Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Daemon.hs @ 0c28bee1

History | View | Annotate | Download (11.7 kB)

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
  , oBindAddress
37
  , oSyslogUsage
38
  , parseArgs
39
  , parseAddress
40
  , writePidFile
41
  , genericMain
42
  ) where
43

    
44
import Control.Exception
45
import Control.Monad
46
import Data.Maybe (fromMaybe)
47
import qualified Data.Version
48
import Data.Word
49
import GHC.IO.Handle (hDuplicateTo)
50
import qualified Network.Socket as Socket
51
import Prelude hiding (catch)
52
import System.Console.GetOpt
53
import System.Exit
54
import System.Environment
55
import System.Info
56
import System.IO
57
import System.Posix.Directory
58
import System.Posix.Files
59
import System.Posix.IO
60
import System.Posix.Process
61
import System.Posix.Types
62
import Text.Printf
63

    
64
import Ganeti.Logging
65
import Ganeti.Runtime
66
import Ganeti.BasicTypes
67
import Ganeti.HTools.Utils
68
import qualified Ganeti.HTools.Version as Version(version)
69
import qualified Ganeti.Constants as C
70
import qualified Ganeti.Ssconf as Ssconf
71

    
72
-- * Constants
73

    
74
-- | \/dev\/null path.
75
devNull :: FilePath
76
devNull = "/dev/null"
77

    
78
-- * Data types
79

    
80
-- | Command line options structure.
81
data DaemonOptions = DaemonOptions
82
  { optShowHelp     :: Bool           -- ^ Just show the help
83
  , optShowVer      :: Bool           -- ^ Just show the program version
84
  , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
85
  , optPort         :: Maybe Word16   -- ^ Override for the network port
86
  , optDebug        :: Bool           -- ^ Enable debug messages
87
  , optNoUserChecks :: Bool           -- ^ Ignore user checks
88
  , optBindAddress  :: Maybe String   -- ^ Override for the bind address
89
  , optSyslogUsage  :: Maybe SyslogUsage -- ^ Override for Syslog usage
90
  }
91

    
92
-- | Default values for the command line options.
93
defaultOptions :: DaemonOptions
94
defaultOptions  = DaemonOptions
95
  { optShowHelp     = False
96
  , optShowVer      = False
97
  , optDaemonize    = True
98
  , optPort         = Nothing
99
  , optDebug        = False
100
  , optNoUserChecks = False
101
  , optBindAddress  = Nothing
102
  , optSyslogUsage  = Nothing
103
  }
104

    
105
-- | Abrreviation for the option type.
106
type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
107

    
108
-- | Helper function for required arguments which need to be converted
109
-- as opposed to stored just as string.
110
reqWithConversion :: (String -> Result a)
111
                  -> (a -> DaemonOptions -> Result DaemonOptions)
112
                  -> String
113
                  -> ArgDescr (DaemonOptions -> Result DaemonOptions)
114
reqWithConversion conversion_fn updater_fn metavar =
115
  ReqArg (\string_opt opts -> do
116
            parsed_value <- conversion_fn string_opt
117
            updater_fn parsed_value opts) metavar
118

    
119
-- * Command line options
120

    
121
oShowHelp :: OptType
122
oShowHelp = Option "h" ["help"]
123
            (NoArg (\ opts -> Ok opts { optShowHelp = True}))
124
            "Show the help message and exit"
125

    
126
oShowVer :: OptType
127
oShowVer = Option "V" ["version"]
128
           (NoArg (\ opts -> Ok opts { optShowVer = True}))
129
           "Show the version of the program and exit"
130

    
131
oNoDaemonize :: OptType
132
oNoDaemonize = Option "f" ["foreground"]
133
               (NoArg (\ opts -> Ok opts { optDaemonize = False}))
134
               "Don't detach from the current terminal"
135

    
136
oDebug :: OptType
137
oDebug = Option "d" ["debug"]
138
         (NoArg (\ opts -> Ok opts { optDebug = True }))
