diff options
author | Joey Hess <joey@kitenet.net> | 2011-10-31 12:33:41 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-10-31 12:33:41 -0400 |
commit | cc1ea8f84463c7e333bfa17a815f250d8d088841 (patch) | |
tree | aa4868f5b59edf4cbb3b34d5ae16f19d06804efa /Command | |
parent | e09dd6f306b3f69718c77a03364ee9e51a51bb3b (diff) |
Removed the setkey command, and added a setcontent command with a more useful interface.
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Fsck.hs | 7 | ||||
-rw-r--r-- | Command/SetContent.hs | 56 | ||||
-rw-r--r-- | Command/SetKey.hs | 48 |
3 files changed, 61 insertions, 50 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 073652d2c..8d6f03d76 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -38,7 +38,7 @@ perform key file backend numcopies = check [ verifyLocationLog key file , checkKeySize key , checkKeyNumCopies key file numcopies - , (Types.Backend.fsckKey backend) key + , checkBackend backend key ] {- To fsck a bare repository, fsck each key in the location log. -} @@ -65,7 +65,7 @@ performBare :: Key -> Backend Annex -> CommandPerform performBare key backend = check [ verifyLocationLog key (show key) , checkKeySize key - , (Types.Backend.fsckKey backend) key + , checkBackend backend key ] check :: [Annex Bool] -> CommandPerform @@ -134,6 +134,9 @@ checkKeySize key = do return False +checkBackend :: Backend Annex -> Key -> Annex Bool +checkBackend backend key = (Types.Backend.fsckKey backend) key + checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool checkKeyNumCopies key file numcopies = do needed <- getNumCopies numcopies diff --git a/Command/SetContent.hs b/Command/SetContent.hs new file mode 100644 index 000000000..d62faa445 --- /dev/null +++ b/Command/SetContent.hs @@ -0,0 +1,56 @@ +{- git-annex command + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.SetContent where + +import Common.Annex +import Command +import Logs.Location +import Annex.Content +import qualified Backend +import qualified Command.Fsck + +def :: [Command] +def = [command "setcontent" (paramPair paramPath paramPath) seek + "sets content of annexed file"] + +seek :: [CommandSeek] +seek = [withWords start] + +start :: [FilePath] -> CommandStart +start (src:dest:[]) = do + showStart "setkey" dest + next $ perform src dest +start _ = error "specify a src file and a dest file" + +perform :: FilePath -> FilePath -> CommandPerform +perform src dest = go =<< Backend.lookupFile dest + where + go Nothing = error "dest file is not in annex" + go (Just (key, backend)) = do + -- the file might be on a different filesystem, + -- so mv is used rather than simply calling + -- moveToObjectDir; disk space is also + -- checked this way. + ok <- getViaTmp key $ \tmp -> + if dest /= src + then liftIO $ + boolSystem "mv" [File src, File tmp] + else return True + if ok + then next $ cleanup key backend + else error "mv failed!" + +cleanup :: Key -> Backend Annex -> CommandCleanup +cleanup key backend = do + logStatus key InfoPresent + + -- fsck the new content + size_ok <- Command.Fsck.checkKeySize key + backend_ok <- Command.Fsck.checkBackend backend key + + return $ size_ok && backend_ok diff --git a/Command/SetKey.hs b/Command/SetKey.hs deleted file mode 100644 index 0c70d12b0..000000000 --- a/Command/SetKey.hs +++ /dev/null @@ -1,48 +0,0 @@ -{- git-annex command - - - - Copyright 2010 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 Config - -def :: [Command] -def = [command "setkey" paramPath seek - "sets annexed content for a key using a temp file"] - -seek :: [CommandSeek] -seek = [withStrings start] - -{- Sets cached content for a key. -} -start :: FilePath -> CommandStart -start file = do - showStart "setkey" file - next $ perform file - -perform :: FilePath -> CommandPerform -perform file = do - key <- cmdlineKey - -- the file might be on a different filesystem, so mv is used - -- rather than simply calling moveToObjectDir; 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 - else error "mv failed!" - -cleanup :: CommandCleanup -cleanup = do - key <- cmdlineKey - logStatus key InfoPresent - return True |