clean P2P protocol shutdown on EOF

Avoids "git-annex-shell: <stdin>: hGetChar: end of file"
being displayed by the test suite, due to the way it
runs git-annex-shell without using ssh.

git-annex-shell over ssh was not affected because git-annex hangs up the
ssh connection and so never sees the error message that git-annnex-shell
probably did emit.

This commit was sponsored by Ryan Newton on Patreon.
This commit is contained in:
Joey Hess 2018-09-13 10:46:37 -04:00
parent e4d1914e3a
commit b18fb1e343
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 11 additions and 2 deletions

View file

@ -38,6 +38,7 @@ import Annex.ChangedRefs
import Control.Monad.Free
import Control.Monad.IO.Class
import System.Exit (ExitCode(..))
import System.IO.Error
import Network.Socket
import Control.Concurrent
import Control.Concurrent.Async
@ -159,9 +160,11 @@ runNet runst conn runner f = case f of
Left e -> return (Left (show e))
Right () -> runner next
ReceiveMessage next -> do
v <- liftIO $ tryNonAsync $ getProtocolLine (connIhdl conn)
v <- liftIO $ tryIOError $ getProtocolLine (connIhdl conn)
case v of
Left e -> return (Left (show e))
Left e
| isEOFError e -> runner (next (Just ProtocolEOF))
| otherwise -> return (Left (show e))
Right Nothing -> return (Left "protocol error")
Right (Just l) -> case parseMessage l of
Just m -> do