c3d40b9ec3
Each command that first checks preferred content (and/or required content) and then does something that can change the sizes of repositories needs to call prepareLiveUpdate, and plumb it through the preferred content check and the location log update. So far, only Command.Drop is done. Many other commands that don't need to do this have been updated to keep working. There may be some calls to NoLiveUpdate in places where that should be done. All will need to be double checked. Not currently in a compilable state.
52 lines
1.4 KiB
Haskell
52 lines
1.4 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010, 2015 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.SetKey where
|
|
|
|
import Command
|
|
import Logs.Location
|
|
import Annex.Content
|
|
|
|
cmd :: Command
|
|
cmd = command "setkey" SectionPlumbing "sets annexed content for a key"
|
|
(paramPair paramKey paramPath)
|
|
(withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek = withWords (commandAction . start)
|
|
|
|
start :: [String] -> CommandStart
|
|
start ps@(keyname:file:[]) = starting "setkey" ai si $
|
|
perform file' (keyOpt keyname)
|
|
where
|
|
ai = ActionItemOther (Just (QuotedPath file'))
|
|
si = SeekInput ps
|
|
file' = toRawFilePath file
|
|
start _ = giveup "specify a key and a content file"
|
|
|
|
keyOpt :: String -> Key
|
|
keyOpt = fromMaybe (giveup "bad key") . deserializeKey
|
|
|
|
perform :: RawFilePath -> Key -> CommandPerform
|
|
perform file key = do
|
|
-- the file might be on a different filesystem, so moveFile is used
|
|
-- rather than simply calling moveAnnex; disk space is also
|
|
-- checked this way.
|
|
ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) Nothing $ \dest -> unVerified $
|
|
if dest /= file
|
|
then liftIO $ catchBoolIO $ do
|
|
moveFile file dest
|
|
return True
|
|
else return True
|
|
if ok
|
|
then next $ cleanup key
|
|
else giveup "move failed!"
|
|
|
|
cleanup :: Key -> CommandCleanup
|
|
cleanup key = do
|
|
logStatus NoLiveUpdate key InfoPresent
|
|
return True
|