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 Control.Exception
47 import Data.Maybe (fromMaybe)
49 import GHC.IO.Handle (hDuplicateTo)
50 import qualified Network.Socket as Socket
51 import Prelude hiding (catch)
52 import System.Console.GetOpt
54 import System.Environment
56 import System.IO.Error (isDoesNotExistError)
57 import System.Posix.Directory
58 import System.Posix.Files
59 import System.Posix.IO
60 import System.Posix.Process
61 import System.Posix.Types
62 import System.Posix.Signals
64 import Ganeti.Common as Common
67 import Ganeti.BasicTypes
68 import Ganeti.HTools.Utils
69 import qualified Ganeti.Constants as C
70 import qualified Ganeti.Ssconf as Ssconf
74 -- | \/dev\/null path.
80 -- | Command line options structure.
81 data DaemonOptions = DaemonOptions
82 { optShowHelp :: Bool -- ^ Just show the help
83 , optShowVer :: Bool -- ^ Just show the program version
84 , optDaemonize :: Bool -- ^ Whether to daemonize or not
85 , optPort :: Maybe Word16 -- ^ Override for the network port
86 , optDebug :: Bool -- ^ Enable debug messages
87 , optNoUserChecks :: Bool -- ^ Ignore user checks
88 , optBindAddress :: Maybe String -- ^ Override for the bind address
89 , optSyslogUsage :: Maybe SyslogUsage -- ^ Override for Syslog usage
92 -- | Default values for the command line options.
93 defaultOptions :: DaemonOptions
94 defaultOptions = DaemonOptions
100 , optNoUserChecks = False
101 , optBindAddress = Nothing
102 , optSyslogUsage = Nothing
105 instance StandardOptions DaemonOptions where
106 helpRequested = optShowHelp
107 verRequested = optShowVer
108 requestHelp o = o { optShowHelp = True }
109 requestVer o = o { optShowVer = True }
111 -- | Abrreviation for the option type.
112 type OptType = GenericOptType DaemonOptions
114 -- * Command line options
116 oNoDaemonize :: OptType
117 oNoDaemonize = Option "f" ["foreground"]
118 (NoArg (\ opts -> Ok opts { optDaemonize = False}))
119 "Don't detach from the current terminal"
122 oDebug = Option "d" ["debug"]
123 (NoArg (\ opts -> Ok opts { optDebug = True }))
124 "Enable debug messages"
126 oNoUserChecks :: OptType
127 oNoUserChecks = Option "" ["no-user-checks"]
128 (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
131 oPort :: Int -> OptType
132 oPort def = Option "p" ["port"]
133 (reqWithConversion (tryRead "reading port")
134 (\port opts -> Ok opts { optPort = Just port }) "PORT")
135 ("Network port (default: " ++ show def ++ ")")
137 oBindAddress :: OptType
138 oBindAddress = Option "b" ["bind"]
139 (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
141 "Bind address (default depends on cluster configuration)"
143 oSyslogUsage :: OptType
144 oSyslogUsage = Option "" ["syslog"]
145 (reqWithConversion syslogUsageFromRaw
146 (\su opts -> Ok opts { optSyslogUsage = Just su })
148 ("Enable logging to syslog (except debug \
149 \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
152 -- | Generic options.
153 genericOpts :: [OptType]
154 genericOpts = [ oShowHelp
158 -- | Small wrapper over getArgs and 'parseOpts'.
159 parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
160 parseArgs cmd options = do
162 parseOpts defaultOptions cmd_args cmd $ options ++ genericOpts
164 -- * Daemon-related functions
166 pidFileMode :: FileMode
167 pidFileMode = unionFileModes ownerReadMode ownerWriteMode
169 -- | Writes a PID file and locks it.
170 _writePidFile :: FilePath -> IO Fd
171 _writePidFile path = do
172 fd <- createFile path pidFileMode
173 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
174 my_pid <- getProcessID
175 _ <- fdWrite fd (show my_pid ++ "\n")
178 -- | Helper to format an IOError.
179 formatIOError :: String -> IOError -> String
180 formatIOError msg err = msg ++ ": " ++ show err
182 -- | Wrapper over '_writePidFile' that transforms IO exceptions into a
184 writePidFile :: FilePath -> IO (Result Fd)
186 catch (fmap Ok $ _writePidFile path)
187 (return . Bad . formatIOError "Failure during writing of the pid file")
189 -- | Helper function to ensure a socket doesn't exist. Should only be
190 -- called once we have locked the pid file successfully.
191 cleanupSocket :: FilePath -> IO ()
192 cleanupSocket socketPath =
193 catchJust (guard . isDoesNotExistError) (removeLink socketPath)
196 -- | Sets up a daemon's environment.
197 setupDaemonEnv :: FilePath -> FileMode -> IO ()
198 setupDaemonEnv cwd umask = do
199 changeWorkingDirectory cwd
200 _ <- setFileCreationMask umask
204 -- | Signal handler for reopening log files.
205 handleSigHup :: FilePath -> IO ()
206 handleSigHup path = do
207 setupDaemonFDs (Just path)
208 logInfo "Reopening log files after receiving SIGHUP"
210 -- | Sets up a daemon's standard file descriptors.
211 setupDaemonFDs :: Maybe FilePath -> IO ()
212 setupDaemonFDs logfile = do
213 null_in_handle <- openFile devNull ReadMode
214 null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
215 hDuplicateTo null_in_handle stdin
216 hDuplicateTo null_out_handle stdout
217 hDuplicateTo null_out_handle stderr
218 hClose null_in_handle
219 hClose null_out_handle
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 =
227 Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
228 defaultBindAddr port 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 case optBindAddress opts of
256 Nothing -> return (def_family >>= defaultBindAddr port)
257 Just saddr -> catch (resolveAddr port saddr)
258 (annotateIOError $ "Invalid address " ++ saddr)
260 -- | Run an I/O action as a daemon.
262 -- WARNING: this only works in single-threaded mode (either using the
263 -- single-threaded runtime, or using the multi-threaded one but with
264 -- only one OS thread, i.e. -N1).
266 -- FIXME: this doesn't support error reporting and the prepfn
268 daemonize :: FilePath -> IO () -> IO ()
269 daemonize logfile action = do
271 _ <- forkProcess $ do
273 setupDaemonEnv "/" (unionFileModes groupModes otherModes)
274 setupDaemonFDs $ Just logfile
275 _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
276 _ <- forkProcess action
277 exitImmediately ExitSuccess
278 exitImmediately ExitSuccess
280 -- | Generic daemon startup.
281 genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
282 genericMain daemon options main = do
283 let progname = daemonName daemon
284 (opts, args) <- parseArgs progname options
286 exitUnless (null args) "This program doesn't take any arguments"
288 unless (optNoUserChecks opts) $ do
289 runtimeEnts <- getEnts
290 ents <- exitIfBad "Can't find required user/groups" runtimeEnts
291 verifyDaemonUser daemon ents
293 syslog <- case optSyslogUsage opts of
294 Nothing -> exitIfBad "Invalid cluster syslog setting" $
295 syslogUsageFromRaw C.syslogUsage
297 let processFn = if optDaemonize opts
298 then daemonize (daemonLogFile daemon)
300 processFn $ innerMain daemon opts syslog (main opts)
302 -- | Inner daemon function.
304 -- This is executed after daemonization.
305 innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
306 innerMain daemon opts syslog main = do
307 let logfile = if optDaemonize opts
309 else Just $ daemonLogFile daemon
310 setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog
311 pid_fd <- writePidFile (daemonPidFile daemon)
312 _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd