systemd 1.0.6 → 1.1.0
raw patch · 4 files changed
+143/−15 lines, 4 files
Files
- System/Systemd/Daemon.hs +71/−11
- System/Systemd/socket_info.c +39/−0
- systemd.cabal +4/−1
- test/Main.hs +29/−3
System/Systemd/Daemon.hs view
@@ -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 -* <http://0pointer.de/blog/projects/socket-activation.html> +* <http://0pointer.de/blog/projects/socket-activation.html> * <http://www.freedesktop.org/software/systemd/man/systemd.socket.html> * <http://www.freedesktop.org/software/systemd/man/systemd.service.html> @@ -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
System/Systemd/socket_info.c view
@@ -1,4 +1,5 @@ #include <sys/socket.h>+#include <string.h> 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);+}+
systemd.cabal view
@@ -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
test/Main.hs view
@@ -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