+{-# LANGUAGE DoAndIfThenElse #-}
+
module Main
where
import Control.Concurrent ( forkIO, threadDelay )
+import Control.Exception ( throw )
import Control.Monad ( forever, when )
import Data.Aeson ( decode )
import Data.Maybe ( fromMaybe, isNothing )
import Data.Monoid ( (<>) )
import Data.Time.LocalTime ( TimeZone, getCurrentTimeZone )
import System.Console.CmdArgs.Default ( Default(..) )
+import System.Directory ( doesFileExist )
import System.Exit ( ExitCode(..), exitWith )
import System.IO ( hPutStrLn, stderr )
+import System.IO.Error ( catchIOError )
import CommandLine ( get_args, show_help )
import Configuration ( Cfg(..), merge_optional )
-import ExitCodes ( exit_no_usernames )
+import ExitCodes ( exit_no_usernames, exit_pidfile_exists )
import qualified OptionalConfiguration as OC ( from_rc )
import Mail (
Message(..),
pretty_print,
utc_time_to_rfc822 )
import Twitter.User ( User(..) )
+import Unix ( full_daemonize )
import Usernames ( Usernames(..) )
+
-- | A wrapper around threadDelay which takes seconds instead of
-- microseconds as its argument.
--
-- | Filter out replies/retweets based on the configuration.
--
filter_statuses :: Cfg -> [Status] -> [Status]
-filter_statuses cfg statuses =
- (reply_filter . retweet_filter) statuses
+filter_statuses cfg =
+ reply_filter . retweet_filter
where
reply_filter = if ignore_replies cfg
then filter (not . reply)
_ <- show_help
exitWith (ExitFailure exit_no_usernames)
+
+ when (daemonize cfg) $ do
+ -- Old PID files can be left around after an unclean shutdown. We
+ -- only care if we're running as a daemon.
+ pidfile_exists <- doesFileExist (pidfile cfg)
+ when pidfile_exists $ do
+ hPutStrLn stderr $ "ERROR: PID file " ++ (pidfile cfg) ++
+ " already exists. Refusing to start."
+ exitWith (ExitFailure exit_pidfile_exists)
+
+
-- If we have both a "To" and "From" address, we'll create a
-- message object to be passed to all of our threads.
let message = construct_message cfg
-
- -- Execute run on each username in a new thread.
let run_curried = run cfg message
- _ <- mapM (forkIO . run_curried) (get_usernames (usernames cfg))
- _ <- forever $
- -- This thread (the one executing main) doesn't do anything,
- -- but when it terminates, so do all the threads we forked.
- -- As a result, we need to keep this thread on life support.
- thread_sleep (heartbeat cfg)
+ let run_program = (mapM_ -- Execute run on each username in a new thread.
+ (forkIO . run_curried)
+ (get_usernames (usernames cfg)))
+ >>
+ -- This thread (the one executing main) doesn't do
+ -- anything, but when it terminates, so do all the
+ -- threads we forked. As a result, we need to
+ -- keep this thread on life support. If we were
+ -- asked to daemonize, do that; otherwise just run
+ -- the thing.
+ forever (thread_sleep (heartbeat cfg))
+
+ if (daemonize cfg)
+ then try_daemonize cfg run_program
+ else run_program
- return ()
+ where
+ -- | A exception handler around full_daemonize. If full_daemonize
+ -- doesn't work, we report the error and crash. This is fine; we
+ -- only need the program to be resilient once it actually starts.
+ --
+ try_daemonize :: Cfg -> IO () -> IO ()
+ try_daemonize cfg program =
+ catchIOError
+ (full_daemonize cfg program)
+ (\e -> do
+ hPutStrLn stderr ("ERROR: " ++ (show e))
+ throw e)
--- /dev/null
+-- | Non-portable code for daemonizing on unix.
+--
+module Unix
+where
+
+import Control.Concurrent ( ThreadId, myThreadId )
+import Control.Exception ( throwTo )
+import Control.Monad ( unless )
+import System.Directory ( createDirectory, doesDirectoryExist )
+import System.Exit ( ExitCode( ExitSuccess ) )
+import System.FilePath ( dropFileName, dropTrailingPathSeparator )
+import System.IO ( hPutStrLn, stderr )
+import System.IO.Error ( catchIOError )
+import System.Posix (
+ GroupEntry ( groupID ),
+ GroupID,
+ Handler ( Catch ),
+ UserEntry ( userID ),
+ UserID,
+ exitImmediately,
+ getGroupEntryForName,
+ getProcessID,
+ getRealGroupID,
+ getRealUserID,
+ getUserEntryForName,
+ installHandler,
+ removeLink,
+ setFileCreationMask,
+ setGroupID,
+ setOwnerAndGroup,
+ setUserID,
+ sigTERM )
+import System.Posix.Daemonize ( daemonize )
+
+import Configuration (
+ Cfg( pidfile,
+ run_as_group,
+ run_as_user ) )
+
+
+-- | Retrieve the uid associated with the given system user name. We
+-- take a Maybe String as an argument so the user name can be passed
+-- in directly from the config.
+--
+get_user_id :: Maybe String -> IO UserID
+get_user_id Nothing = getRealUserID
+get_user_id (Just s) = fmap userID (getUserEntryForName s)
+
+
+-- | Retrieve the gid associated with the given system group name. We
+-- take a Maybe String as an argument so the group name can be
+-- passed in directly from the config.
+--
+get_group_id :: Maybe String -> IO GroupID
+get_group_id Nothing = getRealGroupID
+get_group_id (Just s) = fmap groupID (getGroupEntryForName s)
+
+
+-- | This function will be called in response to a SIGTERM; i.e. when
+-- someone tries to kill our process. We simply delete the PID file
+-- and signal our parent thread to quit (successfully).
+--
+-- If that doesn't work, report the error and quit rudely.
+--
+graceful_shutdown :: Cfg -> ThreadId -> IO ()
+graceful_shutdown cfg main_thread_id = do
+ putStrLn "SIGTERM received, removing PID file and shutting down."
+ catchIOError try_nicely (\e -> do
+ hPutStrLn stderr ("ERROR: " ++ (show e))
+ exitImmediately ExitSuccess )
+ where
+ try_nicely = do
+ removeLink (pidfile cfg)
+ throwTo main_thread_id ExitSuccess
+
+
+-- | Create the directory in which we intend to store the PID
+-- file. This will *not* create any parent directories. The PID
+-- directory will have its owner/group changed to the user/group
+-- under which we'll be running. No permissions will be set; the
+-- system's umask must allow owner-write.
+--
+-- This is intended to create one level beneath either /var/run or
+-- /run which often do not survive a reboot.
+--
+-- If the directory already exists, it is left alone; that is, we
+-- don't change its owner/group.
+--
+create_pid_directory :: FilePath -- ^ The directory to contain the PID file.
+ -> UserID -- ^ Owner of the new directory if created.
+ -> GroupID -- ^ Group of the new directory if created.
+ -> IO ()
+create_pid_directory pid_directory uid gid = do
+ it_exists <- doesDirectoryExist pid_directory
+ unless it_exists $ do
+ putStrLn $ "Creating PID directory " ++ pid_directory ++ "."
+ createDirectory pid_directory
+ putStrLn $ "Changing owner/group of " ++ pid_directory ++
+ " to " ++ (show uid) ++ "/" ++ (show gid) ++ "."
+ setOwnerAndGroup pid_directory uid gid
+
+
+-- | Write a PID file, install a SIGTERM handler, drop privileges, and
+-- finally do the daemonization dance.
+--
+full_daemonize :: Cfg -> IO () -> IO ()
+full_daemonize cfg program = do
+ uid <- get_user_id (run_as_user cfg)
+ gid <- get_group_id (run_as_group cfg)
+
+ -- This will have to be done as root and the result chowned to our
+ -- user/group, so it must happen before daemonizing.
+ let pid_directory = dropTrailingPathSeparator $ dropFileName $ pidfile cfg
+ create_pid_directory pid_directory uid gid
+
+ -- The call to 'daemonize' will set the umask to zero, but we want
+ -- to retain it. So, we set the umask to zero before 'daemonize'
+ -- can, so that we can record the previous umask value (returned by
+ -- setFileCreationMask).
+ orig_umask <- setFileCreationMask 0
+
+ -- This is the 'daemonize' from System.Posix.Daemonize.
+ daemonize (program' orig_umask uid gid)
+ where
+ -- We need to do all this stuff *after* we daemonize.
+ program' orig_umask uid gid = do
+ -- First we install a signal handler for sigTERM. We need to
+ -- pass the thread ID to the signal handler so it knows which
+ -- process to "exit."
+ tid <- myThreadId
+ _ <- installHandler sigTERM (Catch (graceful_shutdown cfg tid)) Nothing
+
+ -- Next we drop privileges. Group ID has to go first, otherwise
+ -- you ain't root to change groups.
+ setGroupID gid
+ setUserID uid
+
+ -- Now we create the PID file.
+ pid <- getProcessID
+
+ -- The PID file needs to be read-only for anyone but its
+ -- owner. Hopefully the umask accomplishes this!
+ _ <- setFileCreationMask orig_umask
+
+ -- When we later attempt to delete the PID file, it requires
+ -- write permission to the parent directory and not to the PID
+ -- file itself. Therefore, if that's going to work, this has to
+ -- work, even as a limited user.
+ writeFile (pidfile cfg) (show pid)
+
+ -- Finally run the program we were asked to.
+ program
projects / dead / halcyon.git / commitdiff