On Tue, Feb 21, 2012 at 1:21 PM, Iustin Pop <[email protected]> wrote: > This is not complete for now, just the basic functionality has been > implemented: > > - daemonize > - check we're running under the correct user > - call setup logging > --- > Makefile.am | 1 + > htools/Ganeti/Daemon.hs | 247 > +++++++++++++++++++++++++++++++++++++++++++++++ > 2 files changed, 248 insertions(+), 0 deletions(-) > create mode 100644 htools/Ganeti/Daemon.hs > > diff --git a/Makefile.am b/Makefile.am > index a231950..6a92874 100644 > --- a/Makefile.am > +++ b/Makefile.am > @@ -394,6 +394,7 @@ HS_LIB_SRCS = \ > htools/Ganeti/BasicTypes.hs \ > htools/Ganeti/Confd.hs \ > htools/Ganeti/Config.hs \ > + htools/Ganeti/Daemon.hs \ > htools/Ganeti/Hash.hs \ > htools/Ganeti/Jobs.hs \ > htools/Ganeti/Logging.hs \ > diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs > new file mode 100644 > index 0000000..af8b038 > --- /dev/null > +++ b/htools/Ganeti/Daemon.hs > @@ -0,0 +1,247 @@ > +{-| Implementation of the generic daemon functionality. > + > +-} > + > +{- > + > +Copyright (C) 2011, 2012 Google Inc. > + > +This program is free software; you can redistribute it and/or modify > +it under the terms of the GNU General Public License as published by > +the Free Software Foundation; either version 2 of the License, or > +(at your option) any later version. > + > +This program is distributed in the hope that it will be useful, but > +WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU > +General Public License for more details. > + > +You should have received a copy of the GNU General Public License > +along with this program; if not, write to the Free Software > +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA > +02110-1301, USA. > + > +-} > + > +module Ganeti.Daemon > + ( DaemonOptions(..) > + , OptType > + , defaultOptions > + , oShowHelp > + , oShowVer > + , oNoDaemonize > + , oNoUserChecks > + , oDebug > + , oPort > + , parseArgs > + , writePidFile > + , genericMain > + ) where > + > +import Control.Monad > +import qualified Data.Version > +import Data.Word > +import System.Console.GetOpt > +import System.Exit > +import System.Environment > +import System.Info > +import System.IO > +import System.Posix.Directory > +import System.Posix.Files > +import System.Posix.IO > +import System.Posix.Process > +import System.Posix.Types > +import Text.Printf > + > +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 > + > +-- * Data types > + > +-- | Command line options structure. > +data DaemonOptions = DaemonOptions > + { optShowHelp :: Bool -- ^ Just show the help > + , optShowVer :: Bool -- ^ Just show the program version > + , optDaemonize :: Bool -- ^ Whether to daemonize or not > + , optPort :: Maybe Word16 -- ^ Override for the network port > + , optDebug :: Bool -- ^ Enable debug messages > + , optNoUserChecks :: Bool -- ^ Ignore user checks > + } > + > +-- | Default values for the command line options. > +defaultOptions :: DaemonOptions > +defaultOptions = DaemonOptions > + { optShowHelp = False > + , optShowVer = False > + , optDaemonize = True > + , optPort = Nothing > + , optDebug = False > + , optNoUserChecks = False > + } > + > +-- | Abrreviation for the option type. > +type OptType = OptDescr (DaemonOptions -> Result 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})) > + "Don't detach from the current terminal" > + > +oDebug :: OptType > +oDebug = Option "d" ["debug"] > + (NoArg (\ opts -> Ok opts { optDebug = True })) > + "Enable debug messages" > + > +oNoUserChecks :: OptType > +oNoUserChecks = Option "" ["no-user-checks"] > + (NoArg (\ opts -> Ok opts { optNoUserChecks = True })) > + "Ignore user checks" > + > +oPort :: Int -> OptType > +oPort def = Option "p" ["--port"] > + (ReqArg (\ p o -> tryRead "reading port" p >>= \p' -> > + return (o { optPort = Just p' })) "PORT") > + ("Network port (default: " ++ show def ++ ")") > +
Maybe we can extract something out of the reqArg? Anyway we may have other command line options in the future that have to parse integer arguments, so we can avoid embedding this here. > +-- | 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 > + (o, n, []) -> > + do > + let (pr, args) = (foldM (flip id) defaultOptions o, n) > + po <- (case pr of > + Bad msg -> do > + hPutStrLn stderr "Error while parsing command\ > + \line arguments:" > + hPutStrLn stderr msg > + exitWith $ ExitFailure 1 > + Ok val -> return val) > + when (optShowHelp po) $ do > + putStr $ usageHelp progname options > + exitWith ExitSuccess > + when (optShowVer po) $ 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 These two are not "parsing" arguments but are executing variations of the program depending on them. Not sure they belong to a "parseOpts" function. Also, is there really no easier way to parse them? :) > + return (po, 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 > + > +-- * Daemon-related functions > +-- | PID file mode. > +pidFileMode :: FileMode > +pidFileMode = unionFileModes ownerReadMode ownerWriteMode > + > +-- | Writes a PID file and locks it. > +_writePidFile :: FilePath -> IO Fd > +_writePidFile path = do > + fd <- createFile path pidFileMode > + setLock fd (WriteLock, AbsoluteSeek, 0, 0) > + my_pid <- getProcessID > + _ <- fdWrite fd (show my_pid ++ "\n") > + return fd > + > +-- | Nice wrapper over '_writePidFile'. "Nice?" ? Also, this is the public function, so its docstring shouldn't mention a private one but explain what it does. > +writePidFile :: FilePath -> IO (Result Fd) > +writePidFile path = do > + catch (fmap Ok $ _writePidFile path) (return . Bad . show) > + > +-- | Sets up a daemon's environment. > +setupDaemonEnv :: FilePath -> FileMode -> IO () > +setupDaemonEnv cwd umask = do > + changeWorkingDirectory cwd > + _ <- setFileCreationMask umask > + _ <- createSession > + return () > + > +-- | Run an I/O action as a daemon. > +-- > +-- WARNING: this only works in single-threaded mode (either using the > +-- single-threaded runtime, or using the multi-threaded one but with > +-- only one OS thread, i.e. -N1). > +-- > +-- FIXME: this doesn't support error reporting and the prepfn > +-- functionality. > +daemonize :: IO () -> IO () > +daemonize action = do > + -- first fork > + _ <- forkProcess $ do > + -- in the child > + setupDaemonEnv "/" (unionFileModes groupModes otherModes) > + _ <- forkProcess action > + exitImmediately ExitSuccess > + exitImmediately ExitSuccess > + > +-- | Generic daemon startup. > +genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO () > +genericMain daemon options main = do > + (opts, args) <- parseArgs (daemonName daemon) options > + > + unless (null args) $ do > + hPutStrLn stderr "This program doesn't take any arguments" > + exitWith $ ExitFailure C.exitFailure > + I believe evaluation of "help" and "version" goes here, and not during the parsing. > + 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) > + > +-- | 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 > + 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 () > + logNotice "starting" > + main > -- > 1.7.7.3 > Thanks, Guido
