, oSyslogUsage
, parseArgs
, parseAddress
+ , cleanupSocket
, writePidFile
, genericMain
) where
import Control.Exception
import Control.Monad
import Data.Maybe (fromMaybe)
-import qualified Data.Version
import Data.Word
import GHC.IO.Handle (hDuplicateTo)
import qualified Network.Socket as Socket
import System.Console.GetOpt
import System.Exit
import System.Environment
-import System.Info
import System.IO
+import System.IO.Error (isDoesNotExistError)
import System.Posix.Directory
import System.Posix.Files
import System.Posix.IO
import System.Posix.Process
import System.Posix.Types
-import Text.Printf
+import System.Posix.Signals
+import Ganeti.Common as Common
import Ganeti.Logging
import Ganeti.Runtime
import Ganeti.BasicTypes
import Ganeti.HTools.Utils
-import qualified Ganeti.HTools.Version as Version(version)
import qualified Ganeti.Constants as C
import qualified Ganeti.Ssconf as Ssconf
, optSyslogUsage = Nothing
}
+instance StandardOptions DaemonOptions where
+ helpRequested = optShowHelp
+ verRequested = optShowVer
+ requestHelp o = o { optShowHelp = True }
+ requestVer o = o { optShowVer = True }
+
-- | Abrreviation for the option type.
-type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
-
--- | Helper function for required arguments which need to be converted
--- as opposed to stored just as string.
-reqWithConversion :: (String -> Result a)
- -> (a -> DaemonOptions -> Result DaemonOptions)
- -> String
- -> ArgDescr (DaemonOptions -> Result DaemonOptions)
-reqWithConversion conversion_fn updater_fn metavar =
- ReqArg (\string_opt opts -> do
- parsed_value <- conversion_fn string_opt
- updater_fn parsed_value opts) metavar
+type OptType = GenericOptType DaemonOptions
-- * Command line options
-oShowHelp :: OptType
-oShowHelp = Option "h" ["help"]
- (NoArg (\ opts -> Ok opts { optShowHelp = True}))
- "Show the help message and exit"
-
-oShowVer :: OptType
-oShowVer = Option "V" ["version"]
- (NoArg (\ opts -> Ok opts { optShowVer = True}))
- "Show the version of the program and exit"
-
oNoDaemonize :: OptType
oNoDaemonize = Option "f" ["foreground"]
(NoArg (\ opts -> Ok opts { optDaemonize = False}))
\messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
"]")
--- | Usage info.
-usageHelp :: String -> [OptType] -> String
-usageHelp progname =
- usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
- progname Version.version progname)
-
--- | Command line parser, using the 'Options' structure.
-parseOpts :: [String] -- ^ The command line arguments
- -> String -- ^ The program name
- -> [OptType] -- ^ The supported command line options
- -> IO (DaemonOptions, [String]) -- ^ The resulting options
- -- and leftover arguments
-parseOpts argv progname options =
- case getOpt Permute options argv of
- (opt_list, args, []) ->
- do
- parsed_opts <-
- exitIfBad "Error while parsing command line arguments" $
- foldM (flip id) defaultOptions opt_list
- return (parsed_opts, args)
- (_, _, errs) -> do
- hPutStrLn stderr $ "Command line error: " ++ concat errs
- hPutStrLn stderr $ usageHelp progname options
- exitWith $ ExitFailure 2
-
-- | Small wrapper over getArgs and 'parseOpts'.
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
parseArgs cmd options = do
cmd_args <- getArgs
- parseOpts cmd_args cmd options
+ parseOpts defaultOptions cmd_args cmd options
-- * Daemon-related functions
-- | PID file mode.
-- | Wrapper over '_writePidFile' that transforms IO exceptions into a
-- 'Bad' value.
writePidFile :: FilePath -> IO (Result Fd)
-writePidFile path = do
+writePidFile path =
catch (fmap Ok $ _writePidFile path)
(return . Bad . formatIOError "Failure during writing of the pid file")
+-- | Helper function to ensure a socket doesn't exist. Should only be
+-- called once we have locked the pid file successfully.
+cleanupSocket :: FilePath -> IO ()
+cleanupSocket socketPath =
+ catchJust (guard . isDoesNotExistError) (removeLink socketPath)
+ (const $ return ())
+
-- | Sets up a daemon's environment.
setupDaemonEnv :: FilePath -> FileMode -> IO ()
setupDaemonEnv cwd umask = do
_ <- createSession
return ()
+-- | Signal handler for reopening log files.
+handleSigHup :: FilePath -> IO ()
+handleSigHup path = do
+ setupDaemonFDs (Just path)
+ logInfo "Reopening log files after receiving SIGHUP"
+
-- | Sets up a daemon's standard file descriptors.
setupDaemonFDs :: Maybe FilePath -> IO ()
setupDaemonFDs logfile = do
-> Socket.Family -- ^ The cluster IP family
-> Result (Socket.Family, Socket.SockAddr)
defaultBindAddr port Socket.AF_INET =
- Ok $ (Socket.AF_INET,
- Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
+ Ok (Socket.AF_INET,
+ Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
defaultBindAddr port Socket.AF_INET6 =
- Ok $ (Socket.AF_INET6,
- Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
+ Ok (Socket.AF_INET6,
+ Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
-- | Default hints for the resolver
resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
return $ case resolved of
[] -> Bad "Invalid results from lookup?"
- best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best)
+ best:_ -> Ok (Socket.addrFamily best, Socket.addrAddress best)
-- | Based on the options, compute the socket address to use for the
-- daemon.
parseAddress opts defport = do
let port = maybe defport fromIntegral $ optPort opts
def_family <- Ssconf.getPrimaryIPFamily Nothing
- ainfo <- case optBindAddress opts of
- Nothing -> return (def_family >>= defaultBindAddr port)
- Just saddr -> catch (resolveAddr port saddr)
- (annotateIOError $ "Invalid address " ++ saddr)
- return ainfo
+ case optBindAddress opts of
+ Nothing -> return (def_family >>= defaultBindAddr port)
+ Just saddr -> catch (resolveAddr port saddr)
+ (annotateIOError $ "Invalid address " ++ saddr)
-- | Run an I/O action as a daemon.
--
-- in the child
setupDaemonEnv "/" (unionFileModes groupModes otherModes)
setupDaemonFDs $ Just logfile
+ _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
_ <- forkProcess action
exitImmediately ExitSuccess
exitImmediately ExitSuccess
let progname = daemonName daemon
(opts, args) <- parseArgs progname options
- when (optShowHelp opts) $ do
- putStr $ usageHelp progname options
- exitWith ExitSuccess
- when (optShowVer opts) $ do
- printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
- progname Version.version
- compilerName (Data.Version.showVersion compilerVersion)
- os arch :: IO ()
- exitWith ExitSuccess
-
exitUnless (null args) "This program doesn't take any arguments"
unless (optNoUserChecks opts) $ do
projects / ganeti-local / blobdiff