summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-10-08 14:47:46 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-10-08 14:47:46 -0400
commit64dfd213e46f983d5cb504b446597e87f71440de (patch)
treeee70642df0e95c99828920b8d071d057b9ee5acf /Command
parentbab88f3596c570346a3d069af9e3c8ed92e473c9 (diff)
git-annex-shell: Added lockcontent command, to prevent dropping of key's content.
Diffstat (limited to 'Command')
-rw-r--r--Command/LockContent.hs45
1 files changed, 45 insertions, 0 deletions
diff --git a/Command/LockContent.hs b/Command/LockContent.hs
new file mode 100644
index 000000000..bab5c9276
--- /dev/null
+++ b/Command/LockContent.hs
@@ -0,0 +1,45 @@
+{- git-annex-shell command
+ -
+ - Copyright 2015 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.LockContent where
+
+import Common.Annex
+import Command
+import Annex.Content
+import Types.Key
+
+cmd :: Command
+cmd = noCommit $
+ command "lockcontent" SectionPlumbing
+ "locks key's content in the annex, preventing it being dropped"
+ paramKey
+ (withParams seek)
+
+seek :: CmdParams -> CommandSeek
+seek = withWords start
+
+-- First, lock the content. Then, make sure the content is actually
+-- present, and print out a "1". Wait for the caller to send a line before
+-- dropping the lock.
+start :: [String] -> CommandStart
+start [ks] = do
+ ok <- lockContentShared k locksuccess
+ `catchNonAsync` (const $ return False)
+ liftIO $ if ok
+ then exitSuccess
+ else exitFailure
+ where
+ k = fromMaybe (error "bad key") (file2key ks)
+ locksuccess = ifM (inAnnex k)
+ ( liftIO $ do
+ putStrLn "OK"
+ hFlush stdout
+ _ <- getLine
+ return True
+ , return False
+ )
+start _ = error "Specify exactly 1 key."