139
         "Enable debug messages"
140

    
141
oNoUserChecks :: OptType
142
oNoUserChecks = Option "" ["no-user-checks"]
143
         (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
144
         "Ignore user checks"
145

    
146
oPort :: Int -> OptType
147
oPort def = Option "p" ["port"]
148
            (reqWithConversion (tryRead "reading port")
149
             (\port opts -> Ok opts { optPort = Just port }) "PORT")
150
            ("Network port (default: " ++ show def ++ ")")
151

    
152
oBindAddress :: OptType
153
oBindAddress = Option "b" ["bind"]
154
               (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
155
                "ADDR")
156
               "Bind address (default depends on cluster configuration)"
157

    
158
oSyslogUsage :: OptType
159
oSyslogUsage = Option "" ["syslog"]
160
               (reqWithConversion syslogUsageFromRaw
161
                (\su opts -> Ok opts { optSyslogUsage = Just su })
162
                "SYSLOG")
163
               ("Enable logging to syslog (except debug \
164
                \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
165
                "]")
166

    
167
-- | Usage info.
168
usageHelp :: String -> [OptType] -> String
169
usageHelp progname =
170
  usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
171
             progname Version.version progname)
172

    
173
-- | Command line parser, using the 'Options' structure.
174
parseOpts :: [String]               -- ^ The command line arguments
175
          -> String                 -- ^ The program name
176
          -> [OptType]              -- ^ The supported command line options
177
          -> IO (DaemonOptions, [String]) -- ^ The resulting options
178
                                          -- and leftover arguments
179
parseOpts argv progname options =
180
  case getOpt Permute options argv of
181
    (opt_list, args, []) ->
182
      do
183
        parsed_opts <-
184
          exitIfBad "Error while parsing command line arguments" $
185
          foldM (flip id) defaultOptions opt_list
186
        return (parsed_opts, args)
187
    (_, _, errs) -> do
188
      hPutStrLn stderr $ "Command line error: "  ++ concat errs
189
      hPutStrLn stderr $ usageHelp progname options
190
      exitWith $ ExitFailure 2
191

    
192
-- | Small wrapper over getArgs and 'parseOpts'.
193
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
194
parseArgs cmd options = do
195
  cmd_args <- getArgs
196
  parseOpts cmd_args cmd options
197

    
198
-- * Daemon-related functions
199
-- | PID file mode.
200
pidFileMode :: FileMode
201
pidFileMode = unionFileModes ownerReadMode ownerWriteMode
202

    
203
-- | Writes a PID file and locks it.
204
_writePidFile :: FilePath -> IO Fd
205
_writePidFile path = do
206
  fd <- createFile path pidFileMode
207
  setLock fd (WriteLock, AbsoluteSeek, 0, 0)
208
  my_pid <- getProcessID
209
  _ <- fdWrite fd (show my_pid ++ "\n")
210
  return fd
211

    
212
-- | Helper to format an IOError.
213
formatIOError :: String -> IOError -> String
214
formatIOError msg err = msg ++ ": " ++  show err
215

    
216
-- | Wrapper over '_writePidFile' that transforms IO exceptions into a
217
-- 'Bad' value.
218
writePidFile :: FilePath -> IO (Result Fd)
219
writePidFile path = do
220
  catch (fmap Ok $ _writePidFile path)
221
    (return . Bad . formatIOError "Failure during writing of the pid file")
222

    
223
-- | Sets up a daemon's environment.
224
setupDaemonEnv :: FilePath -> FileMode -> IO ()
225
setupDaemonEnv cwd umask = do
226
  changeWorkingDirectory cwd
227
  _ <- setFileCreationMask umask
228
  _ <- createSession
229
  return ()
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

    
242
-- | Computes the default bind address for a given family.
243
defaultBindAddr :: Int                  -- ^ The port we want
244
                -> Socket.Family        -- ^ The cluster IP family
