61ccf95004
Only the assistant uses these, and only the assistant cleans them up, so make only git annex transferkeys write them, There is one behavior change from this. If glacier is being used, and a manual git annex get --from glacier fails because the file isn't available yet, the assistant will no longer later see that failed transfer file and retry the get. Hope no-one depended on that old behavior.
57 lines
1.8 KiB
Haskell
57 lines
1.8 KiB
Haskell
{- git-annex plumbing command (for use by old assistant, and users)
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.TransferKey where
|
|
|
|
import Common.Annex
|
|
import Command
|
|
import Annex.Content
|
|
import Logs.Location
|
|
import Annex.Transfer
|
|
import qualified Remote
|
|
import Types.Remote
|
|
|
|
cmd :: [Command]
|
|
cmd = [withOptions transferKeyOptions $
|
|
noCommit $ command "transferkey" paramKey seek SectionPlumbing
|
|
"transfers a key from or to a remote"]
|
|
|
|
transferKeyOptions :: [Option]
|
|
transferKeyOptions = fileOption : fromToOptions
|
|
|
|
fileOption :: Option
|
|
fileOption = fieldOption [] "file" paramFile "the associated file"
|
|
|
|
seek :: CommandSeek
|
|
seek ps = do
|
|
to <- getOptionField toOption Remote.byNameWithUUID
|
|
from <- getOptionField fromOption Remote.byNameWithUUID
|
|
file <- getOptionField fileOption return
|
|
withKeys (start to from file) ps
|
|
|
|
start :: Maybe Remote -> Maybe Remote -> AssociatedFile -> Key -> CommandStart
|
|
start to from file key =
|
|
case (from, to) of
|
|
(Nothing, Just dest) -> next $ toPerform dest key file
|
|
(Just src, Nothing) -> next $ fromPerform src key file
|
|
_ -> error "specify either --from or --to"
|
|
|
|
toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
|
|
toPerform remote key file = go Upload file $
|
|
upload (uuid remote) key file forwardRetry noObserver $ \p -> do
|
|
ok <- Remote.storeKey remote key file p
|
|
when ok $
|
|
Remote.logStatus remote key InfoPresent
|
|
return ok
|
|
|
|
fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
|
|
fromPerform remote key file = go Upload file $
|
|
download (uuid remote) key file forwardRetry noObserver $ \p ->
|
|
getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
|
|
|
|
go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
|
|
go direction file a = notifyTransfer direction file a >>= liftIO . exitBool
|