systemd 2.0.0 → 2.1.0
raw patch · 4 files changed
+212/−104 lines, 4 files
Files
- System/Systemd/Daemon.hs +15/−103
- System/Systemd/Daemon/Fd.hs +115/−0
- System/Systemd/Internal.hs +79/−0
- systemd.cabal +3/−1
System/Systemd/Daemon.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE ForeignFunctionInterface #-} {-| Module : System.Systemd.Daemon Description : Systemd facilities to manage daemons@@ -12,6 +11,11 @@ Implementation of Systemd facilities to create and manage daemons. +All socket-related actions in this module, work with the+"Network.Socket" module from @network@. If you want to use+a different socket library or work directly with file+descriptors, see "System.Systemd.Daemon.Fd".+ This module contains socket activation and notify tools. See * <http://0pointer.de/blog/projects/socket-activation.html>@@ -71,33 +75,15 @@ , unsetEnvironnement ) where --import Control.Exception (bracket)-import Control.Monad-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Maybe-import Data.List--import qualified Data.ByteString.Char8 as BC+import qualified System.Systemd.Daemon.Fd as Fd+import System.Systemd.Internal -import Foreign.C.Error (Errno (..))-import Foreign.C.Types (CInt (..))-import Foreign.Marshal (free, mallocBytes)-import Foreign.Ptr-import System.Posix.Env-import System.Posix.Process-import System.Posix.Types (CPid (..))+import Foreign.C.Error (Errno (..))+import System.Posix.Types (CPid (..)) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Network.Socket-import Network.Socket.Address hiding (recvFrom, sendTo)-import Network.Socket.ByteString --envVariableName :: String-envVariableName = "NOTIFY_SOCKET"- -- | Notify the watchdog that the program is still alive notifyWatchdog :: IO (Maybe()) notifyWatchdog = notify False "WATCHDOG=1"@@ -140,7 +126,7 @@ -- -- Usefull for zero downtime restart storeFd :: Socket -> IO (Maybe ())-storeFd = notifyWithFD False "FDSTORE=1"+storeFd sock = socketToFd sock >>= Fd.storeFd -- | Notify systemd to store a socket for us and specify a name. --@@ -148,13 +134,7 @@ -- -- Usefull for zero downtime restart storeFdWithName :: Socket -> String -> IO (Maybe ())-storeFdWithName sock name = notifyWithFD False ("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", "LISTEN_FDNAMES"]+storeFdWithName sock name = socketToFd sock >>= flip Fd.storeFdWithName name -- | Notify systemd about an event --@@ -173,50 +153,12 @@ -- 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-- where- isValidPath path = (length path >= 2)- && ( "@" `isPrefixOf` path- || "/" `isPrefixOf` path)- notifyImpl = do- guard $ state /= ""-- socketPath <- MaybeT (getEnv envVariableName)- guard $ isValidPath socketPath- let socketPath' = if head socketPath == '@' -- For abstract socket- then '\0' : tail socketPath- else socketPath-- socketFd <- liftIO $ socket AF_UNIX Datagram 0- 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--- return ()----+notifyWithFD unset_env state sock = socketToFd sock >>= Fd.notifyWithFD unset_env state ------------------------------------------------------------------------------------------------ -- SOCKET ------------------------------------------------------------------------------------------------ -fdStart :: CInt-fdStart = 3- -- | Return a list of activated sockets, if the program was started with -- socket activation. --@@ -226,7 +168,7 @@ -- Returns 'Nothing' in systems without socket activation (or -- when the program was not socket activated). getActivatedSockets :: IO (Maybe [Socket])-getActivatedSockets = fmap (fmap fst) <$> getActivatedSocketsWithNames+getActivatedSockets = Fd.getActivatedSockets >>= traverse (mapM fdToSocket) -- | Same as 'getActivatedSockets' but return also the names associated -- with those sockets if 'storeFdWithName' was used or specified in the @.socket@ file.@@ -234,35 +176,5 @@ -- 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-- 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 = liftIO $ do- setNonBlockIfNeeded fd- mkSocket fd--sendBufWithFdTo :: Socket -> BC.ByteString -> SockAddr -> Socket -> IO Int-sendBufWithFdTo sock state addr sockToSend =- unsafeUseAsCStringLen state $ \(ptr, nbytes) ->- bracket addrPointer free $ \p_addr -> do- fd <- fdSocket sock- fdToSend <- fdSocket sockToSend- fromIntegral <$> c_sd_notify_with_fd fd ptr (fromIntegral nbytes)- p_addr (fromIntegral addrSize) fdToSend- where addrSize = sizeOfSocketAddress addr- addrPointer = mallocBytes addrSize >>= (\ptr -> pokeSocketAddress ptr addr >> pure ptr)--foreign import ccall unsafe "sd_notify_with_fd"- c_sd_notify_with_fd :: CInt -> Ptr a -> CInt -> Ptr b -> CInt -> CInt -> IO CInt+getActivatedSocketsWithNames = Fd.getActivatedSocketsWithNames >>= traverse (mapM socketWithName)+ where socketWithName (fd, name) = fmap (flip (,) name) $ fdToSocket fd
+ System/Systemd/Daemon/Fd.hs view
@@ -0,0 +1,115 @@+{-|+Module : System.Systemd.Daemon.Fd+Description : File descriptor based socket activation/management+ using systemd+Copyright : (c) Romain Gérard, 2014+ David Fisher, 2013+ Lukas Epple, 2019+License : BSD3+Maintainer : romain.gerard@erebe.eu+Stability : stable+Portability : Requires Systemd or will fail otherwise++This module implements all functions from "System.Systemd.Daemon"+that require or return 'Network.Socket.Socket's purely using 'Fd's.+This is especially useful if you have to do low level IO using+file descriptors or use a different socket library than @network@.++The API is exactly the same as "System.Systemd.Daemon" except that+'Network.Socket.Socket's have been replaced by 'Fd's (actually+"System.Systemd.Daemon" uses this module internally). This also means+that "System.Systemd.Daemon.Fd" and "System.Systemd.Daemon" expose+conflicting functions. You either have to import "System.Systemd.Daemon.Fd"+@qualified@ or like so:++@+import System.Systemd.Daemon hiding ( notifyWithFD, storeFd+ , storeFdWithName+ , getActivatedSockets+ , getActivatedSocketsWithNames )+import System.Systemd.Daemon.Fd+@++The functions in "System.Systemd.Daemon" that are not implemented+in this module are 100% compatible with "System.Systemd.Daemon.Fd".+-}+module System.Systemd.Daemon.Fd+ ( -- * Notify functions+ notifyWithFD+ , storeFd+ , storeFdWithName+ -- * Socket activation functions+ , getActivatedSockets+ , getActivatedSocketsWithNames+ ) where++import Control.Monad+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Maybe+import qualified Data.ByteString.Char8 as BC+import Foreign.C.Types (CInt (..))+import Network.Socket (setNonBlockIfNeeded)+import System.Posix.Env (getEnv)+import System.Posix.Process+import System.Posix.Types (Fd (..))+import System.Systemd.Internal++fdStart :: CInt+fdStart = 3++-- | Notify Systemd to store a file descriptor for us. This together+-- with 'getActivatedSockets' allows for zero downtime+-- restarts and socket activation.+--+-- Equivalent to standard 'System.Systemd.Daemon.storeFd'+storeFd :: Fd -> IO (Maybe ())+storeFd = notifyWithFD False "FDSTORE=1"++-- | Like 'storeFd', but associate the file descriptor with a name.+-- Best used along with 'getActivatedSocketsWithNames'.+--+-- Equivalent to standard 'System.Systemd.Daemon.storeFdWithName'+storeFdWithName :: Fd -> String -> IO (Maybe ())+storeFdWithName fd name = notifyWithFD False ("FDSTORE=1\nFDNAME=" ++ name) fd++-- | Same as 'System.Systemd.Daemon.notify', but send along a 'Fd'.+-- Note that the caller must set the message, i. e. send @FDSTORE=1@+-- to actually store the file descriptor. In most cases it is probably best+-- to use 'storeFd' or the notify-functions from "System.Systemd.Daemon".+--+-- Equivalent to standard 'System.Systemd.Daemon.notifyWithFD'.+notifyWithFD :: Bool -> String -> Fd -> IO (Maybe ())+notifyWithFD unset_env state sock = notifyWithFD_ unset_env state (Just sock)++-- | Return 'Just' a list of file descriptors if the current process+-- has been activated with one or more socket by systemd, 'Nothing'+-- otherwise.+--+-- The file descriptors are in the same order as the sockets in the+-- associated @.socket@ file. The sockets will have their family, type,+-- and status set according to the @.socket@ file.+--+-- Equivalent to standard 'System.Systemd.Daemon.getActivatedSockets'+getActivatedSockets :: IO (Maybe [Fd])+getActivatedSockets = fmap (fmap fst) <$> getActivatedSocketsWithNames++-- | Like 'getActivatedSockets', but also return the associated names.+-- If a file descriptor has no associated name, it will be a generic+-- one set by systemd.+--+-- Equivalent to standard 'System.Systemd.Daemon.getActivatedSocketsWithNames'+getActivatedSocketsWithNames :: IO (Maybe [(Fd, 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++ let listenFDNames' = fmap BC.unpack $ BC.split ':' $ BC.pack listenFDNames+ nonBlockFds <- mapM (\fd -> liftIO (setNonBlockIfNeeded fd) >> pure (Fd fd))+ [fdStart .. fdStart + listenFDs - 1]+ guard $ length nonBlockFds == length listenFDNames'++ return $ zip nonBlockFds listenFDNames'
+ System/Systemd/Internal.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module System.Systemd.Internal where++import Control.Exception (bracket)+import Control.Monad+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Maybe+import qualified Data.ByteString.Char8 as BC+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.List+import Foreign.C.Types (CInt (..))+import Foreign.Marshal (free, mallocBytes)+import Foreign.Ptr+import Network.Socket+import Network.Socket.Address hiding (recvFrom, sendTo)+import Network.Socket.ByteString+import System.Posix.Env+import System.Posix.Types (Fd (..))++envVariableName :: String+envVariableName = "NOTIFY_SOCKET"++foreign import ccall unsafe "sd_notify_with_fd"+ c_sd_notify_with_fd :: CInt -> Ptr a -> CInt -> Ptr b -> CInt -> CInt -> IO CInt++-- | Unset all environnement variable related to Systemd.+--+-- Calls to functions like 'System.Systemd.Daemon.notify' and+-- 'System.Systemd.Daemon.getActivatedSockets' will return+-- 'Nothing' after that.+unsetEnvironnement :: IO ()+unsetEnvironnement = mapM_ unsetEnv [envVariableName, "LISTEN_PID", "LISTEN_FDS", "LISTEN_FDNAMES"]++sendBufWithFdTo :: Socket -> BC.ByteString -> SockAddr -> Fd -> IO Int+sendBufWithFdTo sock state addr fdToSend =+ unsafeUseAsCStringLen state $ \(ptr, nbytes) ->+ bracket addrPointer free $ \p_addr -> do+ fd <- socketToFd sock+ fromIntegral <$> c_sd_notify_with_fd (fromIntegral fd) ptr (fromIntegral nbytes)+ p_addr (fromIntegral addrSize) (fromIntegral fdToSend)+ where addrSize = sizeOfSocketAddress addr+ addrPointer = mallocBytes addrSize >>= (\ptr -> pokeSocketAddress ptr addr >> pure ptr)++notifyWithFD_ :: Bool -> String -> Maybe Fd -> IO (Maybe ())+notifyWithFD_ unset_env state fd = do+ res <- runMaybeT notifyImpl+ when unset_env unsetEnvironnement+ return res++ where+ isValidPath path = (length path >= 2)+ && ( "@" `isPrefixOf` path+ || "/" `isPrefixOf` path)+ notifyImpl = do+ guard $ state /= ""++ socketPath <- MaybeT (getEnv envVariableName)+ guard $ isValidPath socketPath+ let socketPath' = if head socketPath == '@' -- For abstract socket+ then '\0' : tail socketPath+ else socketPath++ socketFd <- liftIO $ socket AF_UNIX Datagram 0+ nbBytes <- liftIO $ case fd 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+++ return ()++socketToFd :: Socket -> IO Fd+socketToFd = fmap Fd . fdSocket++fdToSocket :: Fd -> IO Socket+fdToSocket = mkSocket . fromIntegral
systemd.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: systemd-version: 2.0.0+version: 2.1.0 synopsis: Systemd facilities (Socket activation, Notify) description: A module for Systemd facilities. homepage: https://github.com/erebe/systemd@@ -23,6 +23,8 @@ library ghc-options: -Wall exposed-modules: System.Systemd.Daemon+ , System.Systemd.Daemon.Fd+ other-modules: System.Systemd.Internal c-sources: System/Systemd/socket_info.c build-depends: base == 4.* , unix >= 2.5,