Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Daemon.hs @ 7b9ceea7

History | View | Annotate | Download (14 kB)

1 6ec7a50e Iustin Pop
{-| Implementation of the generic daemon functionality.
2 6ec7a50e Iustin Pop
3 6ec7a50e Iustin Pop
-}
4 6ec7a50e Iustin Pop
5 6ec7a50e Iustin Pop
{-
6 6ec7a50e Iustin Pop
7 6ec7a50e Iustin Pop
Copyright (C) 2011, 2012 Google Inc.
8 6ec7a50e Iustin Pop
9 6ec7a50e Iustin Pop
This program is free software; you can redistribute it and/or modify
10 6ec7a50e Iustin Pop
it under the terms of the GNU General Public License as published by
11 6ec7a50e Iustin Pop
the Free Software Foundation; either version 2 of the License, or
12 6ec7a50e Iustin Pop
(at your option) any later version.
13 6ec7a50e Iustin Pop
14 6ec7a50e Iustin Pop
This program is distributed in the hope that it will be useful, but
15 6ec7a50e Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
16 6ec7a50e Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 6ec7a50e Iustin Pop
General Public License for more details.
18 6ec7a50e Iustin Pop
19 6ec7a50e Iustin Pop
You should have received a copy of the GNU General Public License
20 6ec7a50e Iustin Pop
along with this program; if not, write to the Free Software
21 6ec7a50e Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 6ec7a50e Iustin Pop
02110-1301, USA.
23 6ec7a50e Iustin Pop
24 6ec7a50e Iustin Pop
-}
25 6ec7a50e Iustin Pop
26 6ec7a50e Iustin Pop
module Ganeti.Daemon
27 6ec7a50e Iustin Pop
  ( DaemonOptions(..)
28 6ec7a50e Iustin Pop
  , OptType
29 2ac2e420 Iustin Pop
  , CheckFn
30 2ac2e420 Iustin Pop
  , PrepFn
31 2ac2e420 Iustin Pop
  , MainFn
32 6ec7a50e Iustin Pop
  , defaultOptions
33 6ec7a50e Iustin Pop
  , oShowHelp
34 6ec7a50e Iustin Pop
  , oShowVer
35 6ec7a50e Iustin Pop
  , oNoDaemonize
36 6ec7a50e Iustin Pop
  , oNoUserChecks
37 6ec7a50e Iustin Pop
  , oDebug
38 6ec7a50e Iustin Pop
  , oPort
39 152e05e1 Iustin Pop
  , oBindAddress
40 b714ff89 Iustin Pop
  , oSyslogUsage
41 6ec7a50e Iustin Pop
  , parseArgs
42 152e05e1 Iustin Pop
  , parseAddress
43 0d0ac025 Iustin Pop
  , cleanupSocket
44 e14b84e9 Iustin Pop
  , describeError
45 6ec7a50e Iustin Pop
  , genericMain
46 6ec7a50e Iustin Pop
  ) where
