git-annex/Command/ReKey.hs
Joey Hess f1b0a4b404 Use lower case hash directories for storing files on crippled filesystems, same as is already done for bare repositories.
* since this is a crippled filesystem anyway, git-annex doesn't use
  symlinks on it
* so there's no reason to use the mixed case hash directories that we're
  stuck using to avoid breaking everyone's symlinks to the content
* so we can do what is already done for all bare repos, and make non-bare
  repos on crippled filesystems use the all-lower case hash directories
* which are, happily, all 3 letters long, so they cannot conflict with
  mixed case hash directories
* so I was able to 100% fix this and even resuming `git annex add` in the
  test case will recover and it will all just work.
2013-04-04 15:46:33 -04:00

73 lines
1.9 KiB
Haskell

{- git-annex command
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.ReKey where
import Common.Annex
import Command
import qualified Annex
import Types.Key
import Annex.Content
import qualified Command.Add
import Logs.Web
import Config
import Utility.CopyFile
def :: [Command]
def = [notDirect $ command "rekey"
(paramOptional $ paramRepeating $ paramPair paramPath paramKey)
seek SectionPlumbing "change keys used for files"]
seek :: [CommandSeek]
seek = [withPairs start]
start :: (FilePath, String) -> CommandStart
start (file, keyname) = ifAnnexed file go stop
where
newkey = fromMaybe (error "bad key") $ file2key keyname
go (oldkey, _)
| oldkey == newkey = stop
| otherwise = do
showStart "rekey" file
next $ perform file oldkey newkey
perform :: FilePath -> Key -> Key -> CommandPerform
perform file oldkey newkey = do
present <- inAnnex oldkey
_ <- if present
then linkKey oldkey newkey
else do
unlessM (Annex.getState Annex.force) $
error $ file ++ " is not available (use --force to override)"
return True
next $ cleanup file oldkey newkey
{- Make a hard link to the old key content, to avoid wasting disk space. -}
linkKey :: Key -> Key -> Annex Bool
linkKey oldkey newkey = getViaTmpUnchecked newkey $ \tmp -> do
src <- calcRepo $ gitAnnexLocation oldkey
ifM (liftIO $ doesFileExist tmp)
( return True
, ifM crippledFileSystem
( liftIO $ copyFileExternal src tmp
, do
liftIO $ createLink src tmp
return True
)
)
cleanup :: FilePath -> Key -> Key -> CommandCleanup
cleanup file oldkey newkey = do
-- If the old key had some associated urls, record them for
-- the new key as well.
urls <- getUrls oldkey
unless (null urls) $
mapM_ (setUrlPresent newkey) urls
-- Update symlink to use the new key.
liftIO $ removeFile file
Command.Add.cleanup file newkey True