Handle SIGTERM by throwing an asynchronous exception

That's roughly how Ctrl-C (SIGINT) is handled by the GHC
runtime.

This way, killing cabal via SIGTERM will give it a chance to
terminate any running children. Previously, it would exit
directly, leaving children behind to exit on their own.

Author: robx

cabal-install/cabal-install.cabal

@@ -165,6 +165,7 @@ library
         Distribution.Client.Security.HTTP
         Distribution.Client.Setup
         Distribution.Client.SetupWrapper
+        Distribution.Client.Signal
         Distribution.Client.SolverInstallPlan
         Distribution.Client.SourceFiles
         Distribution.Client.SrcDist

cabal-install/main/Main.hs

@@ -113,6 +113,8 @@ import Distribution.Client.Manpage            (manpageCmd)
 import Distribution.Client.ManpageFlags       (ManpageFlags (..))
 import Distribution.Client.Utils
          ( determineNumJobs, relaxEncodingErrors )
+import Distribution.Client.Signal
+         ( installTerminationHandler )
 import Distribution.Client.Version
          ( cabalInstallVersion )
 
@@ -170,6 +172,7 @@ import Control.Exception        (try)
 --
 main :: IO ()
 main = do
+  installTerminationHandler
   -- Enable line buffering so that we can get fast feedback even when piped.
   -- This is especially important for CI and build systems.
   hSetBuffering stdout LineBuffering

cabal-install/src/Distribution/Client/Signal.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE CPP #-}
+module Distribution.Client.Signal
+  ( installTerminationHandler
+  , Terminated(..)
+  )
+where
+
+import qualified Control.Exception as Exception
+
+#ifndef mingw32_HOST_OS
+import Control.Concurrent (myThreadId)
+import Control.Monad (void)
+import qualified System.Posix.Signals as Signals
+#endif
+
+-- | Terminated is an asynchronous exception, thrown when
+-- SIGTERM is received. It's to 'kill' what 'UserInterrupt'
+-- is to Ctrl-C.
+data Terminated = Terminated
+
+instance Exception.Exception Terminated where
+  toException = Exception.asyncExceptionToException
+  fromException = Exception.asyncExceptionFromException
+
+instance Show Terminated where
+  show Terminated = "terminated"
+
+-- | Install a signal handler that initiates a controlled shutdown on receiving
+-- SIGTERM by throwing an asynchronous exception at the main thread. Must be
+-- called from the main thread.
+--
+-- It is a noop on Windows.
+--
+installTerminationHandler :: IO ()
+
+#ifdef mingw32_HOST_OS
+
+installTerminationHandler = return ()
+
+#else
+
+installTerminationHandler = do
+  mainThreadId <- myThreadId
+  void $ Signals.installHandler
+    Signals.sigTERM
+    (Signals.CatchOnce $ Exception.throwTo mainThreadId Terminated)
+    Nothing
+
+#endif