47 6ec7a50e Iustin Pop
48 79ac58fa Iustin Pop
import Control.Exception
49 6ec7a50e Iustin Pop
import Control.Monad
50 0c28bee1 Iustin Pop
import Data.Maybe (fromMaybe)
51 6ec7a50e Iustin Pop
import Data.Word
52 0c28bee1 Iustin Pop
import GHC.IO.Handle (hDuplicateTo)
53 152e05e1 Iustin Pop
import qualified Network.Socket as Socket
54 6ec7a50e Iustin Pop
import System.Console.GetOpt
55 6ec7a50e Iustin Pop
import System.Exit
56 6ec7a50e Iustin Pop
import System.Environment
57 6ec7a50e Iustin Pop
import System.IO
58 e14b84e9 Iustin Pop
import System.IO.Error (isDoesNotExistError, modifyIOError, annotateIOError)
59 6ec7a50e Iustin Pop
import System.Posix.Directory
60 6ec7a50e Iustin Pop
import System.Posix.Files
61 6ec7a50e Iustin Pop
import System.Posix.IO
62 6ec7a50e Iustin Pop
import System.Posix.Process
63 6ec7a50e Iustin Pop
import System.Posix.Types
64 36691f08 Iustin Pop
import System.Posix.Signals
65 6ec7a50e Iustin Pop
66 51000365 Iustin Pop
import Ganeti.Common as Common
67 6ec7a50e Iustin Pop
import Ganeti.Logging
68 6ec7a50e Iustin Pop
import Ganeti.Runtime
69 6ec7a50e Iustin Pop
import Ganeti.BasicTypes
70 26d62e4c Iustin Pop
import Ganeti.Utils
71 6ec7a50e Iustin Pop
import qualified Ganeti.Constants as C
72 152e05e1 Iustin Pop
import qualified Ganeti.Ssconf as Ssconf
73 6ec7a50e Iustin Pop
74 0c28bee1 Iustin Pop
-- * Constants
75 0c28bee1 Iustin Pop
76 0c28bee1 Iustin Pop
-- | \/dev\/null path.
77 0c28bee1 Iustin Pop
devNull :: FilePath
78 0c28bee1 Iustin Pop
devNull = "/dev/null"
79 0c28bee1 Iustin Pop
80 b9097468 Iustin Pop
-- | Error message prefix, used in two separate paths (when forking
81 b9097468 Iustin Pop
-- and when not).
82 b9097468 Iustin Pop
daemonStartupErr :: String -> String
83 b9097468 Iustin Pop
daemonStartupErr = ("Error when starting the daemon process: " ++)
84 b9097468 Iustin Pop
85 6ec7a50e Iustin Pop
-- * Data types
86 6ec7a50e Iustin Pop
87 6ec7a50e Iustin Pop
-- | Command line options structure.
88 6ec7a50e Iustin Pop
data DaemonOptions = DaemonOptions
89 6ec7a50e Iustin Pop
  { optShowHelp     :: Bool           -- ^ Just show the help
90 6ec7a50e Iustin Pop
  , optShowVer      :: Bool           -- ^ Just show the program version
91 097ad7ee Iustin Pop
  , optShowComp     :: Bool           -- ^ Just show the completion info
92 6ec7a50e Iustin Pop
  , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
93 6ec7a50e Iustin Pop
  , optPort         :: Maybe Word16   -- ^ Override for the network port
94 6ec7a50e Iustin Pop
  , optDebug        :: Bool           -- ^ Enable debug messages
95 6ec7a50e Iustin Pop
  , optNoUserChecks :: Bool           -- ^ Ignore user checks
96 152e05e1 Iustin Pop
  , optBindAddress  :: Maybe String   -- ^ Override for the bind address
97 b714ff89 Iustin Pop
  , optSyslogUsage  :: Maybe SyslogUsage -- ^ Override for Syslog usage
98 6ec7a50e Iustin Pop
  }
99 6ec7a50e Iustin Pop
100 6ec7a50e Iustin Pop
-- | Default values for the command line options.
101 6ec7a50e Iustin Pop
defaultOptions :: DaemonOptions
102 6ec7a50e Iustin Pop
defaultOptions  = DaemonOptions
103 6ec7a50e Iustin Pop
  { optShowHelp     = False
104 6ec7a50e Iustin Pop
  , optShowVer      = False
105 097ad7ee Iustin Pop
  , optShowComp     = False
106 6ec7a50e Iustin Pop
  , optDaemonize    = True
107 6ec7a50e Iustin Pop
  , optPort         = Nothing
108 6ec7a50e Iustin Pop
  , optDebug        = False
109 6ec7a50e Iustin Pop
  , optNoUserChecks = False
110 152e05e1 Iustin Pop
  , optBindAddress  = Nothing
111 b714ff89 Iustin Pop
  , optSyslogUsage  = Nothing
112 6ec7a50e Iustin Pop
  }
113 6ec7a50e Iustin Pop
114 51000365 Iustin Pop
instance StandardOptions DaemonOptions where
115 51000365 Iustin Pop
  helpRequested = optShowHelp
