-- | Haskell bindings for libsystemd-daemon.
module System.SD.Daemon 
  ( -- * Basic functions
    sdBooted
    -- * Notification functions
  , sdNotify
  , readyVar
  , statusVar
  , statusVar'
  , errnoVar
  , buserrorVar
  , buserrorVar'
  , mainpidVar
  , customVar
  , customVar'
    -- * Socket-based activation functions
  , sdListenFds
  , sdListenFds'
  , sdIsFifo
  , sdIsSocket
  , sdIsSocketInet
  , sdIsSocketUnix
  , sdIsMq
  , Constants.sD_LISTEN_FDS_START
    -- * Logging prefixes
  , Constants.sD_EMERG
  , Constants.sD_ALERT
  , Constants.sD_CRIT
  , Constants.sD_ERR
  , Constants.sD_WARNING
  , Constants.sD_NOTICE
  , Constants.sD_INFO
  , Constants.sD_DEBUG
  )
where

import Foreign.C
import Foreign.Ptr
import System.Posix.Types
import Network.Socket

import Data.Word
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as B8

import qualified System.SD.Daemon.Constants as Constants

foreign import ccall "sd_booted"
  c_sd_booted :: IO CInt

foreign import ccall "sd_notify"
  c_sd_notify :: CInt -> CString -> IO CInt

foreign import ccall "sd_listen_fds"
  c_sd_listen_fds :: CInt -> IO CInt

foreign import ccall "sd_is_fifo"
  c_sd_is_fifo :: CInt -> CString -> IO CInt

foreign import ccall "sd_is_socket"
  c_sd_is_socket :: CInt -> CInt -> CInt -> CInt -> IO CInt

foreign import ccall "sd_is_socket_inet"
  c_sd_is_socket_inet :: CInt -> CInt -> CInt -> CInt -> Word16 -> IO CInt

foreign import ccall "sd_is_socket_unix"
  c_sd_is_socket_unix :: CInt -> CInt -> CInt -> CString -> CSize -> IO CInt

foreign import ccall "sd_is_mq"
  c_sd_is_mq :: CInt -> CString -> IO CInt

-- | Checks whether the system was booted up using the systemd init system.
sdBooted :: IO Bool -- ^ True if booted using systemd, false otherwise.
sdBooted = do
    booted <- throwErrnoIf (< 0) "sd_booted" c_sd_booted
    return (booted > 0)

-- | Representation of a variable that can be passed to sdNotify.
data Variable
    = IntVar B.ByteString CInt
    | StrVar B.ByteString B.ByteString
  deriving
    (Show)

-- | Tell init that daemon startup has finished.
readyVar :: Variable
readyVar = IntVar (B8.fromString "READY") 1

-- | Tell init about current daemon state (single-line status message).
statusVar :: String -> Variable
statusVar msg = StrVar (B8.fromString "STATUS") (B8.fromString msg)

-- | Tell init about current daemon state (single-line status message).
statusVar' :: B.ByteString -> Variable
statusVar' msg = StrVar (B8.fromString "STATUS") msg

-- | Tell init about errno-style error code, in case of failure.
errnoVar :: Errno -> Variable
errnoVar (Errno eno) = IntVar (B8.fromString "ERRNO") eno

-- | Tell init about D-Bus error-style error code, in case of failure.
buserrorVar :: String -> Variable
buserrorVar err = StrVar (B8.fromString "BUSERROR") (B8.fromString err)

-- | Tell init about D-Bus error-style error code, in case of failure.
buserrorVar' :: B.ByteString -> Variable
buserrorVar' err = StrVar (B8.fromString "BUSERROR") err

-- | Tell init about main PID of the daemon.
mainpidVar :: ProcessID -> Variable
mainpidVar pid = IntVar (B8.fromString "MAINPID") (fromIntegral pid)

-- | Tell init about a custom variable.
customVar :: String -> String -> Variable
customVar name val = customVar' (B8.fromString name) (B8.fromString val)

-- | Tell init about a custom variable.
customVar' :: B.ByteString -> B.ByteString -> Variable
customVar' name val = StrVar name val

-- | Called by a daemon to notify the init system about status changes.
sdNotify :: Bool       -- ^ Unset enviroment vars before returning?
         -> [Variable] -- ^ Variable assignments to pass to init.
         -> IO Bool    -- ^ True if data was sent, false otherwise. 
sdNotify unset vars = do
    notified <-
      throwErrnoIf (< 0) "sd_notify" $
      B.useAsCString state (c_sd_notify (if unset then 1 else 0))
    return (notified > 0)
  where
    state = B.concat $ concatMap showVar vars
    
    showVar (IntVar name val) = var name (B8.fromString $ show val)
    showVar (StrVar name val) = var name val

    var name val = [name, B8.fromString "=", val, B8.fromString "\n"]