245
                -> Result (Socket.Family, Socket.SockAddr)
246
defaultBindAddr port Socket.AF_INET =
247
  Ok $ (Socket.AF_INET,
248
        Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
249
defaultBindAddr port Socket.AF_INET6 =
250
  Ok $ (Socket.AF_INET6,
251
        Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
252
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
253

    
254
-- | Default hints for the resolver
255
resolveAddrHints :: Maybe Socket.AddrInfo
256
resolveAddrHints =
257
  Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
258
                                                 Socket.AI_NUMERICSERV] }
259

    
260
-- | Resolves a numeric address.
261
resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
262
resolveAddr port str = do
263
  resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
264
  return $ case resolved of
265
             [] -> Bad "Invalid results from lookup?"
266
             best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best)
267

    
268
-- | Based on the options, compute the socket address to use for the
269
-- daemon.
270
parseAddress :: DaemonOptions      -- ^ Command line options
271
             -> Int                -- ^ Default port for this daemon
272
             -> IO (Result (Socket.Family, Socket.SockAddr))
273
parseAddress opts defport = do
274
  let port = maybe defport fromIntegral $ optPort opts
275
  def_family <- Ssconf.getPrimaryIPFamily Nothing
276
  ainfo <- case optBindAddress opts of
277
             Nothing -> return (def_family >>= defaultBindAddr port)
278
             Just saddr -> catch (resolveAddr port saddr)
279
                           (annotateIOError $ "Invalid address " ++ saddr)
280
  return ainfo
281

    
282
-- | Run an I/O action as a daemon.
283
--
284
-- WARNING: this only works in single-threaded mode (either using the
285
-- single-threaded runtime, or using the multi-threaded one but with
286
-- only one OS thread, i.e. -N1).
287
--
288
-- FIXME: this doesn't support error reporting and the prepfn
289
-- functionality.
290
daemonize :: FilePath -> IO () -> IO ()
291
daemonize logfile action = do
292
  -- first fork
293
  _ <- forkProcess $ do
294
    -- in the child
295
    setupDaemonEnv "/" (unionFileModes groupModes otherModes)
296
    setupDaemonFDs $ Just logfile
297
    _ <- forkProcess action
298
    exitImmediately ExitSuccess
299
  exitImmediately ExitSuccess
300

    
301
-- | Generic daemon startup.
302
genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
303
genericMain daemon options main = do
304
  let progname = daemonName daemon
305
  (opts, args) <- parseArgs progname options
306

    
307
  when (optShowHelp opts) $ do
308
    putStr $ usageHelp progname options
309
    exitWith ExitSuccess
310
  when (optShowVer opts) $ do
311
    printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
312
           progname Version.version
313
           compilerName (Data.Version.showVersion compilerVersion)
314
           os arch :: IO ()
315
    exitWith ExitSuccess
316

    
317
  exitUnless (null args) "This program doesn't take any arguments"
318

    
319
  unless (optNoUserChecks opts) $ do
320
    runtimeEnts <- getEnts
321
    ents <- exitIfBad "Can't find required user/groups" runtimeEnts
322
    verifyDaemonUser daemon ents
323

    
324
  syslog <- case optSyslogUsage opts of
325
              Nothing -> exitIfBad "Invalid cluster syslog setting" $
326
                         syslogUsageFromRaw C.syslogUsage
327
              Just v -> return v
328
  let processFn = if optDaemonize opts
329
                    then daemonize (daemonLogFile daemon)
330
                    else id
331
  processFn $ innerMain daemon opts syslog (main opts)
332

    
333
-- | Inner daemon function.
334
--
335
-- This is executed after daemonization.
336
innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
337
innerMain daemon opts syslog main = do
338
  let logfile = if optDaemonize opts
339
                  then Nothing
340
                  else Just $ daemonLogFile daemon
341
  setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog
342
  pid_fd <- writePidFile (daemonPidFile daemon)
343
  _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
344
  logNotice "starting"
345
  main