116 51000365 Iustin Pop
  verRequested  = optShowVer
117 097ad7ee Iustin Pop
  compRequested = optShowComp
118 5b11f8db Iustin Pop
  requestHelp o = o { optShowHelp = True }
119 5b11f8db Iustin Pop
  requestVer  o = o { optShowVer  = True }
120 097ad7ee Iustin Pop
  requestComp o = o { optShowComp = True }
121 51000365 Iustin Pop
122 6ec7a50e Iustin Pop
-- | Abrreviation for the option type.
123 51000365 Iustin Pop
type OptType = GenericOptType DaemonOptions
124 6ec7a50e Iustin Pop
125 2ac2e420 Iustin Pop
-- | Check function type.
126 2ac2e420 Iustin Pop
type CheckFn a = DaemonOptions -> IO (Either ExitCode a)
127 2ac2e420 Iustin Pop
128 2ac2e420 Iustin Pop
-- | Prepare function type.
129 2ac2e420 Iustin Pop
type PrepFn a b = DaemonOptions -> a -> IO b
130 2ac2e420 Iustin Pop
131 2ac2e420 Iustin Pop
-- | Main execution function type.
132 2ac2e420 Iustin Pop
type MainFn a b = DaemonOptions -> a -> b -> IO ()
133 2ac2e420 Iustin Pop
134 6ec7a50e Iustin Pop
-- * Command line options
135 6ec7a50e Iustin Pop
136 6ec7a50e Iustin Pop
oNoDaemonize :: OptType
137 ce207617 Iustin Pop
oNoDaemonize =
138 ce207617 Iustin Pop
  (Option "f" ["foreground"]
139 ce207617 Iustin Pop
   (NoArg (\ opts -> Ok opts { optDaemonize = False}))
140 ce207617 Iustin Pop
   "Don't detach from the current terminal",
141 ce207617 Iustin Pop
   OptComplNone)
142 6ec7a50e Iustin Pop
143 6ec7a50e Iustin Pop
oDebug :: OptType
144 ce207617 Iustin Pop
oDebug =
145 ce207617 Iustin Pop
  (Option "d" ["debug"]
146 ce207617 Iustin Pop
   (NoArg (\ opts -> Ok opts { optDebug = True }))
147 ce207617 Iustin Pop
   "Enable debug messages",
148 ce207617 Iustin Pop
   OptComplNone)
