git-annex-shell, remotedaemon, git remote: Fix some memory DOS attacks.

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.)

CHANGELOG

@@ -23,6 +23,7 @@ git-annex (6.20161119) UNRELEASED; urgency=medium
   * rekey: Added --batch mode.
   * add: Stage modified non-large files when running in indirect mode. 
     (This was already done in v6 mode and direct mode.)
+  * git-annex-shell, remotedaemon, git remote: Fix some memory DOS attacks.
 
  -- Joey Hess <id@joeyh.name>  Mon, 21 Nov 2016 11:27:50 -0400
 

Command/LockContent.hs

@@ -10,6 +10,7 @@ module Command.LockContent where
 import Command
 import Annex.Content
 import Remote.Helper.Ssh (contentLockedMarker)
+import Utility.SimpleProtocol
 
 cmd :: Command
 cmd = noCommit $ 
@@ -37,7 +38,7 @@ start [ks] = do
 		( liftIO $ do
 			putStrLn contentLockedMarker
 			hFlush stdout
-			_ <- getLine
+			_ <- getProtocolLine stdin
 			return True
 		, return False
 		)

Command/NotifyChanges.hs

@@ -13,6 +13,7 @@ import Utility.DirWatcher.Types
 import qualified Git
 import Git.Sha
 import RemoteDaemon.Transport.Ssh.Types
+import Utility.SimpleProtocol
 
 import Control.Concurrent
 import Control.Concurrent.Async
@@ -52,7 +53,7 @@ start = do
 	
 	-- No messages need to be received from the caller,
 	-- but when it closes the connection, notice and terminate.
-	let receiver = forever $ void getLine
+	let receiver = forever $ void $ getProtocolLine stdin
 	void $ liftIO $ concurrently sender receiver
 	stop
 

Command/TransferInfo.hs

@@ -13,6 +13,7 @@ import Types.Transfer
 import Logs.Transfer
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Utility.Metered
+import Utility.SimpleProtocol
 
 cmd :: Command
 cmd = noCommit $ 
@@ -62,4 +63,4 @@ start (k:[]) = do
 start _ = giveup "wrong number of parameters"
 
 readUpdate :: IO (Maybe Integer)
-readUpdate = readish <$> getLine
+readUpdate = maybe Nothing readish <$> getProtocolLine stdin

P2P/IO.hs

@@ -102,10 +102,11 @@ runNet conn runner f = case f of
 			Left e -> return (Left (show e))
 			Right () -> runner next
 	ReceiveMessage next -> do
-		v <- liftIO $ tryNonAsync $ hGetLine (connIhdl conn)
+		v <- liftIO $ tryNonAsync $ getProtocolLine (connIhdl conn)
 		case v of
 			Left e -> return (Left (show e))
-			Right l -> case parseMessage l of
+			Right Nothing -> return (Left "protocol error")
+			Right (Just l) -> case parseMessage l of
 				Just m -> runner (next m)
 				Nothing -> runner $ do
 					let e = ERROR $ "protocol parse error: " ++ show l

Remote/Git.hs

@@ -45,6 +45,7 @@ import Utility.CopyFile
 #endif
 import Utility.Env
 import Utility.Batch
+import Utility.SimpleProtocol
 import Remote.Helper.Git
 import Remote.Helper.Messages
 import qualified Remote.Helper.Ssh as Ssh
@@ -390,7 +391,7 @@ lockKey r key callback
 						, std_out = CreatePipe
 						, std_err = UseHandle nullh
 						}
-		v <- liftIO $ tryIO $ hGetLine hout
+		v <- liftIO $ tryIO $ getProtocolLine hout
 		let signaldone = void $ tryNonAsync $ liftIO $ mapM_ tryNonAsync
 			[ hPutStrLn hout ""
 			, hFlush hout
@@ -408,7 +409,7 @@ lockKey r key callback
 					void $ waitForProcess p
 				failedlock
 			Right l 
-				| l == Ssh.contentLockedMarker -> bracket_
+				| l == Just Ssh.contentLockedMarker -> bracket_
 					noop
 					signaldone 
 					(withVerifiedCopy LockedCopy r checkexited callback)

RemoteDaemon/Transport/Ssh.hs

@@ -68,8 +68,8 @@ transportUsingCmd' cmd params (RemoteRepo r _) url transporthandle ichan ochan =
 		send (DONESYNCING url ok)
 		
 	handlestdout fromh = do
-		l <- hGetLine fromh
-		case parseMessage l of
+		ml <- getProtocolLine fromh
+		case parseMessage =<< ml of
 			Just SshRemote.READY -> do
 				send (CONNECTED url)
 				handlestdout fromh

Utility/SimpleProtocol.hs

@@ -1,6 +1,6 @@
 {- Simple line-based protocols.
  -
- - Copyright 2013-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2016 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -20,6 +20,7 @@ module Utility.SimpleProtocol (
 	parse2,
 	parse3,
 	dupIoHandles,
+	getProtocolLine,
 ) where
 
 import Data.Char
@@ -48,6 +49,16 @@ class Serializable a where
 	serialize :: a -> String
 	deserialize :: String -> Maybe a
 
+instance Serializable [Char] where
+	serialize = id
+	deserialize = Just
+
+instance Serializable ExitCode where
+	serialize ExitSuccess = "0"
+	serialize (ExitFailure n) = show n
+	deserialize "0" = Just ExitSuccess
+	deserialize s = ExitFailure <$> readish s
+
 {- Parsing the parameters of messages. Using the right parseN ensures
  - that the string is split into exactly the requested number of words,
  - which allows the last parameter of a message to contain arbitrary
@@ -93,12 +104,25 @@ dupIoHandles = do
 	stderr `hDuplicateTo` stdout
 	return (readh, writeh)
 
-instance Serializable [Char] where
-	serialize = id
-	deserialize = Just
-
-instance Serializable ExitCode where
-	serialize ExitSuccess = "0"
-	serialize (ExitFailure n) = show n
-	deserialize "0" = Just ExitSuccess
-	deserialize s = ExitFailure <$> readish s
+{- Reads a line, but to avoid super-long lines eating memory, returns
+ - Nothing if 32 kb have been read without seeing a '\n'
+ -
+ - If there is a '\r' before the '\n', it is removed, to support
+ - systems using "\r\n" at ends of lines 
+ -
+ - This implementation is not super efficient, but as long as the Handle
+ - supports buffering, it avoids reading a character at a time at the
+ - syscall level.
+ -}
+getProtocolLine :: Handle -> IO (Maybe String)
+getProtocolLine h = go (32768 :: Int) []
+  where
+	go 0 _ = return Nothing
+	go n l = do
+		c <- hGetChar h
+		if c == '\n'
+			then return $ Just $ reverse $ 
+				case l of
+					('\r':rest) -> rest
+					_ -> l
+			else go (n-1) (c:l)