-- | Called by a daemon to check for file descriptors passed by the init system
-- as part of the socket-based activation logic.
sdListenFds :: Bool   -- ^ Unset environment vars before returning?
            -> IO Int -- ^ Number of file descriptors passed by init.
sdListenFds unset = do
    fds <-
      throwErrnoIf (< 0) "sd_listen_fds" $
      c_sd_listen_fds (if unset then 1 else 0)
    return (fromIntegral fds)

-- | Helper function to retrieve a list of file descriptors which have been
-- passed by the init system for the socket-based activation logic.
sdListenFds' :: Bool    -- ^ Unset environment vars before returning?
             -> IO [Fd] -- ^ List of file descriptors passed to us.
sdListenFds' unset = do
    fds <-
      throwErrnoIf (< 0) "sd_listen_fds" $
      c_sd_listen_fds (if unset then 1 else 0)
    return $ map (\n -> Fd $ n + Constants.sD_LISTEN_FDS_START) [0..fds-1]

-- | May be called to check whether the specified file descriptor refers to a
-- FIFO or pipe. If the path parameter is not Nothing, is is checked whether
-- the FIFO is bound to the specified file system path.
sdIsFifo :: Fd              -- ^ File descriptor to check.
         -> Maybe FilePath  -- ^ Check if bound to given path.
         -> IO Bool         -- ^ True if matches, false otherwise.
sdIsFifo (Fd fd) path = do
    c_path <- maybe (return nullPtr) newCString path 
    is_fifo <- throwErrnoIf (< 0) "sd_is_fifo" $ c_sd_is_fifo fd c_path
    return (is_fifo > 0)

-- | May be called to check whether the specified file descriptor refers to a
-- socket. The socket family may be AF_UNSPEC to accept any socket, the socket
-- type may be NoSocketType to accept any socket.
sdIsSocket :: Fd          -- ^ File descriptor to check.
           -> Family      -- ^ Check if given socket family.
           -> SocketType  -- ^ Check if given socket type.
           -> Maybe Bool  -- ^ Check if socket is listening.
           -> IO Bool     -- ^ True if matches, false otherwise.
sdIsSocket (Fd fd) fam st listening = do
    is_socket <-
      throwErrnoIf (< 0) "sd_is_socket" $
      c_sd_is_socket fd (packFamily fam) (packSocketType st)
      (maybe (-1) (\c -> if c then 1 else 0) listening)
    return (is_socket > 0)

-- | May be called to check whether the specified file descriptor refers to a
-- socket, specific to AF_INET/AF_INET6 sockets. Socket family must be
-- AF_UNSPEC, AF_INET or AF_INET6 when using this function. Port may be 0 to
-- ignore.
sdIsSocketInet :: Fd          -- ^ File descriptor to check.
               -> Family      -- ^ Check if given socket family.
               -> SocketType  -- ^ Check if given socket type.
               -> Maybe Bool  -- ^ Check if socket is listening.
               -> PortNumber  -- ^ Check if bound to port.
               -> IO Bool     -- ^ True if matches, false otherwise.
sdIsSocketInet (Fd fd) fam st listening (PortNum port) = do
    is_socket <-
      throwErrnoIf (< 0) "sd_is_socket_inet" $
      c_sd_is_socket_inet fd (packFamily fam) (packSocketType st)
      (maybe (-1) (\c -> if c then 1 else 0) listening) port
    return (is_socket > 0)

-- | May be called to check whether the specified file descriptor refers to a
-- socket, specific to AF_UNIX sockets. Optionally checks if the socket is
-- bound to a given path.
sdIsSocketUnix :: Fd             -- ^ File descriptor to check.
               -> SocketType     -- ^ Check if given socket type.
               -> Maybe Bool     -- ^ Check if socket is listening.
               -> Maybe FilePath -- ^ Check if bound to given path.
               -> CSize          -- ^ Check length (or 0 to ignore).
               -> IO Bool        -- ^ True if matches, false otherwise.
sdIsSocketUnix (Fd fd) st listening path len = do
    c_path <- maybe (return nullPtr) newCString path
    is_socket <-
      throwErrnoIf (< 0) "sd_is_socket_unix" $
      c_sd_is_socket_unix fd (packSocketType st)
      (maybe (-1) (\c -> if c then 1 else 0) listening)
      c_path len
    return (is_socket > 0)

-- | May be called to check whether the specified file descriptor refers to a
-- POSIX message queue. Optionally checks if the message queue is bound to
-- a given path.
sdIsMq :: Fd              -- ^ File descriptor to check.
       -> Maybe FilePath  -- ^ Check if bound to given path.
       -> IO Bool         -- ^ True if matches, false otherwise.
sdIsMq (Fd fd) path = do
    c_path <- maybe (return nullPtr) newCString path
    is_mq <- throwErrnoIf (< 0) "sd_is_mq" $ c_sd_is_mq fd c_path
    return (is_mq > 0)