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