diff --git a/System/Systemd/Daemon.hs b/System/Systemd/Daemon.hs --- a/System/Systemd/Daemon.hs +++ b/System/Systemd/Daemon.hs @@ -12,9 +12,9 @@ Implementation of Systemd facilities to create and manage daemons. -This module contains socket activation and notify tools. See +This module contains socket activation and notify tools. See -* +* * * @@ -31,7 +31,7 @@ @ If you use the service described as below, -Systemd will restart your program each time the watchdog +Systemd will restart your program each time the watchdog fail to notify itself under 60 sec. @ @@ -53,6 +53,9 @@ module System.Systemd.Daemon ( -- * Notify functions notify + , notifyWithFD + , storeFd + , storeFdWithName , notifyWatchdog , notifyReady , notifyPID @@ -63,6 +66,7 @@ , notifyStopping -- * Socket activation functions , getActivatedSockets + , getActivatedSocketsWithNames -- * Utils , unsetEnvironnement ) where @@ -78,12 +82,15 @@ import Foreign.C.Error (Errno (..)) import Foreign.C.Types (CInt (..)) +import Foreign.Ptr import System.Posix.Env import System.Posix.Process import System.Posix.Types (CPid (..)) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Network.Socket hiding (recv, recvFrom, send, sendTo) import Network.Socket.ByteString +import Network.Socket.Internal (withSockAddr) @@ -124,10 +131,22 @@ notifyBusError :: String -> IO (Maybe()) notifyBusError msg = notify False $ "BUSERROR=" ++ msg +-- | Notify systemd to store a socket for us +-- To be used along getActivatedSockets during a restart +-- usefull for zero downtime restart +storeFd :: Bool -> Socket -> IO (Maybe ()) +storeFd unset_env = notifyWithFD unset_env "FDSTORE=1" + +-- | Notify systemd to store a socket for us and specify a name +-- To be used along getActivatedSocketsWithNames during a restart +-- usefull for zero downtime restart +storeFdWithName :: Bool -> Socket -> String -> IO (Maybe ()) +storeFdWithName unset_env sock name = notifyWithFD unset_env ("FDSTORE=1\nFDNAME=" ++ name) sock + -- | Unset all environnement variable related to Systemd. -- Calls to 'notify' like and 'getActivatedSockets' functions will return 'Nothing' after that unsetEnvironnement :: IO () -unsetEnvironnement = mapM_ unsetEnv [envVariableName, "LISTEN_PID", "LISTEN_FDS"] +unsetEnvironnement = mapM_ unsetEnv [envVariableName, "LISTEN_PID", "LISTEN_FDS", "LISTEN_FDNAMES"] -- | Notify systemd about an event -- After notifying systemd the 'Bool' parameter specify if the environnement @@ -136,7 +155,16 @@ -- Returns @Nothing@ if the program was not started with systemd -- or that the environnement was previously unset notify :: Bool -> String -> IO (Maybe ()) -notify unset_env state = do +notify unset_env state = notifyWithFD_ unset_env state Nothing + +-- | Same as @notify@ but send a long a socket to be stored +-- It is up to the caller to properly set the message +-- (i.e: do not forget to set FDSTORE=1) +notifyWithFD :: Bool -> String -> Socket -> IO (Maybe ()) +notifyWithFD unset_env state sock = notifyWithFD_ unset_env state (Just sock) + +notifyWithFD_ :: Bool -> String -> Maybe Socket -> IO (Maybe ()) +notifyWithFD_ unset_env state sock = do res <- runMaybeT notifyImpl when unset_env unsetEnvironnement return res @@ -155,7 +183,11 @@ else socketPath socketFd <- liftIO $ socket AF_UNIX Datagram 0 - nbBytes <- liftIO $ sendTo socketFd (BC.pack state) (SockAddrUnix socketPath') + nbBytes <- liftIO $ case sock of + Nothing -> sendTo socketFd (BC.pack state) (SockAddrUnix socketPath') + Just sock' -> sendBufWithFdTo socketFd (BC.pack state) + (SockAddrUnix socketPath') sock' + liftIO $ close socketFd guard $ nbBytes >= length state @@ -164,6 +196,8 @@ + + ------------------------------------------------------------------------------------------------ -- SOCKET ------------------------------------------------------------------------------------------------ @@ -177,12 +211,27 @@ -- and status set appropriately. Returns @Nothing@ in systems without socket activation (or -- when the program was not socket activated). getActivatedSockets :: IO (Maybe [Socket]) -getActivatedSockets = runMaybeT $ do - listenPid <- read <$> MaybeT (getEnv "LISTEN_PID") - listenFDs <- read <$> MaybeT (getEnv "LISTEN_FDS") - myPid <- liftIO getProcessID +getActivatedSockets = fmap (fmap fst) <$> getActivatedSocketsWithNames + +-- | Same as @getActivatedSockets@ but return also the name associated +-- with those sockets if @storeFdWithName@ was used. IF @storeFd@ was +-- used to transmit the socket to systemd, the name will be a generic one +-- (i.e: usally "stored") +getActivatedSocketsWithNames :: IO (Maybe [(Socket, String)]) +getActivatedSocketsWithNames = runMaybeT $ do + listenPid <- read <$> MaybeT (getEnv "LISTEN_PID") + listenFDs <- read <$> MaybeT (getEnv "LISTEN_FDS") + listenFDNames <- MaybeT (getEnv "LISTEN_FDNAMES") + + myPid <- liftIO getProcessID guard $ listenPid == myPid - mapM makeSocket [fdStart .. fdStart + listenFDs - 1] + + let listenFDNames' = fmap BC.unpack $ BC.split ':' $ BC.pack listenFDNames + sockets <- mapM makeSocket [fdStart .. fdStart + listenFDs - 1] + guard $ length sockets == length listenFDNames' + + return $ zip sockets listenFDNames' + where makeSocket :: CInt -> MaybeT IO Socket makeSocket fd = do fam <- socketFamily fd @@ -216,6 +265,14 @@ 1 -> return Listening _ -> mzero + +sendBufWithFdTo :: Socket -> BC.ByteString -> SockAddr -> Socket -> IO Int +sendBufWithFdTo sock state addr sockToSend = + unsafeUseAsCStringLen state $ \(ptr, nbytes) -> + withSockAddr addr $ \p_addr sz -> + fromIntegral <$> c_sd_notify_with_fd (fdSocket sock) ptr (fromIntegral nbytes) + p_addr (fromIntegral sz) (fdSocket sockToSend) + foreign import ccall unsafe "socket_family" c_socket_family :: CInt -> IO CInt @@ -224,3 +281,6 @@ foreign import ccall unsafe "socket_listening" c_socket_listening :: CInt -> IO CInt + +foreign import ccall unsafe "sd_notify_with_fd" + c_sd_notify_with_fd :: CInt -> Ptr a -> CInt -> Ptr b -> CInt -> CInt -> IO CInt diff --git a/System/Systemd/socket_info.c b/System/Systemd/socket_info.c --- a/System/Systemd/socket_info.c +++ b/System/Systemd/socket_info.c @@ -1,4 +1,5 @@ #include +#include int socket_family(int fd) { struct sockaddr sockaddr = {}; @@ -32,3 +33,41 @@ return accepting; } + + +int sd_notify_with_fd(int sock + , char *str, size_t len // message to send + , struct sockaddr *dest, socklen_t lenaddr // for who + , int outfd // The file descriptor to send along + ) +{ + struct msghdr msg = {0}; + + // Attach the message + struct iovec iov[1]; + iov[0].iov_base = str; + iov[0].iov_len = len; + msg.msg_iov = iov; + msg.msg_iovlen = sizeof(iov) / sizeof(iov[0]); + + // Write to who to send + msg.msg_name = dest; + msg.msg_namelen = lenaddr; + + // Attach extra header with the file descriptor in it + char ancBuffer[CMSG_SPACE(sizeof(outfd))]; + msg.msg_control = ancBuffer; + msg.msg_controllen = sizeof(ancBuffer); + + struct cmsghdr *cmsg = CMSG_FIRSTHDR(&msg); + cmsg->cmsg_level = SOL_SOCKET; + cmsg->cmsg_type = SCM_RIGHTS; + cmsg->cmsg_len = CMSG_LEN(sizeof(outfd)); + char *dPtr = (char*)CMSG_DATA(cmsg); + + *(int*)dPtr = outfd; + msg.msg_controllen = cmsg->cmsg_len; + + return sendmsg(sock, &msg, 0); +} + diff --git a/systemd.cabal b/systemd.cabal --- a/systemd.cabal +++ b/systemd.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: systemd -version: 1.0.6 +version: 1.1.0 synopsis: Systemd facilities (Socket activation, Notify) description: A module for Systemd facilities. homepage: https://github.com/erebe/systemd @@ -21,6 +21,7 @@ location: https://github.com/erebe/systemd library + ghc-options: -Wall exposed-modules: System.Systemd.Daemon c-sources: System/Systemd/socket_info.c build-depends: base == 4.* , @@ -37,5 +38,7 @@ main-is: Main.hs default-language: Haskell2010 build-depends: base == 4.*, + network >=2.3, + unix >= 2.5, systemd default-language: Haskell2010 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -2,14 +2,40 @@ import System.Systemd.Daemon import Control.Monad import Control.Concurrent +import Network +import System.IO +import Data.Char +import System.Posix.Env as Ev +apF :: Show w => w -> IO () +apF = appendFile "/home/erebe/log" . (++ "\n") . show + main :: IO () -main = forever runner +main = do + hSetBuffering stdout LineBuffering + ev <- Ev.getEnvironment + apF ev + + apF "totot" + ev' <- getActivatedSocketsWithNames + apF ev' + apF "totot" + + threadDelay $ 1000000 * 20 + s <- listenOn (PortNumber 1213) + s' <- listenOn (PortNumber 1214) + + x <- storeFd False s + apF x + x <- storeFdWithName False s' "tutu" + apF x + forever (runner s) where - runner = do + runner s = do res <- notifyWatchdog - print res + x <- notifyWithFD False "FDSTORE=1" s + apF x threadDelay $ 1000000 * 2