Brought back the setkey plumbing command that was removed in 2011, since we found a use case for it. Note that the command's syntax was changed for consistency.
This commit is contained in:
parent
ecedab0120
commit
1529add61a
6 changed files with 93 additions and 0 deletions
49
Command/SetKey.hs
Normal file
49
Command/SetKey.hs
Normal file
|
@ -0,0 +1,49 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2010, 2015 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Command.SetKey where
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import Logs.Location
|
||||
import Annex.Content
|
||||
import Types.Key
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [command "setkey" (paramPair paramKey paramPath) seek
|
||||
SectionPlumbing "sets annexed content for a key"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek = withWords start
|
||||
|
||||
start :: [String] -> CommandStart
|
||||
start (keyname:file:[]) = do
|
||||
showStart "setkey" file
|
||||
next $ perform file (mkKey keyname)
|
||||
start _ = error "specify a key and a content file"
|
||||
|
||||
mkKey :: String -> Key
|
||||
mkKey = fromMaybe (error "bad key") . file2key
|
||||
|
||||
perform :: FilePath -> Key -> CommandPerform
|
||||
perform file key = do
|
||||
-- the file might be on a different filesystem, so mv is used
|
||||
-- rather than simply calling moveAnnex; disk space is also
|
||||
-- checked this way.
|
||||
ok <- getViaTmp key $ \dest ->
|
||||
if dest /= file
|
||||
then liftIO $
|
||||
boolSystem "mv" [File file, File dest]
|
||||
else return True
|
||||
if ok
|
||||
then next $ cleanup key
|
||||
else error "mv failed!"
|
||||
|
||||
cleanup :: Key -> CommandCleanup
|
||||
cleanup key = do
|
||||
logStatus key InfoPresent
|
||||
return True
|
Loading…
Add table
Add a link
Reference in a new issue