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 -- | Small wrapper over getArgs and 'parseOpts'.
153 parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
154 parseArgs cmd options = do
156 parseOpts defaultOptions cmd_args cmd options
158 -- * Daemon-related functions
160 pidFileMode :: FileMode
161 pidFileMode = unionFileModes ownerReadMode ownerWriteMode
163 -- | Writes a PID file and locks it.
164 _writePidFile :: FilePath -> IO Fd
165 _writePidFile path = do
166 fd <- createFile path pidFileMode
167 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
168 my_pid <- getProcessID
169 _ <- fdWrite fd (show my_pid ++ "\n")
172 -- | Helper to format an IOError.
173 formatIOError :: String -> IOError -> String
174 formatIOError msg err = msg ++ ": " ++ show err
176 -- | Wrapper over '_writePidFile' that transforms IO exceptions into a
178 writePidFile :: FilePath -> IO (Result Fd)
180 catch (fmap Ok $ _writePidFile path)
181 (return . Bad . formatIOError "Failure during writing of the pid file")
183 -- | Helper function to ensure a socket doesn't exist. Should only be
184 -- called once we have locked the pid file successfully.
185 cleanupSocket :: FilePath -> IO ()
186 cleanupSocket socketPath =
187 catchJust (guard . isDoesNotExistError) (removeLink socketPath)
190 -- | Sets up a daemon's environment.
191 setupDaemonEnv :: FilePath -> FileMode -> IO ()
192 setupDaemonEnv cwd umask = do
193 changeWorkingDirectory cwd
194 _ <- setFileCreationMask umask
198 -- | Signal handler for reopening log files.
199 handleSigHup :: FilePath -> IO ()
200 handleSigHup path = do
201 setupDaemonFDs (Just path)
202 logInfo "Reopening log files after receiving SIGHUP"
204 -- | Sets up a daemon's standard file descriptors.
205 setupDaemonFDs :: Maybe FilePath -> IO ()
206 setupDaemonFDs logfile = do
207 null_in_handle <- openFile devNull ReadMode
208 null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
209 hDuplicateTo null_in_handle stdin
210 hDuplicateTo null_out_handle stdout
211 hDuplicateTo null_out_handle stderr
212 hClose null_in_handle
213 hClose null_out_handle
215 -- | Computes the default bind address for a given family.
216 defaultBindAddr :: Int -- ^ The port we want
217 -> Socket.Family -- ^ The cluster IP family
218 -> Result (Socket.Family, Socket.SockAddr)
219 defaultBindAddr port Socket.AF_INET =
221 Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
222 defaultBindAddr port Socket.AF_INET6 =
224 Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
225 defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
227 -- | Default hints for the resolver
228 resolveAddrHints :: Maybe Socket.AddrInfo
230 Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
231 Socket.AI_NUMERICSERV] }
233 -- | Resolves a numeric address.
234 resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
235 resolveAddr port str = do
236 resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
237 return $ case resolved of
238 [] -> Bad "Invalid results from lookup?"
239 best:_ -> Ok (Socket.addrFamily best, Socket.addrAddress best)
241 -- | Based on the options, compute the socket address to use for the
243 parseAddress :: DaemonOptions -- ^ Command line options
244 -> Int -- ^ Default port for this daemon
245 -> IO (Result (Socket.Family, Socket.SockAddr))
246 parseAddress opts defport = do
247 let port = maybe defport fromIntegral $ optPort opts
248 def_family <- Ssconf.getPrimaryIPFamily Nothing
249 case optBindAddress opts of
250 Nothing -> return (def_family >>= defaultBindAddr port)
251 Just saddr -> catch (resolveAddr port saddr)
252 (annotateIOError $ "Invalid address " ++ saddr)
254 -- | Run an I/O action as a daemon.
256 -- WARNING: this only works in single-threaded mode (either using the
257 -- single-threaded runtime, or using the multi-threaded one but with
258 -- only one OS thread, i.e. -N1).
260 -- FIXME: this doesn't support error reporting and the prepfn
262 daemonize :: FilePath -> IO () -> IO ()
263 daemonize logfile action = do
265 _ <- forkProcess $ do
267 setupDaemonEnv "/" (unionFileModes groupModes otherModes)
268 setupDaemonFDs $ Just logfile
269 _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
270 _ <- forkProcess action
271 exitImmediately ExitSuccess
272 exitImmediately ExitSuccess
274 -- | Generic daemon startup.
275 genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
276 genericMain daemon options main = do
277 let progname = daemonName daemon
278 (opts, args) <- parseArgs progname options
280 exitUnless (null args) "This program doesn't take any arguments"
282 unless (optNoUserChecks opts) $ do
283 runtimeEnts <- getEnts
284 ents <- exitIfBad "Can't find required user/groups" runtimeEnts
285 verifyDaemonUser daemon ents
287 syslog <- case optSyslogUsage opts of
288 Nothing -> exitIfBad "Invalid cluster syslog setting" $
289 syslogUsageFromRaw C.syslogUsage
291 let processFn = if optDaemonize opts
292 then daemonize (daemonLogFile daemon)
294 processFn $ innerMain daemon opts syslog (main opts)
296 -- | Inner daemon function.
298 -- This is executed after daemonization.
299 innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
300 innerMain daemon opts syslog main = do
301 let logfile = if optDaemonize opts
303 else Just $ daemonLogFile daemon
304 setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog
305 pid_fd <- writePidFile (daemonPidFile daemon)
306 _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd