shut down RemoteSides cleanly

Before it just exited without actually shutting down the RemoteSides,
when the client hung up.

diff --git a/Annex/Cluster.hs b/Annex/Cluster.hs
index 2c397beeb720e60083007205e5dac6eaaef4d358..e632295a95b2d9d3c01c7c200b6bd4861eeb051f 100644 (file)
--- a/Annex/Cluster.hs
+++ b/Annex/Cluster.hs
@@ -35,11 +35,11 @@ proxyCluster
        -> CommandPerform
        -> ServerMode
        -> ClientSide
-       -> (forall a. ((a -> CommandPerform) -> Annex (Either ProtoFailure a) -> CommandPerform))
+       -> (forall a. Annex () -> ((a -> CommandPerform) -> Annex (Either ProtoFailure a) -> CommandPerform))
        -> CommandPerform
 proxyCluster clusteruuid proxydone servermode clientside protoerrhandler = do
        getClientProtocolVersion (fromClusterUUID clusteruuid) clientside
-               withclientversion protoerrhandler
+               withclientversion (protoerrhandler noop)
   where
        proxymethods = ProxyMethods
                { removedContent = \u k -> logChange k u InfoMissing
@@ -56,22 +56,23 @@ proxyCluster clusteruuid proxydone servermode clientside protoerrhandler = do
                -- versions.
                let protocolversion = min maxProtocolVersion clientmaxversion
                sendClientProtocolVersion clientside othermsg protocolversion
-                       (getclientbypass protocolversion) protoerrhandler
+                       (getclientbypass protocolversion) (protoerrhandler noop)
        withclientversion Nothing = proxydone
 
        getclientbypass protocolversion othermsg =
                getClientBypass clientside protocolversion othermsg
-                       (withclientbypass protocolversion) protoerrhandler
+                       (withclientbypass protocolversion) (protoerrhandler noop)
 
        withclientbypass protocolversion (bypassuuids, othermsg) = do
-               selectnode <- clusterProxySelector clusteruuid protocolversion bypassuuids
+               (selectnode, closenodes) <- clusterProxySelector clusteruuid
+                       protocolversion bypassuuids
                concurrencyconfig <- getConcurrencyConfig
                proxy proxydone proxymethods servermode clientside 
                        (fromClusterUUID clusteruuid)
                        selectnode concurrencyconfig protocolversion
-                       othermsg protoerrhandler
+                       othermsg (protoerrhandler closenodes)
 
-clusterProxySelector :: ClusterUUID -> ProtocolVersion -> Bypass -> Annex ProxySelector
+clusterProxySelector :: ClusterUUID -> ProtocolVersion -> Bypass -> Annex (ProxySelector, Annex ())
 clusterProxySelector clusteruuid protocolversion (Bypass bypass) = do
        nodeuuids <- (fromMaybe S.empty . M.lookup clusteruuid . clusterUUIDs)
                <$> getClusters
@@ -85,8 +86,9 @@ clusterProxySelector clusteruuid protocolversion (Bypass bypass) = do
                , "connecting to", show (map Remote.name clusterremotes)
                , "bypass", show (S.toList bypass)
                ]
