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
64 lines
1.8 KiB
Haskell
64 lines
1.8 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010,2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Command.SendKey where
|
|
|
|
import Command
|
|
import Annex.Content
|
|
import Annex
|
|
import Utility.Rsync
|
|
import Annex.Transfer
|
|
import qualified CmdLine.GitAnnexShell.Fields as Fields
|
|
import Utility.Metered
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $
|
|
command "sendkey" SectionPlumbing
|
|
"runs rsync in server mode to send content"
|
|
paramKey (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek = withKeys (commandAction . start)
|
|
|
|
start :: (SeekInput, Key) -> CommandStart
|
|
start (_, key) = do
|
|
opts <- filterRsyncSafeOptions . maybe [] words
|
|
<$> getField "RsyncOptions"
|
|
ifM (inAnnex key)
|
|
( fieldTransfer Upload key $ \_p ->
|
|
sendAnnex key rollback $ \f _sz ->
|
|
liftIO $ rsyncServerSend (map Param opts) f
|
|
, do
|
|
warning "requested key is not present"
|
|
liftIO exitFailure
|
|
)
|
|
where
|
|
{- No need to do any rollback; when sendAnnex fails, a nonzero
|
|
- exit will be propigated, and the remote will know the transfer
|
|
- failed. -}
|
|
rollback = noop
|
|
|
|
fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
|
|
fieldTransfer direction key a = do
|
|
fastDebug "Command.SendKey" "transfer start"
|
|
let afile = AssociatedFile Nothing
|
|
ok <- maybe (a $ const noop)
|
|
-- Using noRetry here because we're the sender.
|
|
(\u -> runner (Transfer direction (toUUID u) (fromKey id key)) Nothing afile Nothing noRetry a)
|
|
=<< Fields.getField Fields.remoteUUID
|
|
fastDebug "Command.SendKey" "transfer done"
|
|
liftIO $ exitBool ok
|
|
where
|
|
{- Allow the key to be sent to the remote even if there seems to be
|
|
- another transfer of that key going on to that remote.
|
|
- That one may be stale, etc.
|
|
-}
|
|
runner
|
|
| direction == Upload = alwaysRunTransfer
|
|
| otherwise = runTransfer
|