43 |
43 |
|
44 |
44 |
import Control.Exception
|
45 |
45 |
import Control.Monad
|
|
46 |
import Data.Maybe (fromMaybe)
|
46 |
47 |
import qualified Data.Version
|
47 |
48 |
import Data.Word
|
|
49 |
import GHC.IO.Handle (hDuplicateTo)
|
48 |
50 |
import qualified Network.Socket as Socket
|
49 |
51 |
import Prelude hiding (catch)
|
50 |
52 |
import System.Console.GetOpt
|
... | ... | |
67 |
69 |
import qualified Ganeti.Constants as C
|
68 |
70 |
import qualified Ganeti.Ssconf as Ssconf
|
69 |
71 |
|
|
72 |
-- * Constants
|
|
73 |
|
|
74 |
-- | \/dev\/null path.
|
|
75 |
devNull :: FilePath
|
|
76 |
devNull = "/dev/null"
|
|
77 |
|
70 |
78 |
-- * Data types
|
71 |
79 |
|
72 |
80 |
-- | Command line options structure.
|
... | ... | |
220 |
228 |
_ <- createSession
|
221 |
229 |
return ()
|
222 |
230 |
|
|
231 |
-- | Sets up a daemon's standard file descriptors.
|
|
232 |
setupDaemonFDs :: Maybe FilePath -> IO ()
|
|
233 |
setupDaemonFDs logfile = do
|
|
234 |
null_in_handle <- openFile devNull ReadMode
|
|
235 |
null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
|
|
236 |
hDuplicateTo null_in_handle stdin
|
|
237 |
hDuplicateTo null_out_handle stdout
|
|
238 |
hDuplicateTo null_out_handle stderr
|
|
239 |
hClose null_in_handle
|
|
240 |
hClose null_out_handle
|
|
241 |
|
223 |
242 |
-- | Computes the default bind address for a given family.
|
224 |
243 |
defaultBindAddr :: Int -- ^ The port we want
|
225 |
244 |
-> Socket.Family -- ^ The cluster IP family
|
... | ... | |
268 |
287 |
--
|
269 |
288 |
-- FIXME: this doesn't support error reporting and the prepfn
|
270 |
289 |
-- functionality.
|
271 |
|
daemonize :: IO () -> IO ()
|
272 |
|
daemonize action = do
|
|
290 |
daemonize :: FilePath -> IO () -> IO ()
|
|
291 |
daemonize logfile action = do
|
273 |
292 |
-- first fork
|
274 |
293 |
_ <- forkProcess $ do
|
275 |
294 |
-- in the child
|
276 |
295 |
setupDaemonEnv "/" (unionFileModes groupModes otherModes)
|
|
296 |
setupDaemonFDs $ Just logfile
|
277 |
297 |
_ <- forkProcess action
|
278 |
298 |
exitImmediately ExitSuccess
|
279 |
299 |
exitImmediately ExitSuccess
|
... | ... | |
305 |
325 |
Nothing -> exitIfBad "Invalid cluster syslog setting" $
|
306 |
326 |
syslogUsageFromRaw C.syslogUsage
|
307 |
327 |
Just v -> return v
|
308 |
|
let processFn = if optDaemonize opts then daemonize else id
|
|
328 |
let processFn = if optDaemonize opts
|
|
329 |
then daemonize (daemonLogFile daemon)
|
|
330 |
else id
|
309 |
331 |
processFn $ innerMain daemon opts syslog (main opts)
|
310 |
332 |
|
311 |
333 |
-- | Inner daemon function.
|
... | ... | |
313 |
335 |
-- This is executed after daemonization.
|
314 |
336 |
innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
|
315 |
337 |
innerMain daemon opts syslog main = do
|
316 |
|
setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
|
317 |
|
(not (optDaemonize opts)) False syslog
|
|
338 |
let logfile = if optDaemonize opts
|
|
339 |
then Nothing
|
|
340 |
else Just $ daemonLogFile daemon
|
|
341 |
setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog
|
318 |
342 |
pid_fd <- writePidFile (daemonPidFile daemon)
|
319 |
343 |
_ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
|
320 |
344 |
logNotice "starting"
|