From 7bac24ff63aca85ce6c8fa1db0978db48115bfe2 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Thu, 9 Apr 2020 20:03:43 +1000 Subject: [PATCH] Make the clean shutdown handler simpler This modifies the clean shutdown handler to use a FD from the command line, rather than taking stdin. It also makes the logic even simpler, as shown in input-output-hk/cardano-node#767 The command-line arguments are changed from --shutdown-handler to --shutdown-ipc FD so that they are identical to cardano-node. --- lib/byron/exe/cardano-wallet-byron.hs | 22 ++-- lib/cli/src/Cardano/CLI.hs | 23 ++-- .../exe/cardano-wallet-jormungandr.hs | 20 ++-- lib/launcher/cardano-wallet-launcher.cabal | 1 - lib/launcher/src/Cardano/Startup.hs | 105 +++++++++--------- lib/launcher/test/unit/Cardano/StartupSpec.hs | 49 +++++--- nix/.stack.nix/cardano-wallet-launcher.nix | 1 - 7 files changed, 114 insertions(+), 107 deletions(-) diff --git a/lib/byron/exe/cardano-wallet-byron.hs b/lib/byron/exe/cardano-wallet-byron.hs index 9a99124c620..328e050d26f 100644 --- a/lib/byron/exe/cardano-wallet-byron.hs +++ b/lib/byron/exe/cardano-wallet-byron.hs @@ -30,7 +30,8 @@ import Cardano.BM.Data.Severity import Cardano.BM.Trace ( Trace, appendName, logDebug, logError, logInfo, logNotice ) import Cardano.CLI - ( LoggingOptions + ( Fd + , LoggingOptions , cli , cmdAddress , cmdByronWalletCreate @@ -51,7 +52,7 @@ import Cardano.CLI , loggingTracers , runCli , setupDirectory - , shutdownHandlerFlag + , shutdownIPCOption , syncToleranceOption , tlsOption , withLogging @@ -163,7 +164,7 @@ data ServeArgs = ServeArgs , _networkConfiguration :: NetworkConfiguration , _database :: Maybe FilePath , _syncTolerance :: SyncTolerance - , _enableShutdownHandler :: Bool + , _shutdownIpc :: Maybe Fd , _logging :: LoggingOptions TracerSeverities } deriving (Show) @@ -182,7 +183,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty <*> networkConfigurationOption <*> optional databaseOption <*> syncToleranceOption - <*> shutdownHandlerFlag + <*> shutdownIPCOption <*> loggingOptions tracerSeveritiesOption exec :: ServeArgs @@ -195,11 +196,11 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty networkConfig databaseDir sTolerance - enableShutdownHandler + shutdownIpc logOpt) = do withTracers logOpt $ \tr tracers -> do installSignalHandlers (logNotice tr MsgSigTerm) - withShutdownHandlerMaybe tr enableShutdownHandler $ do + void $ withShutdownHandler (trShutdown tr) shutdownIpc $ do logDebug tr $ MsgServeArgs args (discriminant, bp, vData, block0) @@ -226,11 +227,9 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty whenJust m fn = case m of Nothing -> pure () Just a -> fn a - withShutdownHandlerMaybe :: Trace IO MainLog -> Bool -> IO () -> IO () - withShutdownHandlerMaybe _ False = void - withShutdownHandlerMaybe tr True = void . withShutdownHandler trShutdown - where - trShutdown = trMessage $ contramap (\(n, x) -> (n, fmap MsgShutdownHandler x)) tr + + trShutdown = trMessage . contramap (\(n, x) -> (n, fmap MsgShutdownHandler x)) + {------------------------------------------------------------------------------- Logging -------------------------------------------------------------------------------} @@ -305,4 +304,3 @@ tracerSeveritiesOption = Tracers <> value def <> metavar "SEVERITY" <> internal - diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs index edfb8418579..c6ba9b847de 100644 --- a/lib/cli/src/Cardano/CLI.hs +++ b/lib/cli/src/Cardano/CLI.hs @@ -52,7 +52,7 @@ module Cardano.CLI , listenOption , nodePortOption , nodePortMaybeOption - , shutdownHandlerFlag + , shutdownIPCOption , stateDirOption , syncToleranceOption , tlsOption @@ -79,7 +79,6 @@ module Cardano.CLI , hoistKeyScheme , mapKey - -- * Logging , withLogging @@ -101,6 +100,9 @@ module Cardano.CLI , setupDirectory , waitForService , WaitForServiceLog (..) + + -- * Re-exports + , Fd(Fd) ) where import Prelude hiding @@ -265,7 +267,6 @@ import Options.Applicative , str , strOption , subparser - , switch , value ) import Options.Applicative.Help.Pretty @@ -313,6 +314,8 @@ import System.IO , stdin , stdout ) +import System.Posix.Types + ( Fd (Fd) ) import qualified Cardano.BM.Configuration.Model as CM import qualified Cardano.BM.Data.BackendKind as CM @@ -1551,11 +1554,15 @@ sizeOption = optionT $ mempty <> value MS_15 <> showDefaultWith showT --- | [--shutdown-handler] -shutdownHandlerFlag :: Parser Bool -shutdownHandlerFlag = switch - ( long "shutdown-handler" - <> help "Enable the clean shutdown handler (exits when stdin is closed)" ) +-- | [--shutdown-ipc FD] +shutdownIPCOption :: Parser (Maybe Fd) +shutdownIPCOption = optional $ option (Fd <$> auto) $ mempty + <> long "shutdown-ipc" + <> metavar "FD" + <> help (mconcat + [ "Enable the clean shutdown handler. " + , "The program exits when this inherited FD reaches EOF." + ]) -- | --state-dir=DIR, default: ~/.cardano-wallet/$backend/$network stateDirOption :: FilePath -> Parser (Maybe FilePath) diff --git a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs index 05429cb25ed..77b6a2d1e14 100644 --- a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs +++ b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs @@ -29,7 +29,8 @@ import Cardano.BM.Data.Severity import Cardano.BM.Trace ( Trace, appendName, logInfo, logNotice ) import Cardano.CLI - ( LoggingOptions (..) + ( Fd + , LoggingOptions (..) , Port (..) , cli , cmdAddress @@ -55,7 +56,7 @@ import Cardano.CLI , requireFilePath , runCli , setupDirectory - , shutdownHandlerFlag + , shutdownIPCOption , stateDirOption , syncToleranceOption , withLogging @@ -288,7 +289,7 @@ data ServeArgs = ServeArgs , _database :: Maybe FilePath , _syncTolerance :: SyncTolerance , _block0H :: Hash "Genesis" - , _enableShutdownHandler :: Bool + , _shutdownIpc :: Maybe Fd , _logging :: LoggingOptions TracerSeverities } deriving (Show, Eq) @@ -306,15 +307,15 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty <*> optional databaseOption <*> syncToleranceOption <*> genesisHashOption - <*> shutdownHandlerFlag + <*> shutdownIPCOption <*> loggingOptions tracerSeveritiesOption exec :: ServeArgs -> IO () - exec args@(ServeArgs hostPreference listen nodePort databaseDir sTolerance block0H enableShutdownHandler logOpt) = do + exec args@(ServeArgs hostPreference listen nodePort databaseDir sTolerance block0H shutdownIPC logOpt) = do withTracers logOpt $ \tr tracers -> do installSignalHandlers (logNotice tr MsgSigTerm) - withShutdownHandlerMaybe tr enableShutdownHandler $ do + void $ withShutdownHandler (trShutdown tr) shutdownIPC $ do logInfo tr $ MsgServeArgs args let baseUrl = localhostBaseUrl $ getPort nodePort let cp = JormungandrConnParams block0H baseUrl @@ -332,12 +333,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty Nothing -> pure () Just a -> fn a - withShutdownHandlerMaybe :: Trace IO MainLog -> Bool -> IO () -> IO () - withShutdownHandlerMaybe _ False = void - withShutdownHandlerMaybe tr True = void . withShutdownHandler trShutdown - where - trShutdown = trMessage - $ contramap (second $ fmap MsgShutdownHandler) tr + trShutdown = trMessage . contramap (second $ fmap MsgShutdownHandler) {------------------------------------------------------------------------------- Options diff --git a/lib/launcher/cardano-wallet-launcher.cabal b/lib/launcher/cardano-wallet-launcher.cabal index 7559688916d..84c31745c40 100644 --- a/lib/launcher/cardano-wallet-launcher.cabal +++ b/lib/launcher/cardano-wallet-launcher.cabal @@ -32,7 +32,6 @@ library base , aeson , async - , bytestring , code-page , contra-tracer , extra diff --git a/lib/launcher/src/Cardano/Startup.hs b/lib/launcher/src/Cardano/Startup.hs index 0a7e1c1eee2..e21b37e06a7 100644 --- a/lib/launcher/src/Cardano/Startup.hs +++ b/lib/launcher/src/Cardano/Startup.hs @@ -16,7 +16,6 @@ module Cardano.Startup -- * Clean shutdown , withShutdownHandler - , withShutdownHandler' , installSignalHandlers -- * Logging @@ -29,34 +28,26 @@ import Cardano.BM.Data.Severity ( Severity (..) ) import Cardano.BM.Data.Tracer ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) ) -import Control.Concurrent - ( forkIO ) import Control.Concurrent.Async - ( race ) -import Control.Concurrent.MVar - ( MVar, newEmptyMVar, putMVar, takeMVar ) + ( async, race, wait ) import Control.Exception - ( IOException, catch, handle, throwIO ) + ( IOException, try ) import Control.Tracer ( Tracer, traceWith ) import Data.Either.Extra ( eitherToMaybe ) import Data.Text.Class ( ToText (..) ) +import GHC.IO.Handle.FD + ( fdToHandle ) import System.IO - ( Handle - , hIsOpen - , hSetEncoding - , mkTextEncoding - , stderr - , stderr - , stdin - , stdin - , stdout - , stdout - ) + ( hGetChar, hSetEncoding, mkTextEncoding, stderr, stdin, stdout ) import System.IO.CodePage ( withCP65001 ) +import System.IO.Error + ( isEOFError ) +import System.Posix.Types + ( Fd (Fd) ) #ifdef WINDOWS import Cardano.Startup.Windows @@ -66,7 +57,6 @@ import Cardano.Startup.POSIX ( installSignalHandlers ) #endif -import qualified Data.ByteString as BS import qualified Data.Text as T {------------------------------------------------------------------------------- @@ -90,65 +80,70 @@ setUtf8EncodingHandles = do Shutdown handlers -------------------------------------------------------------------------------} --- | Runs the given action with a cross-platform clean shutdown handler. +-- | Runs the given action with an optional cross-platform clean shutdown +-- handler. -- -- This is necessary when running cardano-wallet as a subprocess of Daedalus. -- For more details, see -- -- --- It works simply by reading from 'stdin', which is otherwise unused by the API --- server. Once end-of-file is reached, it cancels the action, causing the --- program to shut down. +-- It works by reading from the given file descriptor. Once end-of-file is +-- reached, either deliberately by the parent process closing the write end, or +-- automatically because the parent process itself terminated, it cancels the +-- action, causing the program to shut down. -- --- So, when running @cardano-wallet@ as a subprocess, the parent process should --- pass a pipe for 'stdin', then close the pipe when it wants @cardano-wallet@ --- to shut down. -withShutdownHandler :: Tracer IO ShutdownHandlerLog -> IO a -> IO (Maybe a) -withShutdownHandler tr = withShutdownHandler' tr stdin - --- | A variant of 'withShutdownHandler' where the handle to read can be chosen. -withShutdownHandler' :: Tracer IO ShutdownHandlerLog -> Handle -> IO a -> IO (Maybe a) -withShutdownHandler' tr h action = do - enabled <- hIsOpen h - traceWith tr $ MsgShutdownHandler enabled - let with - | enabled = fmap eitherToMaybe . race readerLoop - | otherwise = fmap Just - with action +withShutdownHandler :: Tracer IO ShutdownHandlerLog -> Maybe Fd -> IO a -> IO (Maybe a) +withShutdownHandler _ Nothing action = Just <$> action +withShutdownHandler tr (Just (Fd fd)) action = do + traceWith tr $ MsgShutdownHandlerEnabled (Fd fd) + eitherToMaybe <$> race (wrapUninterruptableIO waitForEOF) action where - readerLoop = do - handle (traceWith tr . MsgShutdownError) readerLoop' - traceWith tr MsgShutdownEOF - readerLoop' = waitForInput >>= \case - "" -> pure () -- eof: stop loop - _ -> readerLoop' -- repeat - -- Wait indefinitely for input to be available. - -- Runs in separate thread so that it does not deadlock on Windows. - waitForInput = do - v <- newEmptyMVar :: IO (MVar (Either IOException BS.ByteString)) - _ <- forkIO ((BS.hGet h 1000 >>= putMVar v . Right) `catch` (putMVar v . Left)) - takeMVar v >>= either throwIO pure + waitForEOF :: IO () + waitForEOF = do + hnd <- fdToHandle fd + r <- try $ hGetChar hnd + case r of + Left e + | isEOFError e -> traceWith tr MsgShutdownEOF + | otherwise -> traceWith tr $ MsgShutdownError e + Right _ -> traceWith tr MsgShutdownIncorrectUsage + +-- | Windows blocking file IO calls like 'hGetChar' are not interruptable by +-- asynchronous exceptions, as used by async 'cancel' (as of base-4.12). +-- +-- This wrapper works around that problem by running the blocking IO in a +-- separate thread. If the parent thread receives an async cancel then it +-- will return. Note however that in this circumstance the child thread may +-- continue and remain blocked, leading to a leak of the thread. As such this +-- is only reasonable to use a fixed number of times for the whole process. +-- +wrapUninterruptableIO :: IO a -> IO a +wrapUninterruptableIO action = async action >>= wait data ShutdownHandlerLog - = MsgShutdownHandler Bool + = MsgShutdownHandlerEnabled Fd | MsgShutdownEOF | MsgShutdownError IOException + | MsgShutdownIncorrectUsage deriving (Show, Eq) instance ToText ShutdownHandlerLog where toText = \case - MsgShutdownHandler enabled -> - "Cross-platform subprocess shutdown handler is " - <> if enabled then "enabled." else "disabled." + MsgShutdownHandlerEnabled (Fd fd)-> + "Cross-platform subprocess shutdown handler is enabled on fd " + <> T.pack (show fd) <> "." MsgShutdownEOF -> "Starting clean shutdown..." MsgShutdownError e -> "Error waiting for shutdown: " <> T.pack (show e) <> ". Shutting down..." + MsgShutdownIncorrectUsage -> + "--shutdown-ipc FD does not expect input. Shutting down..." instance HasPrivacyAnnotation ShutdownHandlerLog instance HasSeverityAnnotation ShutdownHandlerLog where getSeverityAnnotation = \case - MsgShutdownHandler _ -> Debug + MsgShutdownHandlerEnabled _ -> Debug MsgShutdownEOF -> Notice MsgShutdownError _ -> Error + MsgShutdownIncorrectUsage -> Error diff --git a/lib/launcher/test/unit/Cardano/StartupSpec.hs b/lib/launcher/test/unit/Cardano/StartupSpec.hs index 16e2bb19bd4..b497ffb43c7 100644 --- a/lib/launcher/test/unit/Cardano/StartupSpec.hs +++ b/lib/launcher/test/unit/Cardano/StartupSpec.hs @@ -14,7 +14,7 @@ module Cardano.StartupSpec import Prelude import Cardano.Startup - ( ShutdownHandlerLog (..), withShutdownHandler' ) + ( ShutdownHandlerLog (..), withShutdownHandler ) import Control.Concurrent ( threadDelay ) import Control.Concurrent.Async @@ -29,6 +29,10 @@ import System.IO ( Handle, IOMode (..), hClose, hWaitForInput, stdin, withFile ) import System.IO.Error ( isUserError ) +import System.Posix.IO + ( handleToFd ) +import System.Posix.Types + ( Fd ) import System.Process ( createPipe ) import Test.Hspec @@ -93,67 +97,76 @@ spec = describe "withShutdownHandler" $ do res <- race (wrapIO $ getChunk a) (threadDelay decisecond) res `shouldBe` Right () - it "action completes immediately" $ withPipe $ \(a, _) -> do + it "action completes immediately" $ withFdPipe $ \(a, _) -> do logs <- captureLogging' $ \tr -> do - withShutdownHandler' tr a (pure ()) + withShutdownHandler tr (Just a) (pure ()) `shouldReturn` Just () - logs `shouldContain` [MsgShutdownHandler True] + logs `shouldContain` [MsgShutdownHandlerEnabled a] - it "action completes with delay" $ withPipe $ \(a, _) -> do - res <- withShutdownHandler' nullTracer a $ do + it "action completes with delay" $ withFdPipe $ \(a, _) -> do + res <- withShutdownHandler nullTracer (Just a) $ do threadDelay decisecond pure () res `shouldBe` Just () - it "handle is closed immediately" $ withPipe $ \(a, b) -> do + it "handle is closed immediately" $ withFdPipe $ \(a, b) -> do logs <- captureLogging' $ \tr -> do - res <- withShutdownHandler' tr a $ do + res <- withShutdownHandler tr (Just a) $ do hClose b threadDelay decisecond -- give handler a chance to run pure () res `shouldBe` Nothing logs `shouldContain` [MsgShutdownEOF] - it "handle is closed with delay" $ withPipe $ \(a, b) -> do - res <- withShutdownHandler' nullTracer a $ do + it "handle is closed with delay" $ withFdPipe $ \(a, b) -> do + res <- withShutdownHandler nullTracer (Just a) $ do threadDelay decisecond hClose b threadDelay decisecond -- give handler a chance to run pure () res `shouldBe` Nothing - it "action throws exception" $ withPipe $ \(a, _) -> do + it "action throws exception" $ withFdPipe $ \(a, _) -> do let bomb = userError "bomb" logs <- captureLogging' $ \tr -> do - withShutdownHandler' tr a (throwIO bomb) + withShutdownHandler tr (Just a) (throwIO bomb) `shouldThrow` isUserError - logs `shouldBe` [MsgShutdownHandler True] + logs `shouldBe` [MsgShutdownHandlerEnabled a] it ("handle is " ++ nullFileName ++ " (immediate EOF)") $ do pendingOnWindows $ "Can't open " ++ nullFileName ++ " for reading" logs <- captureLogging' $ \tr -> withFile nullFileName ReadMode $ \h -> do - res <- withShutdownHandler' tr h $ do + fd <- handleToFd h + res <- withShutdownHandler tr (Just fd) $ do threadDelay decisecond -- give handler a chance to run pure () res `shouldBe` Nothing logs `shouldContain` [MsgShutdownEOF] it "handle is already closed" $ withPipe $ \(a, b) -> do + fd <- handleToFd a hClose a hClose b logs <- captureLogging' $ \tr -> do - res <- withShutdownHandler' tr a $ do + res <- withShutdownHandler tr (Just fd) $ do threadDelay decisecond hClose b threadDelay decisecond -- give handler a chance to run pure () - res `shouldBe` Just () - logs `shouldContain` [MsgShutdownHandler False] + res `shouldBe` Nothing + logs `shouldContain` [MsgShutdownHandlerEnabled fd] -- fixme + logs `shouldContain` [MsgShutdownEOF] withPipe :: ((Handle, Handle) -> IO a) -> IO a withPipe = bracket createPipe closePipe - where closePipe (a, b) = hClose b >> hClose a + where + closePipe (a, b) = hClose b >> hClose a + +withFdPipe :: ((Fd, Handle) -> IO a) -> IO a +withFdPipe action = withPipe $ \(a, b) -> do + fd <- handleToFd a + action (fd, b) captureLogging' :: (Tracer IO msg -> IO a) -> IO [msg] captureLogging' = fmap fst . captureLogging diff --git a/nix/.stack.nix/cardano-wallet-launcher.nix b/nix/.stack.nix/cardano-wallet-launcher.nix index dc8cfc609ac..8be4ca9dd40 100644 --- a/nix/.stack.nix/cardano-wallet-launcher.nix +++ b/nix/.stack.nix/cardano-wallet-launcher.nix @@ -60,7 +60,6 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: (hsPkgs."base" or (buildDepError "base")) (hsPkgs."aeson" or (buildDepError "aeson")) (hsPkgs."async" or (buildDepError "async")) - (hsPkgs."bytestring" or (buildDepError "bytestring")) (hsPkgs."code-page" or (buildDepError "code-page")) (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) (hsPkgs."extra" or (buildDepError "extra"))