summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-31 12:33:41 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-31 12:33:41 -0400
commitcc1ea8f84463c7e333bfa17a815f250d8d088841 (patch)
treeaa4868f5b59edf4cbb3b34d5ae16f19d06804efa /Command
parente09dd6f306b3f69718c77a03364ee9e51a51bb3b (diff)
Removed the setkey command, and added a setcontent command with a more useful interface.
Diffstat (limited to 'Command')
-rw-r--r--Command/Fsck.hs7
-rw-r--r--Command/SetContent.hs56
-rw-r--r--Command/SetKey.hs48
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