Revision 6ec7a50e

b/Makefile.am
397 397
	htools/Ganeti/BasicTypes.hs \
398 398
	htools/Ganeti/Confd.hs \
399 399
	htools/Ganeti/Config.hs \
400
	htools/Ganeti/Daemon.hs \
400 401
	htools/Ganeti/Hash.hs \
401 402
	htools/Ganeti/Jobs.hs \
402 403
	htools/Ganeti/Logging.hs \
b/htools/Ganeti/Daemon.hs
1
{-| Implementation of the generic daemon functionality.
2

  
3
-}
4

  
5
{-
6

  
7
Copyright (C) 2011, 2012 Google Inc.
8

  
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.
13

  
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.
18

  
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
22
02110-1301, USA.
23

  
24
-}
25

  
26
module Ganeti.Daemon
27
  ( DaemonOptions(..)
28
  , OptType
29
  , defaultOptions
30
  , oShowHelp
31
  , oShowVer
32
  , oNoDaemonize
33
  , oNoUserChecks
34
  , oDebug
35
  , oPort
36
  , parseArgs
37
  , writePidFile
38
  , genericMain
39
  ) where
40

  
41
import Control.Monad
42
import qualified Data.Version
43
import Data.Word
44
import System.Console.GetOpt
45
import System.Exit
46
import System.Environment
47
import System.Info
48
import System.IO
49
import System.Posix.Directory
50
import System.Posix.Files
51
import System.Posix.IO
52
import System.Posix.Process
53
import System.Posix.Types
54
import Text.Printf
55

  
56
import Ganeti.Logging
57
import Ganeti.Runtime
58
import Ganeti.BasicTypes
59
import Ganeti.HTools.Utils
60
import qualified Ganeti.HTools.Version as Version(version)
61
import qualified Ganeti.Constants as C
62

  
63
-- * Data types
64

  
65
-- | Command line options structure.
66
data DaemonOptions = DaemonOptions
67
  { optShowHelp     :: Bool           -- ^ Just show the help
68
  , optShowVer      :: Bool           -- ^ Just show the program version
69
  , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
70
  , optPort         :: Maybe Word16   -- ^ Override for the network port
71
  , optDebug        :: Bool           -- ^ Enable debug messages
72
  , optNoUserChecks :: Bool           -- ^ Ignore user checks
73
  }
74

  
75
-- | Default values for the command line options.
76
defaultOptions :: DaemonOptions
77
defaultOptions  = DaemonOptions
78
  { optShowHelp     = False
79
  , optShowVer      = False
80
  , optDaemonize    = True
81
  , optPort         = Nothing
82
  , optDebug        = False
83
  , optNoUserChecks = False
84
  }
85

  
86
-- | Abrreviation for the option type.
87
type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
88

  
89
-- | Helper function for required arguments which need to be converted
90
-- as opposed to stored just as string.
91
reqWithConversion :: (String -> Result a)
92
                  -> (a -> DaemonOptions -> Result DaemonOptions)
93
                  -> String
94
                  -> ArgDescr (DaemonOptions -> Result DaemonOptions)
95
reqWithConversion conversion_fn updater_fn metavar =
96
  ReqArg (\string_opt opts -> do
97
            parsed_value <- conversion_fn string_opt
98
            updater_fn parsed_value opts) metavar
99

  
100
-- * Command line options
101

  
102
oShowHelp :: OptType
103
oShowHelp = Option "h" ["help"]
104
            (NoArg (\ opts -> Ok opts { optShowHelp = True}))
105
            "Show the help message and exit"
106

  
107
oShowVer :: OptType
108
oShowVer = Option "V" ["version"]
109
           (NoArg (\ opts -> Ok opts { optShowVer = True}))
110
           "Show the version of the program and exit"
111

  
112
oNoDaemonize :: OptType
113
oNoDaemonize = Option "f" ["foreground"]
114
               (NoArg (\ opts -> Ok opts { optDaemonize = False}))
115
               "Don't detach from the current terminal"
116

  
117
oDebug :: OptType
118
oDebug = Option "d" ["debug"]
119
         (NoArg (\ opts -> Ok opts { optDebug = True }))
120
         "Enable debug messages"
121

  
122
oNoUserChecks :: OptType
123
oNoUserChecks = Option "" ["no-user-checks"]
124
         (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
125
         "Ignore user checks"
126

  
127
oPort :: Int -> OptType
128
oPort def = Option "p" ["--port"]
129
            (reqWithConversion (tryRead "reading port")
130
             (\port opts -> Ok opts { optPort = Just port }) "PORT")
131
            ("Network port (default: " ++ show def ++ ")")
132

  
133
-- | Usage info.
134
usageHelp :: String -> [OptType] -> String
135
usageHelp progname =
136
  usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
137
             progname Version.version progname)
138

  
139
-- | Command line parser, using the 'Options' structure.
140
parseOpts :: [String]               -- ^ The command line arguments
141
          -> String                 -- ^ The program name
