module System.Systemd.Daemon.Fd
(
notifyWithFD
, storeFd
, storeFdWithName
, 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 :: CInt
fdStart = CInt
3
storeFd :: Fd -> IO (Maybe ())
storeFd :: Fd -> IO (Maybe ())
storeFd = Bool -> String -> Fd -> IO (Maybe ())
notifyWithFD Bool
False String
"FDSTORE=1"
storeFdWithName :: Fd -> String -> IO (Maybe ())
storeFdWithName :: Fd -> String -> IO (Maybe ())
storeFdWithName Fd
fd String
name = Bool -> String -> Fd -> IO (Maybe ())
notifyWithFD Bool
False (String
"FDSTORE=1\nFDNAME=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) Fd
fd
notifyWithFD :: Bool -> String -> Fd -> IO (Maybe ())
notifyWithFD :: Bool -> String -> Fd -> IO (Maybe ())
notifyWithFD Bool
unset_env String
state Fd
sock = Bool -> String -> Maybe Fd -> IO (Maybe ())
notifyWithFD_ Bool
unset_env String
state (Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
sock)
getActivatedSockets :: IO (Maybe [Fd])
getActivatedSockets :: IO (Maybe [Fd])
getActivatedSockets = MaybeT IO [Fd] -> IO (Maybe [Fd])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [Fd] -> IO (Maybe [Fd]))
-> MaybeT IO [Fd] -> IO (Maybe [Fd])
forall a b. (a -> b) -> a -> b
$ do
ProcessID
listenPid <- String -> ProcessID
forall a. Read a => String -> a
read (String -> ProcessID) -> MaybeT IO String -> MaybeT IO ProcessID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (String -> IO (Maybe String)
getEnv String
"LISTEN_PID")
CInt
listenFDs <- String -> CInt
forall a. Read a => String -> a
read (String -> CInt) -> MaybeT IO String -> MaybeT IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (String -> IO (Maybe String)
getEnv String
"LISTEN_FDS")
ProcessID
myPid <- IO ProcessID -> MaybeT IO ProcessID
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ProcessID
getProcessID
Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT IO ()) -> Bool -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ ProcessID
listenPid ProcessID -> ProcessID -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessID
myPid
(CInt -> MaybeT IO Fd) -> [CInt] -> MaybeT IO [Fd]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CInt
fd -> IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CInt -> IO ()
setNonBlockIfNeeded CInt
fd) MaybeT IO () -> MaybeT IO Fd -> MaybeT IO Fd
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fd -> MaybeT IO Fd
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> Fd
Fd CInt
fd))
[CInt
fdStart .. CInt
fdStart CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
listenFDs CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1]
getActivatedSocketsWithNames :: IO (Maybe [(Fd, String)])
getActivatedSocketsWithNames :: IO (Maybe [(Fd, String)])
getActivatedSocketsWithNames = MaybeT IO [(Fd, String)] -> IO (Maybe [(Fd, String)])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [(Fd, String)] -> IO (Maybe [(Fd, String)]))
-> MaybeT IO [(Fd, String)] -> IO (Maybe [(Fd, String)])
forall a b. (a -> b) -> a -> b
$ do
String
listenFDNames <- IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (String -> IO (Maybe String)
getEnv String
"LISTEN_FDNAMES")
let listenFDNames' :: [String]
listenFDNames' = (ByteString -> String) -> [ByteString] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
BC.unpack ([ByteString] -> [String]) -> [ByteString] -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BC.split Char
':' (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BC.pack String
listenFDNames
[Fd]
nonBlockFds <- IO (Maybe [Fd]) -> MaybeT IO [Fd]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe [Fd])
getActivatedSockets
Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT IO ()) -> Bool -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ [Fd] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Fd]
nonBlockFds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
listenFDNames'
[(Fd, String)] -> MaybeT IO [(Fd, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Fd, String)] -> MaybeT IO [(Fd, String)])
-> [(Fd, String)] -> MaybeT IO [(Fd, String)]
forall a b. (a -> b) -> a -> b
$ [Fd] -> [String] -> [(Fd, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Fd]
nonBlockFds [String]
listenFDNames'