diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Unix.hs b/hbs2-core/lib/HBS2/Net/Messaging/Unix.hs index 08d30384..08e5d423 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/Unix.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/Unix.hs @@ -4,6 +4,7 @@ module HBS2.Net.Messaging.Unix ( module HBS2.Net.Messaging.Unix , module HBS2.Net.Messaging , module HBS2.Net.Proto.Types + , SocketClosedException ) where import HBS2.Prelude.Plated @@ -220,12 +221,23 @@ runMessagingUnix env = do atomically $ writeTVar seen now next + + clientLoop m = fix \next -> do + m + if not (MUDontRetry `elem` msgUnixOpts env) then do + debug "LOOP!" + next + else do + debug "LOOP EXIT" + handleClient | MUDontRetry `elem` msgUnixOpts env = \_ w -> handleAny throwStopped w - | otherwise = handleAny + | otherwise = handleAny throwStopped _ = throwIO UnixMessagingStopped - runClient = liftIO $ forever $ handleClient logAndRetry $ flip runContT pure $ do + runClient = liftIO $ clientLoop $ handleClient logAndRetry $ flip runContT pure $ do + + debug "HERE WE GO AGAIN!" let sa = SockAddrUnix (msgUnixSockPath env) let p = msgUnixSockPath env @@ -335,6 +347,7 @@ runMessagingUnix env = do pause (msgUnixRetryTime env) + logAndRetry :: SomeException -> IO () logAndRetry e = do warn $ "MessagingUnix. runClient failed, probably server is gone. Retrying:" <+> pretty (msgUnixSelf env) diff --git a/hbs2-fixer/app/Main.hs b/hbs2-fixer/app/Main.hs index a13caf95..09b838d9 100644 --- a/hbs2-fixer/app/Main.hs +++ b/hbs2-fixer/app/Main.hs @@ -168,7 +168,7 @@ withApp cfgPath action = do client <- lift $ race (pause @'Seconds 1) (newMessagingUnix False 1.0 soname) >>= orThrowUser ("can't connect to" <+> pretty soname) - mess <- ContT $ bracket (async $ runMessagingUnix client) $ \_ -> error "FUCK!" >> liftIO exitFailure + mess <- ContT $ withAsync $ runMessagingUnix client link mess @@ -185,10 +185,10 @@ withApp cfgPath action = do void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClientMulti endpoints) client - let o = [MUWatchdog 20] + let o = [MUWatchdog 20,MUDontRetry] clientN <- newMessagingUnixOpts o False 1.0 soname - notif <- ContT $ bracket (async $ runMessagingUnix clientN) (\_ -> error "FUCK2" >> liftIO exitFailure) + notif <- ContT $ withAsync (runMessagingUnix clientN) link notif