142
          -> [OptType]              -- ^ The supported command line options
143
          -> IO (DaemonOptions, [String]) -- ^ The resulting options
144
                                          -- and leftover arguments
145
parseOpts argv progname options =
146
  case getOpt Permute options argv of
147
    (opt_list, args, []) ->
148
      do
149
        parsed_opts <-
150
          case foldM (flip id) defaultOptions opt_list of
151
            Bad msg -> do
152
              hPutStrLn stderr "Error while parsing command\
153
                               \line arguments:"
154
              hPutStrLn stderr msg
155
              exitWith $ ExitFailure 1
156
            Ok val -> return val
157
        return (parsed_opts, args)
158
    (_, _, errs) -> do
159
      hPutStrLn stderr $ "Command line error: "  ++ concat errs
160
      hPutStrLn stderr $ usageHelp progname options
161
      exitWith $ ExitFailure 2
162

  
163
-- | Small wrapper over getArgs and 'parseOpts'.
164
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
165
parseArgs cmd options = do
166
  cmd_args <- getArgs
167
  parseOpts cmd_args cmd options
168

  
169
-- * Daemon-related functions
170
-- | PID file mode.
171
pidFileMode :: FileMode
172
pidFileMode = unionFileModes ownerReadMode ownerWriteMode
173

  
174
-- | Writes a PID file and locks it.
175
_writePidFile :: FilePath -> IO Fd
176
_writePidFile path = do
177
  fd <- createFile path pidFileMode
178
  setLock fd (WriteLock, AbsoluteSeek, 0, 0)
179
  my_pid <- getProcessID
180
  _ <- fdWrite fd (show my_pid ++ "\n")
181
  return fd
182

  
183
-- | Wrapper over '_writePidFile' that transforms IO exceptions into a
184
-- 'Bad' value.
185
writePidFile :: FilePath -> IO (Result Fd)
186
writePidFile path = do
187
  catch (fmap Ok $ _writePidFile path) (return . Bad . show)
188

  
189
-- | Sets up a daemon's environment.
190
setupDaemonEnv :: FilePath -> FileMode -> IO ()
191
setupDaemonEnv cwd umask = do
192
  changeWorkingDirectory cwd
193
  _ <- setFileCreationMask umask
194
  _ <- createSession
195
  return ()
196

  
197
-- | Run an I/O action as a daemon.
198
--
199
-- WARNING: this only works in single-threaded mode (either using the
200
-- single-threaded runtime, or using the multi-threaded one but with
201
-- only one OS thread, i.e. -N1).
202
--
203
-- FIXME: this doesn't support error reporting and the prepfn
204
-- functionality.
205
daemonize :: IO () -> IO ()
206
daemonize action = do
207
  -- first fork
208
  _ <- forkProcess $ do
209
    -- in the child
210
    setupDaemonEnv "/" (unionFileModes groupModes otherModes)
211
    _ <- forkProcess action
212
    exitImmediately ExitSuccess
213
  exitImmediately ExitSuccess
214

  
215
-- | Generic daemon startup.
216
genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
217
genericMain daemon options main = do
218
  let progname = daemonName daemon
219
  (opts, args) <- parseArgs progname options
220

  
221
  when (optShowHelp opts) $ do
222
    putStr $ usageHelp progname options
223
    exitWith ExitSuccess
224
  when (optShowVer opts) $ do
225
    printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
226
           progname Version.version
227
           compilerName (Data.Version.showVersion compilerVersion)
228
           os arch :: IO ()
229
    exitWith ExitSuccess
230
  unless (null args) $ do
231
         hPutStrLn stderr "This program doesn't take any arguments"
232
         exitWith $ ExitFailure C.exitFailure
233

  
234
  unless (optNoUserChecks opts) $ do
235
    runtimeEnts <- getEnts
236
    case runtimeEnts of
237
      Bad msg -> do
238
        hPutStrLn stderr $ "Can't find required user/groups: " ++ msg
239
        exitWith $ ExitFailure C.exitFailure
240
      Ok ents -> verifyDaemonUser daemon ents
241

  
242
  let processFn = if optDaemonize opts then daemonize else id
243
  processFn $ innerMain daemon opts (main opts)
244

  
245
-- | Inner daemon function.
246
--
247
-- This is executed after daemonization.
248
innerMain :: GanetiDaemon -> DaemonOptions -> IO () -> IO ()
249
innerMain daemon opts main = do
250
  setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
251
                 (not (optDaemonize opts)) False
252
  pid_fd <- writePidFile (daemonPidFile daemon)
253
  case pid_fd of
254
    Bad msg -> do
255
         hPutStrLn stderr $ "Cannot write PID file; already locked? Error: " ++
256
                   msg
257
         exitWith $ ExitFailure 1
258
    _ -> return ()
259
  logNotice "starting"
260
  main

Also available in: Unified diff