{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Functions calling Nix's libutil
module Hercules.CNix.Util
( setInterruptThrown,
triggerInterrupt,
installDefaultSigINTHandler,
createInterruptCallback,
)
where
import Hercules.CNix.Store.Context
( context,
)
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Inline.Cpp.Exception as C
import Protolude
import System.Mem.Weak (deRefWeak)
import System.Posix (Handler (Catch), installHandler, sigHUP, sigINT, sigTERM, sigUSR1)
import Prelude ()
C.context context
C.include "<nix/util/signals.hh>"
C.include "signals.hxx"
C.using "namespace nix"
setInterruptThrown :: IO ()
setInterruptThrown =
[C.throwBlock| void {
nix::setInterruptThrown();
}|]
triggerInterrupt :: IO ()
triggerInterrupt =
[C.throwBlock| void {
nix::unix::triggerInterrupt();
}|]
-- | Install a signal handler that will put Nix into the interrupted state and
-- throws 'UserInterrupt' in the main thread (as is usual), assuming this
-- function is called from the main thread.
--
-- This installs a synchronous C signal handler that calls nix::triggerInterrupt()
-- immediately when signals are delivered, eliminating race conditions between
-- signal delivery and interrupt flag setting. The handler then chains to any
-- previously installed handler to preserve existing behavior.
--
-- This may be removed from the library interface in the future, as it is no
-- longer needed to be called explicitly.
installDefaultSigINTHandler :: IO ()
installDefaultSigINTHandler = do
mainThread <- myThreadId
weakId <- mkWeakThreadId mainThread
let defaultHaskellHandler = do
mt <- deRefWeak weakId
for_ mt \t -> do
throwTo t (toException UserInterrupt)
-- Install synchronous C signal handlers first (these call triggerInterrupt immediately)
for_ [sigINT, sigTERM, sigHUP] \sig -> do
result <- [C.exp| int { hercules_install_signal_handler($(int sig)) } |]
when (result /= 0) $
panic $
"Failed to install synchronous signal handler for signal " <> show sig
-- Install dummy SIGUSR1 handler for Nix interrupt signal propagation
-- (installHandler uses process-wide sigprocmask, so this should apply to all
-- capability threads, as required for Nix)
_oldHandler <-
installHandler
sigUSR1
( -- Not Ignore, because we want to cause EINTR
Catch pass
)
Nothing
-- Install Haskell interrupter in Nix
createInterruptCallback defaultHaskellHandler
createInterruptCallback :: IO () -> IO ()
createInterruptCallback onInterrupt = do
onInterruptPtr <- mkCallback onInterrupt
-- leaks onInterruptPtr
[C.throwBlock| void {
nix::createInterruptCallback($(void (*onInterruptPtr)()));
}|]
#ifndef __GHCIDE__
foreign import ccall "wrapper"
mkCallback :: IO () -> IO (FunPtr (IO ()))
#else
mkCallback :: IO () -> IO (FunPtr (IO ()))
mkCallback = panic "This is a stub to work around a ghcide issue. Please compile without -D__GHCIDE__"
#endif