-       nodes <- mapM (proxySshRemoteSide protocolversion (Bypass bypass')) clusterremotes
-       return $ ProxySelector
+       nodes <- mapM (proxyRemoteSide protocolversion (Bypass bypass')) clusterremotes
+       let closenodes = mapM_ closeRemoteSide nodes
+       let proxyselector = ProxySelector
                { proxyCHECKPRESENT = nodecontaining nodes
                , proxyGET = nodecontaining nodes
                -- The key is sent to multiple nodes at the same time,
@@ -111,6 +113,7 @@ clusterProxySelector clusteruuid protocolversion (Bypass bypass) = do
                , proxyLOCKCONTENT = const (pure Nothing)
                , proxyUNLOCKCONTENT = pure Nothing
                }
+       return (proxyselector, closenodes)
   where
        -- Nodes of the cluster have remote.name.annex-cluster-node
        -- containing its name. 

diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs
index ee1e7ef2bda4b08d994fb74c47d89694cee4cb48..4b38057e5833bf63ac3eb9760cd314237a02df80 100644 (file)
--- a/Command/P2PStdIO.hs
+++ b/Command/P2PStdIO.hs
@@ -57,32 +57,33 @@ performLocal theiruuid servermode = do
                P2P.net $ P2P.sendMessage (P2P.AUTH_SUCCESS myuuid)
                P2P.serveAuthed servermode myuuid
        runst <- liftIO $ mkRunState $ Serving theiruuid Nothing
-       p2pErrHandler (const p2pDone) (runFullProto runst conn server)
+       p2pErrHandler noop (const p2pDone) (runFullProto runst conn server)
 
 performProxy :: UUID -> P2P.ServerMode -> Remote -> CommandPerform
 performProxy clientuuid servermode r = do
        clientside <- proxyClientSide clientuuid
        getClientProtocolVersion (Remote.uuid r) clientside 
                (withclientversion clientside)
-               p2pErrHandler
+               (p2pErrHandler noop)
   where
        withclientversion clientside (Just (clientmaxversion, othermsg)) = do
                remoteside <- proxyRemoteSide clientmaxversion mempty r
                protocolversion <- either (const (min P2P.maxProtocolVersion clientmaxversion)) id
                        <$> runRemoteSide remoteside 
                                (P2P.net P2P.getProtocolVersion)
+               concurrencyconfig <- noConcurrencyConfig
                let closer = do
                        closeRemoteSide remoteside
                        p2pDone
-               concurrencyconfig <- noConcurrencyConfig
+               let errhandler = p2pErrHandler (closeRemoteSide remoteside)
                let runproxy othermsg' = proxy closer proxymethods
                        servermode clientside
                        (Remote.uuid r)
                        (singleProxySelector remoteside)
                        concurrencyconfig
-                       protocolversion othermsg' p2pErrHandler
+                       protocolversion othermsg' errhandler
                sendClientProtocolVersion clientside othermsg protocolversion
-                       runproxy p2pErrHandler
+                       runproxy errhandler
        withclientversion _ Nothing = p2pDone
        
        proxymethods = ProxyMethods
@@ -100,11 +101,15 @@ proxyClientSide clientuuid = do
        clientrunst <- liftIO (mkRunState $ Serving clientuuid Nothing)
        return $ ClientSide clientrunst (stdioP2PConnection Nothing)
 
-p2pErrHandler :: (a -> CommandPerform) -> Annex (Either ProtoFailure a) -> CommandPerform
-p2pErrHandler cont a = a >>= \case
+p2pErrHandler :: Annex () -> (a -> CommandPerform) -> Annex (Either ProtoFailure a) -> CommandPerform
+p2pErrHandler closeconn cont a = a >>= \case
        -- Avoid displaying an error when the client hung up on us.
-       Left (ProtoFailureIOError e) | isEOFError e -> p2pDone
-       Left e -> giveup (describeProtoFailure e)
+       Left (ProtoFailureIOError e) | isEOFError e -> do
+               closeconn
+               p2pDone
+       Left e -> do
+               closeconn
+               giveup (describeProtoFailure e)
        Right v -> cont v
 
 p2pDone :: CommandPerform

diff --git a/P2P/Proxy.hs b/P2P/Proxy.hs
index 89364133e3f449c3dba8868cbecdd66e7b8472b3..b18fde4328d4abb5e0486f81b86d8939d1bf102e 100644 (file)
--- a/P2P/Proxy.hs
+++ b/P2P/Proxy.hs
@@ -58,7 +58,7 @@ runRemoteSide remoteside a =
 
 closeRemoteSide :: RemoteSide -> Annex ()
 closeRemoteSide remoteside = 
-       liftIO (atomically $ tryReadTMVar $ remoteTMVar remoteside) >>= \case
+       liftIO (atomically $ tryTakeTMVar $ remoteTMVar remoteside) >>= \case
                Just (_, _, closer) -> closer
                Nothing -> return ()