From ca9fef4834b844a98ed57b922a70734913c42bcd Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@well-typed.com>
Date: Tue, 7 Apr 2020 10:46:13 +0100
Subject: [PATCH] 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 |  3 ++
 cardano-node/src/Cardano/Common/Parsers.hs | 12 ++++++++
 cardano-node/src/Cardano/Node/Run.hs       | 34 ++++++++++++++++++++--
 3 files changed, 46 insertions(+), 3 deletions(-)

diff --git a/cardano-config/src/Cardano/Config/Types.hs b/cardano-config/src/Cardano/Config/Types.hs
index b7a33e3d35f..b6c6583a4d7 100644
--- a/cardano-config/src/Cardano/Config/Types.hs
+++ b/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
diff --git a/cardano-node/src/Cardano/Common/Parsers.hs b/cardano-node/src/Cardano/Common/Parsers.hs
index a25f057db29..5e40269de6d 100644
--- a/cardano-node/src/Cardano/Common/Parsers.hs
+++ b/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
diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs
index 8f00864a217..c9d8db0539d 100644
--- a/cardano-node/src/Cardano/Node/Run.hs
+++ b/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)
@@ -208,9 +212,8 @@ handleSimpleNode p trace nodeTracers npm onKernel = do
     Left err   -> (putTextLn $ show err) >> exitFailure
     Right addr -> return addr
 
-  varTip <- atomically $ newTVar GenesisPoint
-
-  Node.run
+  withShutdownHandler npm tracer $
+   Node.run
     (consensusTracers nodeTracers)
     (protocolTracers nodeTracers)
     (withTip varTip $ chainDBTracer nodeTracers)
@@ -336,6 +339,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