f6cf2dec4c
Improve disk free space checking when transferring unsized keys to local git remotes. Since the size of the object file is known, can check that instead. Getting unsized keys from local git remotes does not check the actual object size. It would be harder to handle that direction because the size check is run locally, before anything involving the remote is done. So it doesn't know the size of the file on the remote. Also, transferring unsized keys to other remotes, including ssh remotes and p2p remotes don't do disk size checking for unsized keys. This would need a change in protocol. (It does seem like it would be possible to implement the same thing for directory special remotes though.) In some sense, it might be better to not ever do disk free checking for unsized keys, than to do it only sometimes. A user might notice this direction working and consider it a bug that the other direction does not. On the other hand, disk reserve checking is not implemented for most special remotes at all, and yet it is implemented for a few, which is also inconsistent, but best effort. And so doing this best effort seems to make some sense. Fundamentally, if the user wants the size to always be checked, they should not use unsized keys. Sponsored-by: Brock Spratlen on Patreon
76 lines
2.4 KiB
Haskell
76 lines
2.4 KiB
Haskell
{- git-annex plumbing command (for use by old assistant, and users)
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL 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 (commandAction . start o) (keyOptions o)
|
|
|
|
start :: TransferKeyOptions -> (SeekInput, Key) -> CommandStart
|
|
start o (_, key) = startingCustomOutput key $ case fromToOptions o of
|
|
ToRemote dest -> toPerform key (fileOption o) =<< getParsed dest
|
|
FromRemote src -> fromPerform key (fileOption o) =<< getParsed src
|
|
|
|
toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
|
|
toPerform key file remote = go Upload file $
|
|
upload' (uuid remote) key file Nothing stdRetry $ \p -> do
|
|
tryNonAsync (Remote.storeKey remote key file p) >>= \case
|
|
Right () -> do
|
|
Remote.logStatus remote key InfoPresent
|
|
return True
|
|
Left e -> do
|
|
warning (UnquotedString (show e))
|
|
return False
|
|
|
|
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
|
|
fromPerform key file remote = go Upload file $
|
|
download' (uuid remote) key file Nothing stdRetry $ \p ->
|
|
logStatusAfter key $ getViaTmp (retrievalSecurityPolicy remote) vc key file Nothing $ \t ->
|
|
tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p vc) >>= \case
|
|
Right v -> return (True, v)
|
|
Left e -> do
|
|
warning (UnquotedString (show e))
|
|
return (False, UnVerified)
|
|
where
|
|
vc = RemoteVerify remote
|
|
|
|
go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
|
|
go direction file a = notifyTransfer direction file a >>= liftIO . exitBool
|