10d3b7fc62
Avoid creating transfer info file before transfer lock is created and locked. The wrong order for one thing caused transfer info to be overwritten when a transfer was already in progress. But worse, it caused checkTransfer to see the transfer info, and so lock the transfer lock in order to verify the transfer was not in progress. Which in a concurrent situation, prevented the transferrer from locking the transfer lock, so it failed with "transfer already in progress". Note that the transferinfo command does not lock the transfer lock before creating the transfer info. But, that's only run after recvkey is running, and recvkey does lock the transfer lock, so that seems more or less ok. (Other than being a super complicated legacy mess that the P2P code has mostly obsoleted now.) This commit was supported by the NSF-funded DataLad project.
67 lines
2 KiB
Haskell
67 lines
2 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.TransferInfo where
|
|
|
|
import Command
|
|
import Annex.Content
|
|
import Types.Transfer
|
|
import Logs.Transfer
|
|
import qualified CmdLine.GitAnnexShell.Fields as Fields
|
|
import Utility.Metered
|
|
import Utility.SimpleProtocol
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $
|
|
command "transferinfo" SectionPlumbing
|
|
"updates sender on number of bytes of content received"
|
|
paramKey (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek = withWords start
|
|
|
|
{- Security:
|
|
-
|
|
- The transfer info file contains the user-supplied key, but
|
|
- the built-in guards prevent slashes in it from showing up in the filename.
|
|
- It also contains the UUID of the remote. But slashes are also filtered
|
|
- out of that when generating the filename.
|
|
-
|
|
- Checks that the key being transferred is inAnnex, to prevent
|
|
- malicious spamming of bogus keys. Does not check that a transfer
|
|
- of the key is actually in progress, because this could be started
|
|
- concurrently with sendkey, and win the race.
|
|
-}
|
|
start :: [String] -> CommandStart
|
|
start (k:[]) = do
|
|
case file2key k of
|
|
Nothing -> error "bad key"
|
|
(Just key) -> whenM (inAnnex key) $ do
|
|
afile <- AssociatedFile <$> Fields.getField Fields.associatedFile
|
|
u <- maybe (error "missing remoteuuid") toUUID
|
|
<$> Fields.getField Fields.remoteUUID
|
|
let t = Transfer
|
|
{ transferDirection = Upload
|
|
, transferUUID = u
|
|
, transferKey = key
|
|
}
|
|
tinfo <- liftIO $ startTransferInfo afile
|
|
(update, tfile, createtfile, _) <- mkProgressUpdater t tinfo
|
|
createtfile
|
|
liftIO $ mapM_ void
|
|
[ tryIO $ forever $ do
|
|
bytes <- readUpdate
|
|
maybe (error "transferinfo protocol error")
|
|
(update . toBytesProcessed) bytes
|
|
, tryIO $ removeFile tfile
|
|
, exitSuccess
|
|
]
|
|
stop
|
|
start _ = giveup "wrong number of parameters"
|
|
|
|
readUpdate :: IO (Maybe Integer)
|
|
readUpdate = maybe Nothing readish <$> getProtocolLine stdin
|