summaryrefslogtreecommitdiff
path: root/Command/RecvKey.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-02 01:31:10 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-02 01:31:10 -0400
commitbea0ac0274861f639ef999b146a719f4300fbfe4 (patch)
treebd1bf0d171f83667da918850e6b653c288031d30 /Command/RecvKey.hs
parentd1f49b0ad032f13adc39d963cc8ceca28215b1d5 (diff)
record transfers for git-annex-shell
Not yet tested and places git-annex-shell is run need to be modified to pass the new field settings. Note that rsyncServerSend was changed to fork, rather than directly exec rsync, because it needs to keep the transfer lock held, and clean up the transfer log when done.
Diffstat (limited to 'Command/RecvKey.hs')
-rw-r--r--Command/RecvKey.hs24
1 files changed, 13 insertions, 11 deletions
diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index 9744a56d4..ce8bff997 100644
--- a/Command/RecvKey.hs
+++ b/Command/RecvKey.hs
@@ -12,6 +12,7 @@ import Command
import CmdLine
import Annex.Content
import Utility.RsyncFile
+import Logs.Transfer
def :: [Command]
def = [oneShot $ command "recvkey" paramKey seek
@@ -21,14 +22,15 @@ seek :: [CommandSeek]
seek = [withKeys start]
start :: Key -> CommandStart
-start key = do
- whenM (inAnnex key) $ error "key is already present in annex"
-
- ok <- getViaTmp key (liftIO . rsyncServerReceive)
- if ok
- then do
- -- forcibly quit after receiving one key,
- -- and shutdown cleanly
- _ <- shutdown True
- liftIO exitSuccess
- else liftIO exitFailure
+start key = ifM (inAnnex key)
+ ( error "key is already present in annex"
+ , fieldTransfer Download key $ do
+ ifM (getViaTmp key $ liftIO . rsyncServerReceive)
+ ( do
+ -- forcibly quit after receiving one key,
+ -- and shutdown cleanly
+ _ <- shutdown True
+ liftIO exitSuccess
+ , liftIO exitFailure
+ )
+ )