b657242f5d
Leveraged the existing verification code by making it also check the retrievalSecurityPolicy. Also, prevented getViaTmp from running the download action at all when the retrievalSecurityPolicy is going to prevent verifying and so storing it. Added annex.security.allow-unverified-downloads. A per-remote version would be nice to have too, but would need more plumbing, so KISS. (Bill the Cat reference not too over the top I hope. The point is to make this something the user reads the documentation for before using.) A few calls to verifyKeyContent and getViaTmp, that don't involve downloads from remotes, have RetrievalAllKeysSecure hard-coded. It was also hard-coded for P2P.Annex and Command.RecvKey, to match the values of the corresponding remotes. A few things use retrieveKeyFile/retrieveKeyFileCheap without going through getViaTmp. * Command.Fsck when downloading content from a remote to verify it. That content does not get into the annex, so this is ok. * Command.AddUrl when using a remote to download an url; this is new content being added, so this is ok. This commit was sponsored by Fernando Jimenez on Patreon.
67 lines
2 KiB
Haskell
67 lines
2 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 Command
|
|
import Annex.Content
|
|
import Logs.Location
|
|
import Annex.Transfer
|
|
import qualified Remote
|
|
import Types.Remote
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $
|
|
command "transferkey" SectionPlumbing
|
|
"transfers a key from or to a remote"
|
|
paramKey (seek <--< optParser)
|
|
|
|
data TransferKeyOptions = TransferKeyOptions
|
|
{ keyOptions :: CmdParams
|
|
, fromToOptions :: FromToOptions
|
|
, fileOption :: AssociatedFile
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser TransferKeyOptions
|
|
optParser desc = TransferKeyOptions
|
|
<$> cmdParams desc
|
|
<*> parseFromToOptions
|
|
<*> (AssociatedFile <$> optional (strOption
|
|
( long "file" <> metavar paramFile
|
|
<> help "the associated file"
|
|
)))
|
|
|
|
instance DeferredParseClass TransferKeyOptions where
|
|
finishParse v = TransferKeyOptions
|
|
<$> pure (keyOptions v)
|
|
<*> finishParse (fromToOptions v)
|
|
<*> pure (fileOption v)
|
|
|
|
seek :: TransferKeyOptions -> CommandSeek
|
|
seek o = withKeys (start o) (keyOptions o)
|
|
|
|
start :: TransferKeyOptions -> Key -> CommandStart
|
|
start o key = case fromToOptions o of
|
|
ToRemote dest -> next $ toPerform key (fileOption o) =<< getParsed dest
|
|
FromRemote src -> next $ fromPerform key (fileOption o) =<< getParsed src
|
|
|
|
toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
|
|
toPerform key file remote = go Upload file $
|
|
upload (uuid remote) key file stdRetry $ \p -> do
|
|
ok <- Remote.storeKey remote key file p
|
|
when ok $
|
|
Remote.logStatus remote key InfoPresent
|
|
return ok
|
|
|
|
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
|
|
fromPerform key file remote = go Upload file $
|
|
download (uuid remote) key file stdRetry $ \p ->
|
|
getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) 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
|