b4c6da9cbd
However, I don't yet have a reliable way to deal with files being modified while they're being transferred. I have code that detects it on the sending side, but the receiver is still free to move the wrong content into its annex, and record that it has the content. So that's not acceptable, and I'll need to work on it some more. However, at this point I can use a direct mode repository as a remote and transfer files from and to it.
41 lines
1 KiB
Haskell
41 lines
1 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010,2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.SendKey where
|
|
|
|
import Common.Annex
|
|
import Command
|
|
import Annex.Content
|
|
import Utility.Rsync
|
|
import Logs.Transfer
|
|
import qualified Fields
|
|
|
|
def :: [Command]
|
|
def = [noCommit $ command "sendkey" paramKey seek
|
|
"runs rsync in server mode to send content"]
|
|
|
|
seek :: [CommandSeek]
|
|
seek = [withKeys start]
|
|
|
|
start :: Key -> CommandStart
|
|
start key = ifM (inAnnex key)
|
|
( fieldTransfer Upload key $ \_p ->
|
|
sendAnnex key $ liftIO . rsyncServerSend
|
|
, do
|
|
warning "requested key is not present"
|
|
liftIO exitFailure
|
|
)
|
|
|
|
fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
|
|
fieldTransfer direction key a = do
|
|
afile <- Fields.getField Fields.associatedFile
|
|
ok <- maybe (a $ const noop)
|
|
(\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a)
|
|
=<< Fields.getField Fields.remoteUUID
|
|
if ok
|
|
then liftIO exitSuccess
|
|
else liftIO exitFailure
|