├── .github └── workflows │ └── haskell.yml ├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── System └── Systemd │ ├── Daemon.hs │ ├── Daemon │ └── Fd.hs │ ├── Internal.hs │ └── socket_info.c ├── ressources └── test.service ├── stack.yaml ├── systemd.cabal └── test └── Main.hs /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: Haskell CI 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | build: 11 | 12 | runs-on: ubuntu-latest 13 | 14 | steps: 15 | - uses: actions/checkout@v2 16 | - name: Setup GHC 17 | run: | 18 | stack setup 19 | 20 | - name: Setup GHC 21 | run: | 22 | stack build 23 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-newstyle 3 | .ghc.environment.* 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | .virtualenv 10 | .hsenv 11 | .cabal-sandbox/ 12 | cabal.sandbox.config 13 | cabal.config 14 | *.log 15 | tags 16 | bin/ 17 | .stack-work/ 18 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, David Fisher 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of David Fisher nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell implementation for systemd 2 | 3 | Systemd offers some functionnalities to developpers for creating daemons process 4 | 5 | 6 | - [Watchdog](http://www.freedesktop.org/software/systemd/man/sd_notify.html) 7 | - [Socket activation](http://0pointer.de/blog/projects/socket-activation.html) 8 | - journal log 9 | 10 | Documentation and the package is [available on hackage](https://hackage.haskell.org/package/systemd/docs/System-Systemd-Daemon.html) 11 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /System/Systemd/Daemon.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : System.Systemd.Daemon 3 | Description : Systemd facilities to manage daemons 4 | Copyright : (c) Romain Gérard, 2014 5 | David Fisher, 2013 6 | License : BSD3 7 | Maintainer : romain.gerard@erebe.eu 8 | Stability : stable 9 | Portability : Require Systemd or will fail otherwise 10 | 11 | Implementation of Systemd facilities to create and manage 12 | daemons. 13 | 14 | All socket-related actions in this module, work with the 15 | "Network.Socket" module from @network@. If you want to use 16 | a different socket library or work directly with file 17 | descriptors, see "System.Systemd.Daemon.Fd". 18 | 19 | This module contains socket activation and notify tools. See 20 | 21 | * 22 | * 23 | * 24 | 25 | Example: 26 | 27 | @ 28 | import Control.Monad(forever) 29 | import System.Systemd.Daemon(notifyWatchdog) 30 | 31 | main :: IO () 32 | main = forever $ do 33 | functionThatMayHang 34 | notifyWatchdog 35 | @ 36 | 37 | If you use the service described as below, 38 | Systemd will restart your program each time the watchdog 39 | fail to notify itself under 60 sec. 40 | 41 | @ 42 | [Unit] 43 | Description=MyDaemon 44 | 45 | [Service] 46 | Type=simple 47 | TimeoutStartSec=0 48 | ExecStart=AbsolutePathToMyExecutable 49 | WatchdogSec=60 50 | Restart=on-failure 51 | 52 | [Install] 53 | WantedBy=multi-user.target 54 | @ 55 | -} 56 | 57 | module System.Systemd.Daemon ( 58 | -- * Notify functions 59 | notify 60 | , notifyWithFD 61 | , storeFd 62 | , storeFdWithName 63 | , notifyWatchdog 64 | , notifyReady 65 | , notifyPID 66 | , notifyErrno 67 | , notifyStatus 68 | , notifyBusError 69 | , notifyReloading 70 | , notifyStopping 71 | -- * Socket activation functions 72 | , getActivatedSockets 73 | , getActivatedSocketsWithNames 74 | -- * Utils 75 | , unsetEnvironnement 76 | ) where 77 | 78 | import qualified System.Systemd.Daemon.Fd as Fd 79 | import System.Systemd.Internal 80 | 81 | import Foreign.C.Error (Errno (..)) 82 | import System.Posix.Types (CPid (..)) 83 | 84 | import Network.Socket 85 | 86 | 87 | -- | Notify the watchdog that the program is still alive 88 | notifyWatchdog :: IO (Maybe()) 89 | notifyWatchdog = notify False "WATCHDOG=1" 90 | 91 | -- | Notify the systemd that the program is ready 92 | notifyReady :: IO (Maybe()) 93 | notifyReady = notify False "READY=1" 94 | 95 | -- | Notify systemd of the PID of the program (for after a fork) 96 | notifyPID :: CPid -> IO (Maybe()) 97 | notifyPID pid = notify False $ "MAINPID=" ++ show pid 98 | 99 | -- | Notify systemd that the service is reloading its configuration 100 | notifyReloading :: IO (Maybe()) 101 | notifyReloading = notify False "RELOADING=1" 102 | 103 | -- | Notify systemd that the service is beginning its shutdown 104 | notifyStopping :: IO (Maybe()) 105 | notifyStopping = notify False "STOPPING=1" 106 | 107 | -- | Notify systemd of an 'Errno' error 108 | notifyErrno :: Errno -> IO (Maybe()) 109 | notifyErrno (Errno errorNb) = notify False $ "ERRNO=" ++ show errorNb 110 | 111 | -- | Notify systemd of the status of the program. 112 | -- 113 | -- An arbitrary 'String' can be passed 114 | notifyStatus :: String -> IO (Maybe()) 115 | notifyStatus msg = notify False $ "STATUS=" ++ msg 116 | 117 | -- | Notify systemd of a DBUS error like. 118 | -- 119 | -- Correct formatting of the 'String' is left to the caller 120 | notifyBusError :: String -> IO (Maybe()) 121 | notifyBusError msg = notify False $ "BUSERROR=" ++ msg 122 | 123 | -- | Notify systemd to store a socket for us. 124 | -- 125 | -- To be used along 'getActivatedSockets' during a restart 126 | -- 127 | -- Usefull for zero downtime restart 128 | storeFd :: Socket -> IO (Maybe ()) 129 | storeFd sock = socketToFd_ sock >>= Fd.storeFd 130 | 131 | -- | Notify systemd to store a socket for us and specify a name. 132 | -- 133 | -- To be used along 'getActivatedSocketsWithNames' during a restart 134 | -- 135 | -- Usefull for zero downtime restart 136 | storeFdWithName :: Socket -> String -> IO (Maybe ()) 137 | storeFdWithName sock name = socketToFd_ sock >>= flip Fd.storeFdWithName name 138 | 139 | -- | Notify systemd about an event 140 | -- 141 | -- After notifying systemd the 'Bool' parameter specify if the environnement 142 | -- shall be unset (Further call to notify will fail) 143 | -- 144 | -- The 'String' is the event to pass 145 | -- 146 | -- Returns 'Nothing' if the program was not started with systemd 147 | -- or that the environnement was previously unset 148 | notify :: Bool -> String -> IO (Maybe ()) 149 | notify unset_env state = notifyWithFD_ unset_env state Nothing 150 | 151 | -- | Same as 'notify' but send along a socket to be stored 152 | -- 153 | -- It is up to the caller to properly set the message 154 | -- (i.e: do not forget to set FDSTORE=1) 155 | notifyWithFD :: Bool -> String -> Socket -> IO (Maybe ()) 156 | notifyWithFD unset_env state sock = socketToFd_ sock >>= Fd.notifyWithFD unset_env state 157 | 158 | ------------------------------------------------------------------------------------------------ 159 | -- SOCKET 160 | ------------------------------------------------------------------------------------------------ 161 | 162 | -- | Return a list of activated sockets, if the program was started with 163 | -- socket activation. 164 | -- 165 | -- The sockets are in the same order as in the associated @.socket@ file. 166 | -- The sockets will have their family, type, and status set appropriately. 167 | -- 168 | -- Returns 'Nothing' in systems without socket activation (or 169 | -- when the program was not socket activated). 170 | getActivatedSockets :: IO (Maybe [Socket]) 171 | getActivatedSockets = Fd.getActivatedSockets >>= traverse (mapM fdToSocket) 172 | 173 | -- | Same as 'getActivatedSockets' but return also the names associated 174 | -- with those sockets if 'storeFdWithName' was used or specified in the @.socket@ file. 175 | -- 176 | -- IF 'storeFd' was used to transmit the socket to systemd, the name will be a generic one 177 | -- (i.e: usally "stored") 178 | getActivatedSocketsWithNames :: IO (Maybe [(Socket, String)]) 179 | getActivatedSocketsWithNames = Fd.getActivatedSocketsWithNames >>= traverse (mapM socketWithName) 180 | where socketWithName (fd, name) = fmap (flip (,) name) $ fdToSocket fd 181 | -------------------------------------------------------------------------------- /System/Systemd/Daemon/Fd.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : System.Systemd.Daemon.Fd 3 | Description : File descriptor based socket activation/management 4 | using systemd 5 | Copyright : (c) Romain Gérard, 2014 6 | David Fisher, 2013 7 | Lukas Epple, 2019 8 | License : BSD3 9 | Maintainer : romain.gerard@erebe.eu 10 | Stability : stable 11 | Portability : Requires Systemd or will fail otherwise 12 | 13 | This module implements all functions from "System.Systemd.Daemon" 14 | that require or return 'Network.Socket.Socket's purely using 'Fd's. 15 | This is especially useful if you have to do low level IO using 16 | file descriptors or use a different socket library than @network@. 17 | 18 | The API is exactly the same as "System.Systemd.Daemon" except that 19 | 'Network.Socket.Socket's have been replaced by 'Fd's (actually 20 | "System.Systemd.Daemon" uses this module internally). This also means 21 | that "System.Systemd.Daemon.Fd" and "System.Systemd.Daemon" expose 22 | conflicting functions. You either have to import "System.Systemd.Daemon.Fd" 23 | @qualified@ or like so: 24 | 25 | @ 26 | import System.Systemd.Daemon hiding ( notifyWithFD, storeFd 27 | , storeFdWithName 28 | , getActivatedSockets 29 | , getActivatedSocketsWithNames ) 30 | import System.Systemd.Daemon.Fd 31 | @ 32 | 33 | The functions in "System.Systemd.Daemon" that are not implemented 34 | in this module are 100% compatible with "System.Systemd.Daemon.Fd". 35 | -} 36 | module System.Systemd.Daemon.Fd 37 | ( -- * Notify functions 38 | notifyWithFD 39 | , storeFd 40 | , storeFdWithName 41 | -- * Socket activation functions 42 | , getActivatedSockets 43 | , getActivatedSocketsWithNames 44 | ) where 45 | 46 | import Control.Monad 47 | import Control.Monad.IO.Class (liftIO) 48 | import Control.Monad.Trans.Maybe 49 | import qualified Data.ByteString.Char8 as BC 50 | import Foreign.C.Types (CInt (..)) 51 | import Network.Socket (setNonBlockIfNeeded) 52 | import System.Posix.Env (getEnv) 53 | import System.Posix.Process 54 | import System.Posix.Types (Fd (..)) 55 | import System.Systemd.Internal 56 | 57 | fdStart :: CInt 58 | fdStart = 3 59 | 60 | -- | Notify Systemd to store a file descriptor for us. This together 61 | -- with 'getActivatedSockets' allows for zero downtime 62 | -- restarts and socket activation. 63 | -- 64 | -- Equivalent to standard 'System.Systemd.Daemon.storeFd' 65 | storeFd :: Fd -> IO (Maybe ()) 66 | storeFd = notifyWithFD False "FDSTORE=1" 67 | 68 | -- | Like 'storeFd', but associate the file descriptor with a name. 69 | -- Best used along with 'getActivatedSocketsWithNames'. 70 | -- 71 | -- Equivalent to standard 'System.Systemd.Daemon.storeFdWithName' 72 | storeFdWithName :: Fd -> String -> IO (Maybe ()) 73 | storeFdWithName fd name = notifyWithFD False ("FDSTORE=1\nFDNAME=" ++ name) fd 74 | 75 | -- | Same as 'System.Systemd.Daemon.notify', but send along a 'Fd'. 76 | -- Note that the caller must set the message, i. e. send @FDSTORE=1@ 77 | -- to actually store the file descriptor. In most cases it is probably best 78 | -- to use 'storeFd' or the notify-functions from "System.Systemd.Daemon". 79 | -- 80 | -- Equivalent to standard 'System.Systemd.Daemon.notifyWithFD'. 81 | notifyWithFD :: Bool -> String -> Fd -> IO (Maybe ()) 82 | notifyWithFD unset_env state sock = notifyWithFD_ unset_env state (Just sock) 83 | 84 | -- | Return 'Just' a list of file descriptors if the current process 85 | -- has been activated with one or more socket by systemd, 'Nothing' 86 | -- otherwise. 87 | -- 88 | -- The file descriptors are in the same order as the sockets in the 89 | -- associated @.socket@ file. The sockets will have their family, type, 90 | -- and status set according to the @.socket@ file. 91 | -- 92 | -- Equivalent to standard 'System.Systemd.Daemon.getActivatedSockets' 93 | getActivatedSockets :: IO (Maybe [Fd]) 94 | getActivatedSockets = runMaybeT $ do 95 | listenPid <- read <$> MaybeT (getEnv "LISTEN_PID") 96 | listenFDs <- read <$> MaybeT (getEnv "LISTEN_FDS") 97 | 98 | myPid <- liftIO getProcessID 99 | guard $ listenPid == myPid 100 | 101 | mapM (\fd -> liftIO (setNonBlockIfNeeded fd) >> pure (Fd fd)) 102 | [fdStart .. fdStart + listenFDs - 1] 103 | 104 | -- | Like 'getActivatedSockets', but also return the associated names. 105 | -- If a file descriptor has no associated name, it will be a generic 106 | -- one set by systemd. 107 | -- 108 | -- Equivalent to standard 'System.Systemd.Daemon.getActivatedSocketsWithNames' 109 | getActivatedSocketsWithNames :: IO (Maybe [(Fd, String)]) 110 | getActivatedSocketsWithNames = runMaybeT $ do 111 | listenFDNames <- MaybeT (getEnv "LISTEN_FDNAMES") 112 | let listenFDNames' = fmap BC.unpack $ BC.split ':' $ BC.pack listenFDNames 113 | 114 | nonBlockFds <- MaybeT getActivatedSockets 115 | guard $ length nonBlockFds == length listenFDNames' 116 | 117 | return $ zip nonBlockFds listenFDNames' 118 | -------------------------------------------------------------------------------- /System/Systemd/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | module System.Systemd.Internal where 4 | 5 | import Control.Exception (bracket) 6 | import Control.Monad 7 | import Control.Monad.IO.Class (liftIO) 8 | import Control.Monad.Trans.Maybe 9 | import qualified Data.ByteString.Char8 as BC 10 | import Data.ByteString.Unsafe (unsafeUseAsCStringLen) 11 | import Data.List 12 | import Foreign.C.Types (CInt (..)) 13 | import Foreign.Marshal (free, mallocBytes) 14 | import Foreign.Ptr 15 | import Network.Socket 16 | import Network.Socket.Address hiding (recvFrom, sendTo) 17 | import Network.Socket.ByteString 18 | import System.Posix.Env 19 | import System.Posix.Types (Fd (..)) 20 | 21 | envVariableName :: String 22 | envVariableName = "NOTIFY_SOCKET" 23 | 24 | foreign import ccall unsafe "sd_notify_with_fd" 25 | c_sd_notify_with_fd :: CInt -> Ptr a -> CInt -> Ptr b -> CInt -> CInt -> IO CInt 26 | 27 | -- | Unset all environnement variable related to Systemd. 28 | -- 29 | -- Calls to functions like 'System.Systemd.Daemon.notify' and 30 | -- 'System.Systemd.Daemon.getActivatedSockets' will return 31 | -- 'Nothing' after that. 32 | unsetEnvironnement :: IO () 33 | unsetEnvironnement = mapM_ unsetEnv [envVariableName, "LISTEN_PID", "LISTEN_FDS", "LISTEN_FDNAMES"] 34 | 35 | sendBufWithFdTo :: Socket -> BC.ByteString -> SockAddr -> Fd -> IO Int 36 | sendBufWithFdTo sock state addr fdToSend = 37 | unsafeUseAsCStringLen state $ \(ptr, nbytes) -> 38 | bracket addrPointer free $ \p_addr -> do 39 | fd <- socketToFd sock 40 | fromIntegral <$> c_sd_notify_with_fd (fromIntegral fd) ptr (fromIntegral nbytes) 41 | p_addr (fromIntegral addrSize) (fromIntegral fdToSend) 42 | where addrSize = sizeOfSocketAddress addr 43 | addrPointer = mallocBytes addrSize >>= (\ptr -> pokeSocketAddress ptr addr >> pure ptr) 44 | 45 | notifyWithFD_ :: Bool -> String -> Maybe Fd -> IO (Maybe ()) 46 | notifyWithFD_ unset_env state fd = do 47 | res <- runMaybeT notifyImpl 48 | when unset_env unsetEnvironnement 49 | return res 50 | 51 | where 52 | isValidPath path = (length path >= 2) 53 | && ( "@" `isPrefixOf` path 54 | || "/" `isPrefixOf` path) 55 | notifyImpl = do 56 | guard $ state /= "" 57 | 58 | socketPath <- MaybeT (getEnv envVariableName) 59 | guard $ isValidPath socketPath 60 | let socketPath' = if head socketPath == '@' -- For abstract socket 61 | then '\0' : tail socketPath 62 | else socketPath 63 | 64 | socketFd <- liftIO $ socket AF_UNIX Datagram 0 65 | nbBytes <- liftIO $ case fd of 66 | Nothing -> sendTo socketFd (BC.pack state) (SockAddrUnix socketPath') 67 | Just sock' -> sendBufWithFdTo socketFd (BC.pack state) 68 | (SockAddrUnix socketPath') sock' 69 | 70 | liftIO $ close socketFd 71 | guard $ nbBytes >= length state 72 | 73 | 74 | return () 75 | 76 | socketToFd_ :: Socket -> IO Fd 77 | #if ! MIN_VERSION_network(3,1,0) 78 | socketToFd_ = fmap Fd . fdSocket 79 | #else 80 | socketToFd_ = fmap Fd . unsafeFdSocket 81 | #endif 82 | 83 | fdToSocket :: Fd -> IO Socket 84 | fdToSocket = mkSocket . fromIntegral 85 | -------------------------------------------------------------------------------- /System/Systemd/socket_info.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | int socket_family(int fd) { 5 | struct sockaddr sockaddr = {}; 6 | socklen_t len = sizeof(sockaddr); 7 | 8 | if (getsockname(fd, &sockaddr, &len) < 0) 9 | return -1; 10 | 11 | if (len < sizeof(sa_family_t)) 12 | return -1; 13 | 14 | return sockaddr.sa_family; 15 | } 16 | 17 | int socket_type(int fd) { 18 | int type = 0; 19 | socklen_t len = sizeof(type); 20 | 21 | if (getsockopt(fd, SOL_SOCKET, SO_TYPE, &type, &len) < 0) 22 | return -1; 23 | 24 | return type; 25 | } 26 | 27 | int socket_listening(int fd) { 28 | int accepting = 0; 29 | socklen_t len = sizeof(accepting); 30 | 31 | if (getsockopt(fd, SOL_SOCKET, SO_ACCEPTCONN, &accepting, &len) < 0) 32 | return -1; 33 | 34 | return accepting; 35 | } 36 | 37 | 38 | int sd_notify_with_fd(int sock 39 | , char *str, size_t len // message to send 40 | , struct sockaddr *dest, socklen_t lenaddr // for who 41 | , int outfd // The file descriptor to send along 42 | ) 43 | { 44 | struct msghdr msg = {0}; 45 | 46 | // Attach the message 47 | struct iovec iov[1]; 48 | iov[0].iov_base = str; 49 | iov[0].iov_len = len; 50 | msg.msg_iov = iov; 51 | msg.msg_iovlen = sizeof(iov) / sizeof(iov[0]); 52 | 53 | // Write to who to send 54 | msg.msg_name = dest; 55 | msg.msg_namelen = lenaddr; 56 | 57 | // Attach extra header with the file descriptor in it 58 | char ancBuffer[CMSG_SPACE(sizeof(outfd))]; 59 | msg.msg_control = ancBuffer; 60 | msg.msg_controllen = sizeof(ancBuffer); 61 | 62 | struct cmsghdr *cmsg = CMSG_FIRSTHDR(&msg); 63 | cmsg->cmsg_level = SOL_SOCKET; 64 | cmsg->cmsg_type = SCM_RIGHTS; 65 | cmsg->cmsg_len = CMSG_LEN(sizeof(outfd)); 66 | char *dPtr = (char*)CMSG_DATA(cmsg); 67 | 68 | *(int*)dPtr = outfd; 69 | msg.msg_controllen = cmsg->cmsg_len; 70 | 71 | return sendmsg(sock, &msg, 0); 72 | } 73 | 74 | -------------------------------------------------------------------------------- /ressources/test.service: -------------------------------------------------------------------------------- 1 | [Unit] 2 | Description=MyDaemon 3 | 4 | [Service] 5 | Type=simple 6 | TimeoutStartSec=0 7 | ExecStart=/home/erebe/programmation/haskell/systemd/dist/build/daemon-test/daemon-test 8 | WatchdogSec=60 9 | Restart=on-failure 10 | 11 | [Install] 12 | WantedBy=multi-user.target 13 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-22.28 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: ["network-3.2.1.0"] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Extra package databases containing global packages 17 | extra-package-dbs: [] 18 | 19 | # Control whether we use the GHC we find on the path 20 | # system-ghc: true 21 | 22 | # Require a specific version of stack, using version ranges 23 | # require-stack-version: -any # Default 24 | # require-stack-version: >= 0.1.10.0 25 | 26 | # Override the architecture used by stack, especially useful on Windows 27 | # arch: i386 28 | # arch: x86_64 29 | 30 | # Extra directories used by stack for building 31 | # extra-include-dirs: [/path/to/dir] 32 | # extra-lib-dirs: [/path/to/dir] 33 | -------------------------------------------------------------------------------- /systemd.cabal: -------------------------------------------------------------------------------- 1 | -- Initial systemd.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: systemd 5 | version: 2.4.0 6 | synopsis: Systemd facilities (Socket activation, Notify) 7 | description: A module for Systemd facilities. 8 | homepage: https://github.com/erebe/systemd 9 | license: BSD3 10 | license-file: LICENSE 11 | author: Erèbe 12 | maintainer: romain.gerard@erebe.eu 13 | 14 | category: System 15 | build-type: Simple 16 | extra-source-files: README.md 17 | stability: stable 18 | cabal-version: 2.0 19 | source-repository head 20 | type: git 21 | location: https://github.com/erebe/systemd 22 | 23 | library 24 | ghc-options: -Wall 25 | exposed-modules: System.Systemd.Daemon 26 | , System.Systemd.Daemon.Fd 27 | other-modules: System.Systemd.Internal 28 | c-sources: System/Systemd/socket_info.c 29 | build-depends: base == 4.* , 30 | unix >= 2.5, 31 | transformers >= 0.3, 32 | network >=3.1.0.0, 33 | bytestring >= 0.10 34 | 35 | default-language: Haskell2010 36 | 37 | test-suite daemon-test 38 | hs-source-dirs: test 39 | type: exitcode-stdio-1.0 40 | main-is: Main.hs 41 | build-depends: base == 4.*, 42 | network >=3.1.0.0, 43 | unix >= 2.5, 44 | systemd 45 | default-language: Haskell2010 46 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Systemd.Daemon 3 | import Control.Monad 4 | import Control.Concurrent 5 | 6 | import Network.Socket 7 | import System.IO 8 | import Data.Char 9 | import System.Posix.Env as Ev 10 | 11 | 12 | apF :: Show w => w -> IO () 13 | apF = appendFile "/tmp/log" . (++ "\n") . show 14 | 15 | test :: IO () 16 | test = do 17 | hSetBuffering stdout LineBuffering 18 | ev <- Ev.getEnvironment 19 | apF ev 20 | 21 | apF "totot" 22 | ev' <- getActivatedSocketsWithNames 23 | apF ev' 24 | apF "totot" 25 | 26 | threadDelay $ 1000000 * 20 27 | s <- socket AF_INET Stream defaultProtocol 28 | s' <- socket AF_INET Stream defaultProtocol 29 | listen s 1213 30 | listen s' 1214 31 | 32 | x <- storeFd s 33 | apF x 34 | x <- storeFdWithName s' "tutu" 35 | apF x 36 | forever (runner s) 37 | where 38 | runner s = do 39 | res <- notifyWatchdog 40 | x <- notifyWithFD False "FDSTORE=1" s 41 | apF x 42 | threadDelay $ 1000000 * 2 43 | 44 | main :: IO () 45 | main = do 46 | -- _ <- test 47 | return () 48 | --------------------------------------------------------------------------------