systemd (empty) → 0.1.0.1
raw patch · 7 files changed
+348/−0 lines, 7 filesdep +basedep +bytestringdep +networksetup-changed
Dependencies added: base, bytestring, network, systemd, transformers, unix
Files
- LICENSE +30/−0
- README.md +11/−0
- Setup.hs +2/−0
- System/Systemd/Daemon.hs +216/−0
- System/Systemd/socket_info.c +34/−0
- systemd.cabal +40/−0
- test/Main.hs +15/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, David Fisher++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of David Fisher nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,11 @@+#Haskell implementation for systemd++Systemd offers some functionnalities to developpers for creating daemons process+++- Whatchdog (http://www.freedesktop.org/software/systemd/man/sd_notify.html)+- Socket activation (http://0pointer.de/blog/projects/socket-activation.html)+- journal log++Available on hackage+http://hackage.haskell.org/package/systemd-1.0.0/docs/System-Systemd-Daemon.html
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Systemd/Daemon.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-|+Module : System.Systemd.Daemon+Description : Systemd facilities to manage daemons+Copyright : (c) Romain Gérard, 2014+ David Fisher, 2013+License : BSD3+Maintainer : romain.gerard@erebe.eu+Stability : experimental+Portability : Require Systemd or will fail otherwise++Implementation of Systemd facilities to create and manage+daemons.++This module contains socket activation and notify tools. See ++* <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>++Example:++@+import Control.Monad(forever)+import System.Systemd.Daemon(notifyWatchdog)++main :: IO ()+main = forever $ do+ functionThatMayHang+ notifyWatchdog+@++If you use the service described as below,+Systemd will restart your program each time the watchdog +fail to notify itself under 60 sec.++@+[Unit]+Description=MyDaemon++[Service]+Type=simple+TimeoutStartSec=0+ExecStart=AbsolutePathToMyExecutable+WatchdogSec=60+Restart=on-failure++[Install]+WantedBy=multi-user.target+@+-}++module System.Systemd.Daemon (+ -- * Notify functions+ notify+ , notifyWatchdog+ , notifyReady+ , notifyPID+ , notifyErrno+ , notifyStatus+ , notifyBusError+ -- * Socket activation functions+ , getActivatedSockets+ -- * Utils+ , unsetEnvironnement+ ) where+++import Control.Applicative+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 Foreign.C.Error (Errno (..))+import Foreign.C.Types (CInt (..))+import System.Posix.Env+import System.Posix.Process+import System.Posix.Types (CPid (..))++import Network.Socket hiding (recv, recvFrom, send, 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"++-- | Notify the systemd that the program is ready+notifyReady :: IO (Maybe())+notifyReady = notify False "READY=1"++-- | Notify systemd of the PID of the program (for after a fork)+notifyPID :: CPid -> IO (Maybe())+notifyPID pid = notify False $ "MAINPID=" ++ show pid++-- | Notify systemd of an 'Errno' error+notifyErrno :: Errno -> IO (Maybe())+notifyErrno (Errno errorNb) = notify False $ "ERRNO=" ++ show errorNb++-- | Notify systemd of the status of the program. An arbitrary 'String'+-- can be passed+notifyStatus :: String -> IO (Maybe())+notifyStatus msg = notify False $ "STATUS=" ++ msg++-- | Notify systemd of a DBUS error like.+-- Correct formatting of the 'String' is left to the caller+notifyBusError :: String -> IO (Maybe())+notifyBusError msg = notify False $ "BUSERROR=" ++ msg++-- | 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"]++-- | Notify systemd about an event+-- After notifying systemd the 'Bool' parameter specify if the environnement+-- shall be unset (Further call to notify will fail)+-- The @String@ is the event to pass+-- 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+ 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 $ sendTo socketFd (BC.pack state) (SockAddrUnix socketPath')+ liftIO $ close socketFd+ guard $ nbBytes >= length state+++ return ()++++------------------------------------------------------------------------------------------------+-- SOCKET+------------------------------------------------------------------------------------------------++fdStart :: CInt+fdStart = 3++-- | Return a list of activated sockets, if the program was started with+-- socket activation. The sockets are in the same order as in+-- the associated @.socket@ file. The sockets will have their family, type,+-- 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+ guard $ listenPid == myPid+ mapM makeSocket [fdStart .. fdStart + listenFDs - 1]+ where makeSocket :: CInt -> MaybeT IO Socket+ makeSocket fd = do+ fam <- socketFamily fd+ typ <- socketType fd+ stat <- socketStatus fd+ liftIO $ mkSocket fd fam typ defaultProtocol stat++socketFamily :: CInt -> MaybeT IO Family+socketFamily fd = do+ familyInt <- liftIO $ c_socket_family fd+ guard $ familyInt >= 0+ return $ unpackFamily familyInt++socketType :: CInt -> MaybeT IO SocketType+socketType fd = do+ typeInt <- liftIO $ c_socket_type fd+ case typeInt of+ 0 -> return NoSocketType+ 1 -> return Stream+ 2 -> return Datagram+ 3 -> return Raw+ 4 -> return RDM+ 5 -> return SeqPacket+ _ -> mzero++socketStatus :: CInt -> MaybeT IO SocketStatus+socketStatus fd = do+ listeningInt <- liftIO $ c_socket_listening fd+ case listeningInt of+ 0 -> return Bound+ 1 -> return Listening+ _ -> mzero++foreign import ccall unsafe "socket_family"+ c_socket_family :: CInt -> IO CInt++foreign import ccall unsafe "socket_type"+ c_socket_type :: CInt -> IO CInt++foreign import ccall unsafe "socket_listening"+ c_socket_listening :: CInt -> IO CInt
+ System/Systemd/socket_info.c view
@@ -0,0 +1,34 @@+#include <sys/socket.h>++int socket_family(int fd) {+ struct sockaddr sockaddr = {};+ socklen_t len = sizeof(sockaddr);+ + if (getsockname(fd, &sockaddr, &len) < 0)+ return -1;+ + if (len < sizeof(sa_family_t))+ return -1;+ + return sockaddr.sa_family;+}++int socket_type(int fd) {+ int type = 0;+ socklen_t len = sizeof(type);+ + if (getsockopt(fd, SOL_SOCKET, SO_TYPE, &type, &len) < 0)+ return -1;+ + return type;+}++int socket_listening(int fd) {+ int accepting = 0;+ socklen_t len = sizeof(accepting);+ + if (getsockopt(fd, SOL_SOCKET, SO_ACCEPTCONN, &accepting, &len) < 0)+ return -1;++ return accepting;+}
+ systemd.cabal view
@@ -0,0 +1,40 @@+-- Initial systemd.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: systemd+version: 0.1.0.1+synopsis: Systemd facilities (Socket activation, Notify)+description: A module for Systemd facilities.+homepage: https://github.com/erebe/systemd+license: BSD3+license-file: LICENSE+author: Erèbe+maintainer: romain.gerard@erebe.eu++category: System+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+source-repository head+ type: git+ location: https://github.com/erebe/systemd++library+ exposed-modules: System.Systemd.Daemon+ c-sources: System/Systemd/socket_info.c+ build-depends: base >=4.7 && <= 4.8.1.0,+ unix >= 2.5,+ transformers >= 0.3,+ network >=2.3,+ bytestring >= 0.10++ default-language: Haskell2010++test-suite daemon-test+ hs-source-dirs: test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ default-language: Haskell2010+ build-depends: base >=4.7 && <= 4.8.1.0,+ systemd+ default-language: Haskell2010
+ test/Main.hs view
@@ -0,0 +1,15 @@++import System.Systemd.Daemon+import Control.Monad+import Control.Concurrent++++main :: IO ()+main = forever runner+ where+ runner = do+ res <- notifyWatchdog+ print res+ threadDelay $ 1000000 * 2+