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:
parent
e4d1914e3a
commit
b18fb1e343
3 changed files with 11 additions and 2 deletions
|
@ -38,6 +38,7 @@ import Annex.ChangedRefs
|
||||||
import Control.Monad.Free
|
import Control.Monad.Free
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import System.Exit (ExitCode(..))
|
import System.Exit (ExitCode(..))
|
||||||
|
import System.IO.Error
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
|
@ -159,9 +160,11 @@ runNet runst conn runner f = case f of
|
||||||
Left e -> return (Left (show e))
|
Left e -> return (Left (show e))
|
||||||
Right () -> runner next
|
Right () -> runner next
|
||||||
ReceiveMessage next -> do
|
ReceiveMessage next -> do
|
||||||
v <- liftIO $ tryNonAsync $ getProtocolLine (connIhdl conn)
|
v <- liftIO $ tryIOError $ getProtocolLine (connIhdl conn)
|
||||||
case v of
|
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 Nothing -> return (Left "protocol error")
|
||||||
Right (Just l) -> case parseMessage l of
|
Right (Just l) -> case parseMessage l of
|
||||||
Just m -> do
|
Just m -> do
|
||||||
|
|
|
@ -83,6 +83,7 @@ data Message
|
||||||
| DATA Len -- followed by bytes of data
|
| DATA Len -- followed by bytes of data
|
||||||
| VALIDITY Validity
|
| VALIDITY Validity
|
||||||
| ERROR String
|
| ERROR String
|
||||||
|
| ProtocolEOF
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
instance Proto.Sendable Message where
|
instance Proto.Sendable Message where
|
||||||
|
@ -108,6 +109,7 @@ instance Proto.Sendable Message where
|
||||||
formatMessage (VALIDITY Invalid) = ["INVALID"]
|
formatMessage (VALIDITY Invalid) = ["INVALID"]
|
||||||
formatMessage (DATA len) = ["DATA", Proto.serialize len]
|
formatMessage (DATA len) = ["DATA", Proto.serialize len]
|
||||||
formatMessage (ERROR err) = ["ERROR", Proto.serialize err]
|
formatMessage (ERROR err) = ["ERROR", Proto.serialize err]
|
||||||
|
formatMessage (ProtocolEOF) = []
|
||||||
|
|
||||||
instance Proto.Receivable Message where
|
instance Proto.Receivable Message where
|
||||||
parseCommand "AUTH" = Proto.parse2 AUTH
|
parseCommand "AUTH" = Proto.parse2 AUTH
|
||||||
|
@ -367,6 +369,8 @@ serverLoop :: (Message -> Proto (ServerHandler a)) -> Proto (Maybe a)
|
||||||
serverLoop a = do
|
serverLoop a = do
|
||||||
mcmd <- net receiveMessage
|
mcmd <- net receiveMessage
|
||||||
case mcmd of
|
case mcmd of
|
||||||
|
-- Stop loop at EOF
|
||||||
|
Just ProtocolEOF -> return Nothing
|
||||||
-- When the client sends ERROR to the server, the server
|
-- When the client sends ERROR to the server, the server
|
||||||
-- gives up, since it's not clear what state the client
|
-- gives up, since it's not clear what state the client
|
||||||
-- is in, and so not possible to recover.
|
-- is in, and so not possible to recover.
|
||||||
|
|
|
@ -113,6 +113,8 @@ dupIoHandles = do
|
||||||
- This implementation is not super efficient, but as long as the Handle
|
- This implementation is not super efficient, but as long as the Handle
|
||||||
- supports buffering, it avoids reading a character at a time at the
|
- supports buffering, it avoids reading a character at a time at the
|
||||||
- syscall level.
|
- syscall level.
|
||||||
|
-
|
||||||
|
- Throws isEOFError when no more input is available.
|
||||||
-}
|
-}
|
||||||
getProtocolLine :: Handle -> IO (Maybe String)
|
getProtocolLine :: Handle -> IO (Maybe String)
|
||||||
getProtocolLine h = go (32768 :: Int) []
|
getProtocolLine h = go (32768 :: Int) []
|
||||||
|
|
Loading…
Reference in a new issue