1 {-| Implementation of the generic daemon functionality.
7 Copyright (C) 2011, 2012 Google Inc.
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.
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.
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
45 import qualified Data.Version
47 import qualified Network.Socket as Socket
48 import System.Console.GetOpt
50 import System.Environment
53 import System.Posix.Directory
54 import System.Posix.Files
55 import System.Posix.IO
56 import System.Posix.Process
57 import System.Posix.Types
62 import Ganeti.BasicTypes
63 import Ganeti.HTools.Utils
64 import qualified Ganeti.HTools.Version as Version(version)
65 import qualified Ganeti.Constants as C
66 import qualified Ganeti.Ssconf as Ssconf
70 -- | Command line options structure.
71 data DaemonOptions = DaemonOptions
72 { optShowHelp :: Bool -- ^ Just show the help
73 , optShowVer :: Bool -- ^ Just show the program version
74 , optDaemonize :: Bool -- ^ Whether to daemonize or not
75 , optPort :: Maybe Word16 -- ^ Override for the network port
76 , optDebug :: Bool -- ^ Enable debug messages
77 , optNoUserChecks :: Bool -- ^ Ignore user checks
78 , optBindAddress :: Maybe String -- ^ Override for the bind address
79 , optSyslogUsage :: Maybe SyslogUsage -- ^ Override for Syslog usage
82 -- | Default values for the command line options.
83 defaultOptions :: DaemonOptions
84 defaultOptions = DaemonOptions
90 , optNoUserChecks = False
91 , optBindAddress = Nothing
92 , optSyslogUsage = Nothing
95 -- | Abrreviation for the option type.
96 type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
98 -- | Helper function for required arguments which need to be converted
99 -- as opposed to stored just as string.
100 reqWithConversion :: (String -> Result a)
101 -> (a -> DaemonOptions -> Result DaemonOptions)
103 -> ArgDescr (DaemonOptions -> Result DaemonOptions)
104 reqWithConversion conversion_fn updater_fn metavar =
105 ReqArg (\string_opt opts -> do
106 parsed_value <- conversion_fn string_opt
107 updater_fn parsed_value opts) metavar
109 -- * Command line options
112 oShowHelp = Option "h" ["help"]
113 (NoArg (\ opts -> Ok opts { optShowHelp = True}))
114 "Show the help message and exit"
117 oShowVer = Option "V" ["version"]
118 (NoArg (\ opts -> Ok opts { optShowVer = True}))
119 "Show the version of the program and exit"
121 oNoDaemonize :: OptType
122 oNoDaemonize = Option "f" ["foreground"]
123 (NoArg (\ opts -> Ok opts { optDaemonize = False}))
124 "Don't detach from the current terminal"
127 oDebug = Option "d" ["debug"]
128 (NoArg (\ opts -> Ok opts { optDebug = True }))
129 "Enable debug messages"
131 oNoUserChecks :: OptType
132 oNoUserChecks = Option "" ["no-user-checks"]
133 (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
136 oPort :: Int -> OptType
137 oPort def = Option "p" ["port"]
138 (reqWithConversion (tryRead "reading port")
139 (\port opts -> Ok opts { optPort = Just port }) "PORT")
140 ("Network port (default: " ++ show def ++ ")")
142 oBindAddress :: OptType
143 oBindAddress = Option "b" ["bind"]
144 (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
146 "Bind address (default depends on cluster configuration)"
148 oSyslogUsage :: OptType
149 oSyslogUsage = Option "" ["syslog"]
150 (reqWithConversion syslogUsageFromRaw
151 (\su opts -> Ok opts { optSyslogUsage = Just su })
153 ("Enable logging to syslog (except debug \
154 \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
158 usageHelp :: String -> [OptType] -> String
160 usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
161 progname Version.version progname)
163 -- | Command line parser, using the 'Options' structure.
164 parseOpts :: [String] -- ^ The command line arguments
165 -> String -- ^ The program name
166 -> [OptType] -- ^ The supported command line options
167 -> IO (DaemonOptions, [String]) -- ^ The resulting options
168 -- and leftover arguments
169 parseOpts argv progname options =
170 case getOpt Permute options argv of
171 (opt_list, args, []) ->
174 case foldM (flip id) defaultOptions opt_list of
176 hPutStrLn stderr "Error while parsing command\
179 exitWith $ ExitFailure 1
181 return (parsed_opts, args)
183 hPutStrLn stderr $ "Command line error: " ++ concat errs
184 hPutStrLn stderr $ usageHelp progname options
185 exitWith $ ExitFailure 2
187 -- | Small wrapper over getArgs and 'parseOpts'.
188 parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
189 parseArgs cmd options = do
191 parseOpts cmd_args cmd options
193 -- * Daemon-related functions
195 pidFileMode :: FileMode
196 pidFileMode = unionFileModes ownerReadMode ownerWriteMode
198 -- | Writes a PID file and locks it.
199 _writePidFile :: FilePath -> IO Fd
200 _writePidFile path = do
201 fd <- createFile path pidFileMode
202 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
203 my_pid <- getProcessID
204 _ <- fdWrite fd (show my_pid ++ "\n")
207 -- | Wrapper over '_writePidFile' that transforms IO exceptions into a
209 writePidFile :: FilePath -> IO (Result Fd)
210 writePidFile path = do
211 catch (fmap Ok $ _writePidFile path) (return . Bad . show)
213 -- | Sets up a daemon's environment.
214 setupDaemonEnv :: FilePath -> FileMode -> IO ()
215 setupDaemonEnv cwd umask = do
216 changeWorkingDirectory cwd
217 _ <- setFileCreationMask umask
221 -- | Computes the default bind address for a given family.
222 defaultBindAddr :: Int -- ^ The port we want
223 -> Socket.Family -- ^ The cluster IP family
224 -> Result (Socket.Family, Socket.SockAddr)
225 defaultBindAddr port Socket.AF_INET =
226 Ok $ (Socket.AF_INET,
227 Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
228 defaultBindAddr port Socket.AF_INET6 =
229 Ok $ (Socket.AF_INET6,
230 Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
231 defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
233 -- | Default hints for the resolver
234 resolveAddrHints :: Maybe Socket.AddrInfo
236 Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
237 Socket.AI_NUMERICSERV] }
239 -- | Resolves a numeric address.
240 resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
241 resolveAddr port str = do
242 resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
243 return $ case resolved of
244 [] -> Bad "Invalid results from lookup?"
245 best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best)
247 -- | Based on the options, compute the socket address to use for the
249 parseAddress :: DaemonOptions -- ^ Command line options
250 -> Int -- ^ Default port for this daemon
251 -> IO (Result (Socket.Family, Socket.SockAddr))
252 parseAddress opts defport = do
253 let port = maybe defport fromIntegral $ optPort opts
254 def_family <- Ssconf.getPrimaryIPFamily Nothing
255 ainfo <- case optBindAddress opts of
256 Nothing -> return (def_family >>= defaultBindAddr port)
257 Just saddr -> catch (resolveAddr port saddr)
258 (annotateIOError $ "Invalid address " ++ saddr)
261 -- | Run an I/O action as a daemon.
263 -- WARNING: this only works in single-threaded mode (either using the
264 -- single-threaded runtime, or using the multi-threaded one but with
265 -- only one OS thread, i.e. -N1).
267 -- FIXME: this doesn't support error reporting and the prepfn
269 daemonize :: IO () -> IO ()
270 daemonize action = do
272 _ <- forkProcess $ do
274 setupDaemonEnv "/" (unionFileModes groupModes otherModes)
275 _ <- forkProcess action
276 exitImmediately ExitSuccess
277 exitImmediately ExitSuccess
279 -- | Generic daemon startup.
280 genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
281 genericMain daemon options main = do
282 let progname = daemonName daemon
283 (opts, args) <- parseArgs progname options
285 when (optShowHelp opts) $ do
286 putStr $ usageHelp progname options
288 when (optShowVer opts) $ do
289 printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
290 progname Version.version
291 compilerName (Data.Version.showVersion compilerVersion)
294 unless (null args) $ do
295 hPutStrLn stderr "This program doesn't take any arguments"
296 exitWith $ ExitFailure C.exitFailure
298 unless (optNoUserChecks opts) $ do
299 runtimeEnts <- getEnts
302 hPutStrLn stderr $ "Can't find required user/groups: " ++ msg
303 exitWith $ ExitFailure C.exitFailure
304 Ok ents -> verifyDaemonUser daemon ents
306 syslog <- case optSyslogUsage opts of
307 Nothing -> exitIfBad $
308 annotateResult "Invalid cluster syslog setting" $
309 syslogUsageFromRaw C.syslogUsage
311 let processFn = if optDaemonize opts then daemonize else id
312 processFn $ innerMain daemon opts syslog (main opts)
314 -- | Inner daemon function.
316 -- This is executed after daemonization.
317 innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
318 innerMain daemon opts syslog main = do
319 setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
320 (not (optDaemonize opts)) False syslog
321 pid_fd <- writePidFile (daemonPidFile daemon)
324 hPutStrLn stderr $ "Cannot write PID file; already locked? Error: " ++
326 exitWith $ ExitFailure 1