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.

2 files changed, 24 insertions, 18 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
+			)
+	)
diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index 686a31caa..5eca70d24 100644
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,6 +11,7 @@ import Common.Annex
 import Command
 import Annex.Content
 import Utility.RsyncFile
+import Logs.Transfer
 
 def :: [Command]
 def = [oneShot $ command "sendkey" paramKey seek
@@ -20,9 +21,12 @@ seek :: [CommandSeek]
 seek = [withKeys start]
 
 start :: Key -> CommandStart
-start key = do
-	file <- inRepo $ gitAnnexLocation key
-	whenM (inAnnex key) $
-		liftIO $ rsyncServerSend file -- does not return
-	warning "requested key is not present"
-	liftIO exitFailure
+start key = ifM (inAnnex key)
+	( fieldTransfer Upload key $ do
+		file <- inRepo $ gitAnnexLocation key
+		liftIO $ ifM (rsyncServerSend file)
+			( exitSuccess , exitFailure )
+	, do
+		warning "requested key is not present"
+		liftIO exitFailure
+	)