Cross-platform clean shutdown support with --shutdown-ipc FD flag

Fixes #726

On Windows there is no standard reliable mechanism to politely ask a
process to stop. There is only the brutal TerminateProcess. Using that
by default is not great since it means the node always has to revalidate
its chain DB on startup.

This adds an ad-hoc mechainsim that Daedalus can use to reliably shut
down the node process. The --shutdown-ipc flag takes the FD of the read
ebd of an inherited pipe. If provided, the node will monitor that pipe
when when the write end of the pipe is closed then the node will
initiate a clean shutdown. So Daedalus can explicitly terminate the node
by closing the write end of the pipe. If Daedalus terminates uncleanly
then the pipe will also be closed and the node will also shut down.

Although this mechanism is needed for Windows, it is also cross-platform
so it can be used by Daedalus across all platforms.

cardano-config/src/Cardano/Config/Types.hs

@@ -27,6 +27,7 @@ module Cardano.Config.Types
     , Update (..)
     , ViewMode (..)
     , YamlSocketPath (..)
+    , Fd (..)
     , parseNodeConfiguration
     , parseNodeConfigurationFP
     ) where
@@ -40,6 +41,7 @@ import qualified Data.Text as T
 import           Data.Yaml (decodeFileThrow)
 import           Network.Socket (PortNumber)
 import           System.FilePath ((</>), takeDirectory)
+import           System.Posix.Types (Fd(Fd))
 
 import qualified Cardano.Chain.Update as Update
 import           Cardano.BM.Data.Tracer (TracingVerbosity (..))
@@ -84,6 +86,7 @@ data NodeCLI = NodeCLI
   , nodeAddr :: !NodeAddress
   , configFp :: !ConfigYamlFilePath
   , validateDB :: !Bool
+  , shutdownIPC :: !(Maybe Fd)
   }
 
 data NodeMockCLI = NodeMockCLI

cardano-node/src/Cardano/Common/Parsers.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 
 {-# OPTIONS_GHC -Wno-all-missed-specialisations #-}
@@ -124,6 +125,7 @@ nodeRealParser = do
   nodeConfigFp <- parseConfigFile
 
   validate <- parseValidateDB
+  shutdownIPC <- parseShutdownIPC
 
   pure NodeCLI
     { mscFp = MiscellaneousFilepaths
@@ -136,6 +138,7 @@ nodeRealParser = do
     , nodeAddr = nAddress
     , configFp = ConfigYamlFilePath nodeConfigFp
     , validateDB = validate
+    , shutdownIPC
     }
 
 parseCLISocketPath :: Text -> Parser (Maybe CLISocketPath)
@@ -249,6 +252,15 @@ parseValidateDB =
       <> help "Validate all on-disk database files"
     )
 
+parseShutdownIPC :: Parser (Maybe Fd)
+parseShutdownIPC =
+    optional $ option (Fd <$> auto) (
+         long "shutdown-ipc"
+      <> metavar "FD"
+      <> help "Shut down the process when this inherited FD reaches EOF"
+      <> hidden
+    )
+
 -- | Flag parser, that returns its argument on success.
 flagParser :: a -> String -> String -> Parser a
 flagParser val opt desc = flag' val $ long opt <> help desc

cardano-node/src/Cardano/Node/Run.hs

@@ -39,7 +39,11 @@ import           Data.Version (showVersion)
 import           Network.HostName (getHostName)
 import           Network.Socket (AddrInfo)
 import           System.Directory (canonicalizePath, makeAbsolute)
+import qualified System.IO as IO
+import qualified System.IO.Error  as IO
+import qualified GHC.IO.Handle.FD as IO (fdToHandle)
 
+import           Control.Concurrent.Async (race_)
 import           Control.Monad.Class.MonadSTM
 
 import           Paths_cardano_node (version)
@@ -210,7 +214,8 @@ handleSimpleNode p trace nodeTracers npm onKernel = do
 
   varTip <- atomically $ newTVar GenesisPoint
 
-  Node.run
+  withShutdownHandler npm tracer $
+   Node.run
     (consensusTracers nodeTracers)
     (protocolTracers nodeTracers)
     (withTip varTip $ chainDBTracer nodeTracers)
@@ -336,6 +341,31 @@ handleSimpleNode p trace nodeTracers npm onKernel = do
 
          when mockValidateDB $ traceWith tracer "Performing DB validation"
 
+-- | We provide an optional cross-platform method to politely request shut down.
+--
+-- The parent process passes us the file descriptor number of the read end of a
+-- pipe, via the CLI with @--shutdown-ipc FD@. If the write end gets closed,
+-- either deliberatly by the parent process or automatically because the parent
+-- process itself terminated, then we initiate a clean shutdown.
+--
+withShutdownHandler :: NodeProtocolMode -> Tracer IO String -> IO () -> IO ()
+withShutdownHandler (RealProtocolMode NodeCLI{shutdownIPC = Just (Fd fd)})
+                    tracer action =
+    race_ waitForEOF action
+  where
+    waitForEOF :: IO ()
+    waitForEOF = do
+      hnd <- IO.fdToHandle fd
+      r   <- try $ IO.hGetChar hnd
+      case r of
+        Left e | IO.isEOFError e -> traceWith tracer "received shutdown request"
+               | otherwise       -> throwIO e
+
+        Right _  ->
+          throwIO $ IO.userError "--shutdown-ipc FD does not expect input"
+
+withShutdownHandler _ _ action = action
+
 
 --------------------------------------------------------------------------------
 -- Helper functions