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.
This commit is contained in:
Joey Hess 2012-07-02 01:31:10 -04:00
parent d1f49b0ad0
commit bea0ac0274
5 changed files with 51 additions and 27 deletions

View file

@ -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
)
)

View file

@ -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
)