, oNoUserChecks
, oDebug
, oPort
+ , oBindAddress
+ , oSyslogUsage
, parseArgs
+ , parseAddress
, 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 Prelude hiding (catch)
import System.Console.GetOpt
import System.Exit
import System.Environment
import System.Posix.IO
import System.Posix.Process
import System.Posix.Types
+import System.Posix.Signals
import Text.Printf
import Ganeti.Logging
import Ganeti.HTools.Utils
import qualified Ganeti.HTools.Version as Version(version)
import qualified Ganeti.Constants as C
+import qualified Ganeti.Ssconf as Ssconf
+
+-- * Constants
+
+-- | \/dev\/null path.
+devNull :: FilePath
+devNull = "/dev/null"
-- * Data types
, optPort :: Maybe Word16 -- ^ Override for the network port
, optDebug :: Bool -- ^ Enable debug messages
, optNoUserChecks :: Bool -- ^ Ignore user checks
+ , optBindAddress :: Maybe String -- ^ Override for the bind address
+ , optSyslogUsage :: Maybe SyslogUsage -- ^ Override for Syslog usage
}
-- | Default values for the command line options.
, optPort = Nothing
, optDebug = False
, optNoUserChecks = False
+ , optBindAddress = Nothing
+ , optSyslogUsage = Nothing
}
-- | Abrreviation for the option type.
(\port opts -> Ok opts { optPort = Just port }) "PORT")
("Network port (default: " ++ show def ++ ")")
+oBindAddress :: OptType
+oBindAddress = Option "b" ["bind"]
+ (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
+ "ADDR")
+ "Bind address (default depends on cluster configuration)"
+
+oSyslogUsage :: OptType
+oSyslogUsage = Option "" ["syslog"]
+ (reqWithConversion syslogUsageFromRaw
+ (\su opts -> Ok opts { optSyslogUsage = Just su })
+ "SYSLOG")
+ ("Enable logging to syslog (except debug \
+ \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
+ "]")
+
-- | Usage info.
usageHelp :: String -> [OptType] -> String
usageHelp progname =
(opt_list, args, []) ->
do
parsed_opts <-
- case foldM (flip id) defaultOptions opt_list of
- Bad msg -> do
- hPutStrLn stderr "Error while parsing command\
- \line arguments:"
- hPutStrLn stderr msg
- exitWith $ ExitFailure 1
- Ok val -> return val
+ 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
_ <- fdWrite fd (show my_pid ++ "\n")
return fd
+-- | Helper to format an IOError.
+formatIOError :: String -> IOError -> String
+formatIOError msg err = msg ++ ": " ++ show err
+
-- | Wrapper over '_writePidFile' that transforms IO exceptions into a
-- 'Bad' value.
writePidFile :: FilePath -> IO (Result Fd)
writePidFile path = do
- catch (fmap Ok $ _writePidFile path) (return . Bad . show)
+ catch (fmap Ok $ _writePidFile path)
+ (return . Bad . formatIOError "Failure during writing of the pid file")
-- | Sets up a daemon's environment.
setupDaemonEnv :: FilePath -> FileMode -> IO ()
_ <- 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
+ null_in_handle <- openFile devNull ReadMode
+ null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
+ hDuplicateTo null_in_handle stdin
+ hDuplicateTo null_out_handle stdout
+ hDuplicateTo null_out_handle stderr
+ hClose null_in_handle
+ hClose null_out_handle
+
+-- | Computes the default bind address for a given family.
+defaultBindAddr :: Int -- ^ The port we want
+ -> 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)
+defaultBindAddr port Socket.AF_INET6 =
+ 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
+resolveAddrHints :: Maybe Socket.AddrInfo
+resolveAddrHints =
+ Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
+ Socket.AI_NUMERICSERV] }
+
+-- | Resolves a numeric address.
+resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
+resolveAddr port str = do
+ 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)
+
+-- | Based on the options, compute the socket address to use for the
+-- daemon.
+parseAddress :: DaemonOptions -- ^ Command line options
+ -> Int -- ^ Default port for this daemon
+ -> IO (Result (Socket.Family, Socket.SockAddr))
+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
+
-- | Run an I/O action as a daemon.
--
-- WARNING: this only works in single-threaded mode (either using the
--
-- FIXME: this doesn't support error reporting and the prepfn
-- functionality.
-daemonize :: IO () -> IO ()
-daemonize action = do
+daemonize :: FilePath -> IO () -> IO ()
+daemonize logfile action = do
-- first fork
_ <- forkProcess $ do
-- in the child
setupDaemonEnv "/" (unionFileModes groupModes otherModes)
+ setupDaemonFDs $ Just logfile
+ _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
_ <- forkProcess action
exitImmediately ExitSuccess
exitImmediately ExitSuccess
compilerName (Data.Version.showVersion compilerVersion)
os arch :: IO ()
exitWith ExitSuccess
- unless (null args) $ do
- hPutStrLn stderr "This program doesn't take any arguments"
- exitWith $ ExitFailure C.exitFailure
+
+ exitUnless (null args) "This program doesn't take any arguments"
unless (optNoUserChecks opts) $ do
runtimeEnts <- getEnts
- case runtimeEnts of
- Bad msg -> do
- hPutStrLn stderr $ "Can't find required user/groups: " ++ msg
- exitWith $ ExitFailure C.exitFailure
- Ok ents -> verifyDaemonUser daemon ents
-
- let processFn = if optDaemonize opts then daemonize else id
- processFn $ innerMain daemon opts (main opts)
+ ents <- exitIfBad "Can't find required user/groups" runtimeEnts
+ verifyDaemonUser daemon ents
+
+ syslog <- case optSyslogUsage opts of
+ Nothing -> exitIfBad "Invalid cluster syslog setting" $
+ syslogUsageFromRaw C.syslogUsage
+ Just v -> return v
+ let processFn = if optDaemonize opts
+ then daemonize (daemonLogFile daemon)
+ else id
+ processFn $ innerMain daemon opts syslog (main opts)
-- | Inner daemon function.
--
-- This is executed after daemonization.
-innerMain :: GanetiDaemon -> DaemonOptions -> IO () -> IO ()
-innerMain daemon opts main = do
- setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
- (not (optDaemonize opts)) False
+innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
+innerMain daemon opts syslog main = do
+ let logfile = if optDaemonize opts
+ then Nothing
+ else Just $ daemonLogFile daemon
+ setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog
pid_fd <- writePidFile (daemonPidFile daemon)
- case pid_fd of
- Bad msg -> do
- hPutStrLn stderr $ "Cannot write PID file; already locked? Error: " ++
- msg
- exitWith $ ExitFailure 1
- _ -> return ()
+ _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
logNotice "starting"
main
projects / ganeti-local / blobdiff