Add Main.hs

Main.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE CPP #-}
+
+import qualified Graphics.X11.Xlib as X11
+import Control.Monad (forever)
+import Control.Concurrent (threadDelay)
+import System.Posix.Process (forkProcess, createSession, exitImmediately)
+import System.Posix.Files (setFileCreationMask)
+import System.Posix.IO (stdInput, stdOutput, stdError, openFd, defaultFileFlags, OpenMode(..), dupTo, closeFd)
+import System.Posix.Signals (installHandler, Handler(Ignore), sigHUP)
+import System.Directory (setCurrentDirectory)
+import System.Exit (ExitCode(..))
+
+daemonize :: IO () -> IO ()
+daemonize daemonAction = do
+  _ <- forkProcess $ do
+    _ <- createSession
+    _ <- forkProcess $ do
+      daemonAction
+    exitImmediately ExitSuccess
+  exitImmediately ExitSuccess
+
+daemonAction :: IO ()
+daemonAction = do
+  -- Ignore SIGHUP
+  _ <- installHandler sigHUP Ignore Nothing
+
+  -- Change working dir & mask
+  setCurrentDirectory "/"
+  setFileCreationMask 0
+
+  devNull <- openFd "/dev/null" ReadWrite defaultFileFlags
+  mapM_ (\fd -> dupTo devNull fd) [stdInput, stdOutput, stdError]
+  closeFd devNull
+
+  display <- X11.openDisplay ""
+  let root = X11.defaultRootWindow display
+
+  forever $ do
+    X11.resetScreenSaver display
+    X11.flush display
+    threadDelay (30 * 1000000)  -- 30 seconds
+
+main :: IO ()
+main = daemonize daemonAction