149 6ec7a50e Iustin Pop
150 6ec7a50e Iustin Pop
oNoUserChecks :: OptType
151 ce207617 Iustin Pop
oNoUserChecks =
152 ce207617 Iustin Pop
  (Option "" ["no-user-checks"]
153 ce207617 Iustin Pop
   (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
154 ce207617 Iustin Pop
   "Ignore user checks",
155 ce207617 Iustin Pop
   OptComplNone)
156 6ec7a50e Iustin Pop
157 6ec7a50e Iustin Pop
oPort :: Int -> OptType
158 ce207617 Iustin Pop
oPort def =
159 ce207617 Iustin Pop
  (Option "p" ["port"]
160 ce207617 Iustin Pop
   (reqWithConversion (tryRead "reading port")
161 ce207617 Iustin Pop
    (\port opts -> Ok opts { optPort = Just port }) "PORT")
162 ce207617 Iustin Pop
   ("Network port (default: " ++ show def ++ ")"),
163 ecebe9f6 Iustin Pop
   OptComplInteger)
164 6ec7a50e Iustin Pop
165 152e05e1 Iustin Pop
oBindAddress :: OptType
166 ce207617 Iustin Pop
oBindAddress =
167 ce207617 Iustin Pop
  (Option "b" ["bind"]
168 ce207617 Iustin Pop
   (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
169 ce207617 Iustin Pop
    "ADDR")
170 ce207617 Iustin Pop
   "Bind address (default depends on cluster configuration)",
171 ce207617 Iustin Pop
   OptComplInetAddr)
172 152e05e1 Iustin Pop
173 b714ff89 Iustin Pop
oSyslogUsage :: OptType
174 ce207617 Iustin Pop
oSyslogUsage =
175 ce207617 Iustin Pop
  (Option "" ["syslog"]
176 ce207617 Iustin Pop
   (reqWithConversion syslogUsageFromRaw
177 ce207617 Iustin Pop
    (\su opts -> Ok opts { optSyslogUsage = Just su })
178 ce207617 Iustin Pop
    "SYSLOG")
179 ce207617 Iustin Pop
   ("Enable logging to syslog (except debug \
180 ce207617 Iustin Pop
    \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
181 ce207617 Iustin Pop
    "]"),
182 ce207617 Iustin Pop
   OptComplChoices ["yes", "no", "only"])
183 b714ff89 Iustin Pop
184 42834645 Iustin Pop
-- | Generic options.
185 42834645 Iustin Pop
genericOpts :: [OptType]
186 42834645 Iustin Pop
genericOpts = [ oShowHelp
187 42834645 Iustin Pop
              , oShowVer
188 097ad7ee Iustin Pop
              , oShowComp
189 42834645 Iustin Pop
              ]
190 42834645 Iustin Pop
191 7413b229 Iustin Pop
-- | Annotates and transforms IOErrors into a Result type. This can be
192 7413b229 Iustin Pop
-- used in the error handler argument to 'catch', for example.
193 7413b229 Iustin Pop
ioErrorToResult :: String -> IOError -> IO (Result a)
194 7413b229 Iustin Pop
ioErrorToResult description exc =
195 7413b229 Iustin Pop
  return . Bad $ description ++ ": " ++ show exc
196 7413b229 Iustin Pop
197 6ec7a50e Iustin Pop
-- | Small wrapper over getArgs and 'parseOpts'.
198 6ec7a50e Iustin Pop
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
199 6ec7a50e Iustin Pop
parseArgs cmd options = do
200 6ec7a50e Iustin Pop
  cmd_args <- getArgs
201 22278fa7 Iustin Pop
  parseOpts defaultOptions cmd_args cmd (options ++ genericOpts) []
202 6ec7a50e Iustin Pop
203 6ec7a50e Iustin Pop
-- * Daemon-related functions
204 a4c0fe1e Iustin Pop
205 6ec7a50e Iustin Pop
-- | PID file mode.
206 6ec7a50e Iustin Pop
pidFileMode :: FileMode
207 6ec7a50e Iustin Pop
pidFileMode = unionFileModes ownerReadMode ownerWriteMode
208 6ec7a50e Iustin Pop
209 a4c0fe1e Iustin Pop
-- | PID file open flags.
210 a4c0fe1e Iustin Pop
pidFileFlags :: OpenFileFlags
211 a4c0fe1e Iustin Pop
pidFileFlags = defaultFileFlags { noctty = True, trunc = False }
212 a4c0fe1e Iustin Pop
213 6ec7a50e Iustin Pop
-- | Writes a PID file and locks it.
214 e14b84e9 Iustin Pop
writePidFile :: FilePath -> IO Fd
215 e14b84e9 Iustin Pop
writePidFile path = do
216 a4c0fe1e Iustin Pop
  fd <- openFd path ReadWrite (Just pidFileMode) pidFileFlags
217 6ec7a50e Iustin Pop
  setLock fd (WriteLock, AbsoluteSeek, 0, 0)
218 6ec7a50e Iustin Pop
  my_pid <- getProcessID
219 6ec7a50e Iustin Pop
  _ <- fdWrite fd (show my_pid ++ "\n")
220 6ec7a50e Iustin Pop
  return fd
221 6ec7a50e Iustin Pop
222 0d0ac025 Iustin Pop
-- | Helper function to ensure a socket doesn't exist. Should only be
223 0d0ac025 Iustin Pop
-- called once we have locked the pid file successfully.
224 0d0ac025 Iustin Pop
cleanupSocket :: FilePath -> IO ()
225 5b11f8db Iustin Pop
cleanupSocket socketPath =
226 0d0ac025 Iustin Pop
  catchJust (guard . isDoesNotExistError) (removeLink socketPath)
227 0d0ac025 Iustin Pop
            (const $ return ())
228 0d0ac025 Iustin Pop
229 6ec7a50e Iustin Pop
-- | Sets up a daemon's environment.
230 6ec7a50e Iustin Pop
setupDaemonEnv :: FilePath -> FileMode -> IO ()
231 6ec7a50e Iustin Pop
setupDaemonEnv cwd umask = do
232 6ec7a50e Iustin Pop
  changeWorkingDirectory cwd
233 6ec7a50e Iustin Pop
  _ <- setFileCreationMask umask
234 6ec7a50e Iustin Pop
  _ <- createSession
235 6ec7a50e Iustin Pop
  return ()
236 6ec7a50e Iustin Pop
237 36691f08 Iustin Pop
-- | Signal handler for reopening log files.
238 36691f08 Iustin Pop
handleSigHup :: FilePath -> IO ()
239 36691f08 Iustin Pop
handleSigHup path = do
240 36691f08 Iustin Pop
  setupDaemonFDs (Just path)
241 36691f08 Iustin Pop
  logInfo "Reopening log files after receiving SIGHUP"
242 36691f08 Iustin Pop
243 0c28bee1 Iustin Pop
-- | Sets up a daemon's standard file descriptors.
244 0c28bee1 Iustin Pop
setupDaemonFDs :: Maybe FilePath -> IO ()
245 0c28bee1 Iustin Pop
setupDaemonFDs logfile = do
246 0c28bee1 Iustin Pop
  null_in_handle <- openFile devNull ReadMode
247 0c28bee1 Iustin Pop
  null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
248 0c28bee1 Iustin Pop
  hDuplicateTo null_in_handle stdin
249 0c28bee1 Iustin Pop
  hDuplicateTo null_out_handle stdout
250 0c28bee1 Iustin Pop
  hDuplicateTo null_out_handle stderr
251 0c28bee1 Iustin Pop
  hClose null_in_handle
252 0c28bee1 Iustin Pop
  hClose null_out_handle
253 0c28bee1 Iustin Pop
254 152e05e1 Iustin Pop
-- | Computes the default bind address for a given family.
255 152e05e1 Iustin Pop
defaultBindAddr :: Int                  -- ^ The port we want
256 152e05e1 Iustin Pop
                -> Socket.Family        -- ^ The cluster IP family
257 152e05e1 Iustin Pop
                -> Result (Socket.Family, Socket.SockAddr)
258 152e05e1 Iustin Pop
defaultBindAddr port Socket.AF_INET =
259 5b11f8db Iustin Pop
  Ok (Socket.AF_INET,
260 5b11f8db Iustin Pop
      Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
261 152e05e1 Iustin Pop
defaultBindAddr port Socket.AF_INET6 =
262 5b11f8db Iustin Pop
  Ok (Socket.AF_INET6,
263 5b11f8db Iustin Pop
      Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
264 152e05e1 Iustin Pop
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
265 152e05e1 Iustin Pop
266 152e05e1 Iustin Pop
-- | Default hints for the resolver
267 152e05e1 Iustin Pop
resolveAddrHints :: Maybe Socket.AddrInfo
268 152e05e1 Iustin Pop
resolveAddrHints =
269 152e05e1 Iustin Pop
  Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
270 152e05e1 Iustin Pop
                                                 Socket.AI_NUMERICSERV] }
271 152e05e1 Iustin Pop
272 152e05e1 Iustin Pop
-- | Resolves a numeric address.
273 152e05e1 Iustin Pop
resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
274 152e05e1 Iustin Pop
resolveAddr port str = do
275 152e05e1 Iustin Pop
  resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
276 152e05e1 Iustin Pop
  return $ case resolved of
277 152e05e1 Iustin Pop
             [] -> Bad "Invalid results from lookup?"
278 5b11f8db Iustin Pop
             best:_ -> Ok (Socket.addrFamily best, Socket.addrAddress best)
279 152e05e1 Iustin Pop
280 152e05e1 Iustin Pop
-- | Based on the options, compute the socket address to use for the
281 152e05e1 Iustin Pop
-- daemon.
282 152e05e1 Iustin Pop
parseAddress :: DaemonOptions      -- ^ Command line options
283 152e05e1 Iustin Pop
             -> Int                -- ^ Default port for this daemon
284 152e05e1 Iustin Pop
             -> IO (Result (Socket.Family, Socket.SockAddr))
285 152e05e1 Iustin Pop
parseAddress opts defport = do
286 152e05e1 Iustin Pop
  let port = maybe defport fromIntegral $ optPort opts
287 152e05e1 Iustin Pop
  def_family <- Ssconf.getPrimaryIPFamily Nothing
288 5b11f8db Iustin Pop
  case optBindAddress opts of
289 5b11f8db Iustin Pop
    Nothing -> return (def_family >>= defaultBindAddr port)
290 b9612abb Iustin Pop
    Just saddr -> Control.Exception.catch
291 b9612abb Iustin Pop
                    (resolveAddr port saddr)
292 7413b229 Iustin Pop
                    (ioErrorToResult $ "Invalid address " ++ saddr)
293 152e05e1 Iustin Pop
294 e14b84e9 Iustin Pop
-- | Run an I\/O action that might throw an I\/O error, under a
295 e14b84e9 Iustin Pop
-- handler that will simply annotate and re-throw the exception.
296 e14b84e9 Iustin Pop
describeError :: String -> Maybe Handle -> Maybe FilePath -> IO a -> IO a
297 e14b84e9 Iustin Pop
describeError descr hndl fpath =
298 e14b84e9 Iustin Pop
  modifyIOError (\e -> annotateIOError e descr hndl fpath)
299 e14b84e9 Iustin Pop
300 e14b84e9 Iustin Pop
-- | Run an I\/O action as a daemon.
301 6ec7a50e Iustin Pop
--
302 6ec7a50e Iustin Pop
-- WARNING: this only works in single-threaded mode (either using the
303 6ec7a50e Iustin Pop
-- single-threaded runtime, or using the multi-threaded one but with
304 6ec7a50e Iustin Pop
-- only one OS thread, i.e. -N1).
305 b9097468 Iustin Pop
daemonize :: FilePath -> (Maybe Fd -> IO ()) -> IO ()
306 0c28bee1 Iustin Pop
daemonize logfile action = do
307 b9097468 Iustin Pop
  (rpipe, wpipe) <- createPipe
308 6ec7a50e Iustin Pop
  -- first fork
309 6ec7a50e Iustin Pop
  _ <- forkProcess $ do
310 6ec7a50e Iustin Pop
    -- in the child
311 b9097468 Iustin Pop
    closeFd rpipe
312 1a865afe Iustin Pop
    let wpipe' = Just wpipe
313 6ec7a50e Iustin Pop
    setupDaemonEnv "/" (unionFileModes groupModes otherModes)
314 1a865afe Iustin Pop
    setupDaemonFDs (Just logfile) `Control.Exception.catch`
315 1a865afe Iustin Pop
      handlePrepErr False wpipe'
316 36691f08 Iustin Pop
    _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
317 b9097468 Iustin Pop
    -- second fork, launches the actual child code; standard
318 b9097468 Iustin Pop
    -- double-fork technique
319 1a865afe Iustin Pop
    _ <- forkProcess (action wpipe')
320 6ec7a50e Iustin Pop
    exitImmediately ExitSuccess
321 b9097468 Iustin Pop
  closeFd wpipe
322 b9097468 Iustin Pop
  hndl <- fdToHandle rpipe
323 b9097468 Iustin Pop
  errors <- hGetContents hndl
324 b9097468 Iustin Pop
  ecode <- if null errors
325 b9097468 Iustin Pop
             then return ExitSuccess
326 b9097468 Iustin Pop
             else do
327 b9097468 Iustin Pop
               hPutStrLn stderr $ daemonStartupErr errors
328 b9097468 Iustin Pop
               return $ ExitFailure C.exitFailure
329 b9097468 Iustin Pop
  exitImmediately ecode
330 6ec7a50e Iustin Pop
331 6ec7a50e Iustin Pop
-- | Generic daemon startup.
332 2ac2e420 Iustin Pop
genericMain :: GanetiDaemon -- ^ The daemon we're running
333 2ac2e420 Iustin Pop
            -> [OptType]    -- ^ The available options
334 2ac2e420 Iustin Pop
            -> CheckFn a    -- ^ Check function
335 2ac2e420 Iustin Pop
            -> PrepFn  a b  -- ^ Prepare function
336 2ac2e420 Iustin Pop
            -> MainFn  a b  -- ^ Execution function
337 2ac2e420 Iustin Pop
            -> IO ()
338 2ac2e420 Iustin Pop
genericMain daemon options check_fn prep_fn exec_fn = do
339 6ec7a50e Iustin Pop
  let progname = daemonName daemon
340 6ec7a50e Iustin Pop
  (opts, args) <- parseArgs progname options
341 6ec7a50e Iustin Pop
342 88a10df5 Iustin Pop
  exitUnless (null args) "This program doesn't take any arguments"
343 6ec7a50e Iustin Pop
344 6ec7a50e Iustin Pop
  unless (optNoUserChecks opts) $ do
345 6ec7a50e Iustin Pop
    runtimeEnts <- getEnts
346 88a10df5 Iustin Pop
    ents <- exitIfBad "Can't find required user/groups" runtimeEnts
347 88a10df5 Iustin Pop
    verifyDaemonUser daemon ents
348 6ec7a50e Iustin Pop
349 b714ff89 Iustin Pop
  syslog <- case optSyslogUsage opts of
350 88a10df5 Iustin Pop
              Nothing -> exitIfBad "Invalid cluster syslog setting" $
351 b714ff89 Iustin Pop
                         syslogUsageFromRaw C.syslogUsage
352 b714ff89 Iustin Pop
              Just v -> return v
353 2ac2e420 Iustin Pop
354 29a30533 Iustin Pop
  log_file <- daemonLogFile daemon
355 2ac2e420 Iustin Pop
  -- run the check function and optionally exit if it returns an exit code
356 2ac2e420 Iustin Pop
  check_result <- check_fn opts
357 2ac2e420 Iustin Pop
  check_result' <- case check_result of
358 2ac2e420 Iustin Pop
                     Left code -> exitWith code
359 2ac2e420 Iustin Pop
                     Right v -> return v
360 2ac2e420 Iustin Pop
361 0c28bee1 Iustin Pop
  let processFn = if optDaemonize opts
362 29a30533 Iustin Pop
                    then daemonize log_file
363 b9097468 Iustin Pop
                    else \action -> action Nothing
364 2ac2e420 Iustin Pop
  processFn $ innerMain daemon opts syslog check_result' prep_fn exec_fn
365 6ec7a50e Iustin Pop
366 b9097468 Iustin Pop
-- | Full prepare function.
367 b9097468 Iustin Pop
--
368 b9097468 Iustin Pop
-- This is executed after daemonization, and sets up both the log
369 b9097468 Iustin Pop
-- files (a generic functionality) and the custom prepare function of
370 b9097468 Iustin Pop
-- the daemon.
371 b9097468 Iustin Pop
fullPrep :: GanetiDaemon  -- ^ The daemon we're running
372 b9097468 Iustin Pop
         -> DaemonOptions -- ^ The options structure, filled from the cmdline
373 b9097468 Iustin Pop
         -> SyslogUsage   -- ^ Syslog mode
374 b9097468 Iustin Pop
         -> a             -- ^ Check results
375 b9097468 Iustin Pop
         -> PrepFn a b    -- ^ Prepare function
376 b9097468 Iustin Pop
         -> IO b
377 b9097468 Iustin Pop
fullPrep daemon opts syslog check_result prep_fn = do
378 29a30533 Iustin Pop
  logfile <- if optDaemonize opts
379 29a30533 Iustin Pop
               then return Nothing
380 29a30533 Iustin Pop
               else liftM Just $ daemonLogFile daemon
381 29a30533 Iustin Pop
  pidfile <- daemonPidFile daemon
382 29a30533 Iustin Pop
  let dname = daemonName daemon
383 48483a2e Iustin Pop
  setupLogging logfile dname (optDebug opts) True False syslog
384 e14b84e9 Iustin Pop
  _ <- describeError "writing PID file; already locked?"
385 e14b84e9 Iustin Pop
         Nothing (Just pidfile) $ writePidFile pidfile
386 48483a2e Iustin Pop
  logNotice $ dname ++ " daemon startup"
387 b9097468 Iustin Pop
  prep_fn opts check_result
388 b9097468 Iustin Pop
389 6ec7a50e Iustin Pop
-- | Inner daemon function.
390 6ec7a50e Iustin Pop
--
391 6ec7a50e Iustin Pop
-- This is executed after daemonization.
392 2ac2e420 Iustin Pop
innerMain :: GanetiDaemon  -- ^ The daemon we're running
393 2ac2e420 Iustin Pop
          -> DaemonOptions -- ^ The options structure, filled from the cmdline
394 2ac2e420 Iustin Pop
          -> SyslogUsage   -- ^ Syslog mode
395 2ac2e420 Iustin Pop
          -> a             -- ^ Check results
396 2ac2e420 Iustin Pop
          -> PrepFn a b    -- ^ Prepare function
397 2ac2e420 Iustin Pop
          -> MainFn a b    -- ^ Execution function
398 b9097468 Iustin Pop
          -> Maybe Fd      -- ^ Error reporting function
399 2ac2e420 Iustin Pop
          -> IO ()
400 b9097468 Iustin Pop
innerMain daemon opts syslog check_result prep_fn exec_fn fd = do
401 b9097468 Iustin Pop
  prep_result <- fullPrep daemon opts syslog check_result prep_fn
402 1a865afe Iustin Pop
                 `Control.Exception.catch` handlePrepErr True fd
403 b9097468 Iustin Pop
  -- no error reported, we should now close the fd
404 b9097468 Iustin Pop
  maybeCloseFd fd
405 2ac2e420 Iustin Pop
  exec_fn opts check_result prep_result
406 b9097468 Iustin Pop
407 b9097468 Iustin Pop
-- | Daemon prepare error handling function.
408 1a865afe Iustin Pop
handlePrepErr :: Bool -> Maybe Fd -> IOError -> IO a
409 1a865afe Iustin Pop
handlePrepErr logging_setup fd err = do
410 b9097468 Iustin Pop
  let msg = show err
411 b9097468 Iustin Pop
  case fd of
412 b9097468 Iustin Pop
    -- explicitly writing to the fd directly, since when forking it's
413 b9097468 Iustin Pop
    -- better (safer) than trying to convert this into a full handle
414 b9097468 Iustin Pop
    Just fd' -> fdWrite fd' msg >> return ()
415 b9097468 Iustin Pop
    Nothing  -> hPutStrLn stderr (daemonStartupErr msg)
416 1a865afe Iustin Pop
  when logging_setup $ logError msg
417 b9097468 Iustin Pop
  exitWith $ ExitFailure 1
418 b9097468 Iustin Pop
419 b9097468 Iustin Pop
-- | Close a file descriptor.
420 b9097468 Iustin Pop
maybeCloseFd :: Maybe Fd -> IO ()
421 b9097468 Iustin Pop
maybeCloseFd Nothing   = return ()
422 b9097468 Iustin Pop
maybeCloseFd (Just fd) = closeFd fd