code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Daemon.hs

   1 {-| Implementation of the generic daemon functionality.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2011, 2012 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.Daemon
  27   ( DaemonOptions(..)
  28   , OptType
  29   , defaultOptions
  30   , oShowHelp
  31   , oShowVer
  32   , oNoDaemonize
  33   , oNoUserChecks
  34   , oDebug
  35   , oPort
  36   , parseArgs
  37   , writePidFile
  38   , genericMain
  39   ) where
  40
  41 import Control.Monad
  42 import qualified Data.Version
  43 import Data.Word
  44 import System.Console.GetOpt
  45 import System.Exit
  46 import System.Environment
  47 import System.Info
  48 import System.IO
  49 import System.Posix.Directory
  50 import System.Posix.Files
  51 import System.Posix.IO
  52 import System.Posix.Process
  53 import System.Posix.Types
  54 import Text.Printf
  55
  56 import Ganeti.Logging
  57 import Ganeti.Runtime
  58 import Ganeti.BasicTypes
  59 import Ganeti.HTools.Utils
  60 import qualified Ganeti.HTools.Version as Version(version)
  61 import qualified Ganeti.Constants as C
  62
  63 -- * Data types
  64
  65 -- | Command line options structure.
  66 data DaemonOptions = DaemonOptions
  67   { optShowHelp     :: Bool           -- ^ Just show the help
  68   , optShowVer      :: Bool           -- ^ Just show the program version
  69   , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
  70   , optPort         :: Maybe Word16   -- ^ Override for the network port
  71   , optDebug        :: Bool           -- ^ Enable debug messages
  72   , optNoUserChecks :: Bool           -- ^ Ignore user checks
  73   }
  74
  75 -- | Default values for the command line options.
  76 defaultOptions :: DaemonOptions
  77 defaultOptions  = DaemonOptions
  78   { optShowHelp     = False
  79   , optShowVer      = False
  80   , optDaemonize    = True
  81   , optPort         = Nothing
  82   , optDebug        = False
  83   , optNoUserChecks = False
  84   }
  85
  86 -- | Abrreviation for the option type.
  87 type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
  88
  89 -- | Helper function for required arguments which need to be converted
  90 -- as opposed to stored just as string.
  91 reqWithConversion :: (String -> Result a)
  92                   -> (a -> DaemonOptions -> Result DaemonOptions)
  93                   -> String
  94                   -> ArgDescr (DaemonOptions -> Result DaemonOptions)
  95 reqWithConversion conversion_fn updater_fn metavar =
  96   ReqArg (\string_opt opts -> do
  97             parsed_value <- conversion_fn string_opt
  98             updater_fn parsed_value opts) metavar
  99
 100 -- * Command line options
 101
 102 oShowHelp :: OptType
 103 oShowHelp = Option "h" ["help"]
 104             (NoArg (\ opts -> Ok opts { optShowHelp = True}))
 105             "Show the help message and exit"
 106
 107 oShowVer :: OptType
 108 oShowVer = Option "V" ["version"]
 109            (NoArg (\ opts -> Ok opts { optShowVer = True}))
 110            "Show the version of the program and exit"
 111
 112 oNoDaemonize :: OptType
 113 oNoDaemonize = Option "f" ["foreground"]
 114                (NoArg (\ opts -> Ok opts { optDaemonize = False}))
 115                "Don't detach from the current terminal"
 116
 117 oDebug :: OptType
 118 oDebug = Option "d" ["debug"]
 119          (NoArg (\ opts -> Ok opts { optDebug = True }))
 120          "Enable debug messages"
 121
 122 oNoUserChecks :: OptType
 123 oNoUserChecks = Option "" ["no-user-checks"]
 124          (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
 125          "Ignore user checks"
 126
 127 oPort :: Int -> OptType
 128 oPort def = Option "p" ["port"]
 129             (reqWithConversion (tryRead "reading port")
 130              (\port opts -> Ok opts { optPort = Just port }) "PORT")
 131             ("Network port (default: " ++ show def ++ ")")
 132
 133 -- | Usage info.
 134 usageHelp :: String -> [OptType] -> String
 135 usageHelp progname =
 136   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 137              progname Version.version progname)
 138
 139 -- | Command line parser, using the 'Options' structure.
 140 parseOpts :: [String]               -- ^ The command line arguments
 141           -> String                 -- ^ The program name
 142           -> [OptType]              -- ^ The supported command line options
 143           -> IO (DaemonOptions, [String]) -- ^ The resulting options
 144                                           -- and leftover arguments
 145 parseOpts argv progname options =
 146   case getOpt Permute options argv of
 147     (opt_list, args, []) ->
 148       do
 149         parsed_opts <-
 150           case foldM (flip id) defaultOptions opt_list of
 151             Bad msg -> do
 152               hPutStrLn stderr "Error while parsing command\
 153                                \line arguments:"
 154               hPutStrLn stderr msg
 155               exitWith $ ExitFailure 1
 156             Ok val -> return val
 157         return (parsed_opts, args)
 158     (_, _, errs) -> do
 159       hPutStrLn stderr $ "Command line error: "  ++ concat errs
 160       hPutStrLn stderr $ usageHelp progname options
 161       exitWith $ ExitFailure 2
 162
 163 -- | Small wrapper over getArgs and 'parseOpts'.
 164 parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
 165 parseArgs cmd options = do
 166   cmd_args <- getArgs
 167   parseOpts cmd_args cmd options
 168
 169 -- * Daemon-related functions
 170 -- | PID file mode.
 171 pidFileMode :: FileMode
 172 pidFileMode = unionFileModes ownerReadMode ownerWriteMode
 173
 174 -- | Writes a PID file and locks it.
 175 _writePidFile :: FilePath -> IO Fd
 176 _writePidFile path = do
 177   fd <- createFile path pidFileMode
 178   setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 179   my_pid <- getProcessID
 180   _ <- fdWrite fd (show my_pid ++ "\n")
 181   return fd
 182
 183 -- | Wrapper over '_writePidFile' that transforms IO exceptions into a
 184 -- 'Bad' value.
 185 writePidFile :: FilePath -> IO (Result Fd)
 186 writePidFile path = do
 187   catch (fmap Ok $ _writePidFile path) (return . Bad . show)
 188
 189 -- | Sets up a daemon's environment.
 190 setupDaemonEnv :: FilePath -> FileMode -> IO ()
 191 setupDaemonEnv cwd umask = do
 192   changeWorkingDirectory cwd
 193   _ <- setFileCreationMask umask
 194   _ <- createSession
 195   return ()
 196
 197 -- | Run an I/O action as a daemon.
 198 --
 199 -- WARNING: this only works in single-threaded mode (either using the
 200 -- single-threaded runtime, or using the multi-threaded one but with
 201 -- only one OS thread, i.e. -N1).
 202 --
 203 -- FIXME: this doesn't support error reporting and the prepfn
 204 -- functionality.
 205 daemonize :: IO () -> IO ()
 206 daemonize action = do
 207   -- first fork
 208   _ <- forkProcess $ do
 209     -- in the child
 210     setupDaemonEnv "/" (unionFileModes groupModes otherModes)
 211     _ <- forkProcess action
 212     exitImmediately ExitSuccess
 213   exitImmediately ExitSuccess
 214
 215 -- | Generic daemon startup.
 216 genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
 217 genericMain daemon options main = do
 218   let progname = daemonName daemon
 219   (opts, args) <- parseArgs progname options
 220
 221   when (optShowHelp opts) $ do
 222     putStr $ usageHelp progname options
 223     exitWith ExitSuccess
 224   when (optShowVer opts) $ do
 225     printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 226            progname Version.version
 227            compilerName (Data.Version.showVersion compilerVersion)
 228            os arch :: IO ()
 229     exitWith ExitSuccess
 230   unless (null args) $ do
 231          hPutStrLn stderr "This program doesn't take any arguments"
 232          exitWith $ ExitFailure C.exitFailure
 233
 234   unless (optNoUserChecks opts) $ do
 235     runtimeEnts <- getEnts
 236     case runtimeEnts of
 237       Bad msg -> do
 238         hPutStrLn stderr $ "Can't find required user/groups: " ++ msg
 239         exitWith $ ExitFailure C.exitFailure
 240       Ok ents -> verifyDaemonUser daemon ents
 241
 242   let processFn = if optDaemonize opts then daemonize else id
 243   processFn $ innerMain daemon opts (main opts)
 244
 245 -- | Inner daemon function.
 246 --
 247 -- This is executed after daemonization.
 248 innerMain :: GanetiDaemon -> DaemonOptions -> IO () -> IO ()
 249 innerMain daemon opts main = do
 250   setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
 251                  (not (optDaemonize opts)) False
 252   pid_fd <- writePidFile (daemonPidFile daemon)
 253   case pid_fd of
 254     Bad msg -> do
 255          hPutStrLn stderr $ "Cannot write PID file; already locked? Error: " ++
 256                    msg
 257          exitWith $ ExitFailure 1
 258     _ -> return ()
 259   logNotice "starting"
 260   main