Revision 0c28bee1 htools/Ganeti/Daemon.hs
b/htools/Ganeti/Daemon.hs | ||
---|---|---|
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" |
Also available in: Unified diff