15be5c04a6
The attacker could just send a very lot of data, with no \n and it would all be buffered in memory until the kernel killed git-annex or perhaps OOM killed some other more valuable process. This is a low impact security hole, only affecting communication between local git-annex and git-annex-shell on the remote system. (With either able to be the attacker). Only those with the right ssh key can do it. And, there are probably lots of ways to construct git repositories that make git use a lot of memory in various ways, which would have similar impact as this attack. The fix in P2P/IO.hs would have been higher impact, if it had made it to a released version, since it would have allowed DOSing the tor hidden service without needing to authenticate. (The LockContent and NotifyChanges instances may not be really exploitable; since the line is read and ignored, it probably gets read lazily and does not end up staying buffered in memory.)
66 lines
1.9 KiB
Haskell
66 lines
1.9 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
|
|
file <- 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 file
|
|
(update, tfile, _) <- mkProgressUpdater t tinfo
|
|
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
|