Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Daemon.hs @ 79ac58fa

History | View | Annotate | Download (11 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 qualified Data.Version
47
import Data.Word
48
import qualified Network.Socket as Socket
49
import Prelude hiding (catch)
50
import System.Console.GetOpt
51
import System.Exit
52
import System.Environment
53
import System.Info
54
import System.IO
55
import System.Posix.Directory
56
import System.Posix.Files
57
import System.Posix.IO
58
import System.Posix.Process
59
import System.Posix.Types
60
import Text.Printf
61

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

    
70
-- * Data types
71

    
72
-- | Command line options structure.
73
data DaemonOptions = DaemonOptions
74
  { optShowHelp     :: Bool           -- ^ Just show the help
75
  , optShowVer      :: Bool           -- ^ Just show the program version
76
  , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
77
  , optPort         :: Maybe Word16   -- ^ Override for the network port
78
  , optDebug        :: Bool           -- ^ Enable debug messages
79
  , optNoUserChecks :: Bool           -- ^ Ignore user checks
80
  , optBindAddress  :: Maybe String   -- ^ Override for the bind address
81
  , optSyslogUsage  :: Maybe SyslogUsage -- ^ Override for Syslog usage
82
  }
83

    
84
-- | Default values for the command line options.
85
defaultOptions :: DaemonOptions
86
defaultOptions  = DaemonOptions
87
  { optShowHelp     = False
88
  , optShowVer      = False
89
  , optDaemonize    = True
90
  , optPort         = Nothing
91
  , optDebug        = False
92
  , optNoUserChecks = False
93
  , optBindAddress  = Nothing
94
  , optSyslogUsage  = Nothing
95
  }
96

    
97
-- | Abrreviation for the option type.
98
type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
99

    
100
-- | Helper function for required arguments which need to be converted
101
-- as opposed to stored just as string.
102
reqWithConversion :: (String -> Result a)
103
                  -> (a -> DaemonOptions -> Result DaemonOptions)
104
                  -> String
105
                  -> ArgDescr (DaemonOptions -> Result DaemonOptions)
106
reqWithConversion conversion_fn updater_fn metavar =
107
  ReqArg (\string_opt opts -> do
108
            parsed_value <- conversion_fn string_opt
109
            updater_fn parsed_value opts) metavar
110

    
111
-- * Command line options
112

    
113
oShowHelp :: OptType
114
oShowHelp = Option "h" ["help"]
115
            (NoArg (\ opts -> Ok opts { optShowHelp = True}))
116
            "Show the help message and exit"
117

    
118
oShowVer :: OptType
119
oShowVer = Option "V" ["version"]
120
           (NoArg (\ opts -> Ok opts { optShowVer = True}))
121
           "Show the version of the program and exit"
122

    
123
oNoDaemonize :: OptType
124
oNoDaemonize = Option "f" ["foreground"]
125
               (NoArg (\ opts -> Ok opts { optDaemonize = False}))
126
               "Don't detach from the current terminal"
127

    
128
oDebug :: OptType
129
oDebug = Option "d" ["debug"]
130
         (NoArg (\ opts -> Ok opts { optDebug = True }))
131
         "Enable debug messages"
132

    
133
oNoUserChecks :: OptType
134
oNoUserChecks = Option "" ["no-user-checks"]
135
         (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
136
         "Ignore user checks"
137

    
138
oPort :: Int -> OptType
139
oPort def = Option "p" ["port"]
140
            (reqWithConversion (tryRead "reading port")
141
             (\port opts -> Ok opts { optPort = Just port }) "PORT")
142
            ("Network port (default: " ++ show def ++ ")")
143

    
144
oBindAddress :: OptType
145
oBindAddress = Option "b" ["bind"]
146
               (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
147
                "ADDR")
148
               "Bind address (default depends on cluster configuration)"
149

    
150
oSyslogUsage :: OptType
151
oSyslogUsage = Option "" ["syslog"]
152
               (reqWithConversion syslogUsageFromRaw
153
                (\su opts -> Ok opts { optSyslogUsage = Just su })
154
                "SYSLOG")
155
               ("Enable logging to syslog (except debug \
156
                \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
157
                "]")
158

    
159
-- | Usage info.
160
usageHelp :: String -> [OptType] -> String
161
usageHelp progname =
162
  usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
163
             progname Version.version progname)
164

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

    
184
-- | Small wrapper over getArgs and 'parseOpts'.
185
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
186
parseArgs cmd options = do
187
  cmd_args <- getArgs
188
  parseOpts cmd_args cmd options
189

    
190
-- * Daemon-related functions
191
-- | PID file mode.
192
pidFileMode :: FileMode
193
pidFileMode = unionFileModes ownerReadMode ownerWriteMode
194

    
195
-- | Writes a PID file and locks it.
196
_writePidFile :: FilePath -> IO Fd
197
_writePidFile path = do
198
  fd <- createFile path pidFileMode
199
  setLock fd (WriteLock, AbsoluteSeek, 0, 0)
200
  my_pid <- getProcessID
201
  _ <- fdWrite fd (show my_pid ++ "\n")
202
  return fd
203

    
204
-- | Helper to format an IOError.
205
formatIOError :: String -> IOError -> String
206
formatIOError msg err = msg ++ ": " ++  show err
207

    
208
-- | Wrapper over '_writePidFile' that transforms IO exceptions into a
209
-- 'Bad' value.
210
writePidFile :: FilePath -> IO (Result Fd)
211
writePidFile path = do
212
  catch (fmap Ok $ _writePidFile path)
213
    (return . Bad . formatIOError "Failure during writing of the pid file")
214

    
215
-- | Sets up a daemon's environment.
216
setupDaemonEnv :: FilePath -> FileMode -> IO ()
217
setupDaemonEnv cwd umask = do
218
  changeWorkingDirectory cwd
219
  _ <- setFileCreationMask umask
220
  _ <- createSession
221
  return ()
222

    
223
-- | Computes the default bind address for a given family.
224
defaultBindAddr :: Int                  -- ^ The port we want
225
                -> Socket.Family        -- ^ The cluster IP family
226
                -> Result (Socket.Family, Socket.SockAddr)
227
defaultBindAddr port Socket.AF_INET =
228
  Ok $ (Socket.AF_INET,
229
        Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
230
defaultBindAddr port Socket.AF_INET6 =
231
  Ok $ (Socket.AF_INET6,
232
        Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
233
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
234

    
235
-- | Default hints for the resolver
236
resolveAddrHints :: Maybe Socket.AddrInfo
237
resolveAddrHints =
238
  Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
239
                                                 Socket.AI_NUMERICSERV] }
240

    
241
-- | Resolves a numeric address.
242
resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
243
resolveAddr port str = do
244
  resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
245
  return $ case resolved of
246
             [] -> Bad "Invalid results from lookup?"
247
             best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best)
248

    
249
-- | Based on the options, compute the socket address to use for the
250
-- daemon.
251
parseAddress :: DaemonOptions      -- ^ Command line options
252
             -> Int                -- ^ Default port for this daemon
253
             -> IO (Result (Socket.Family, Socket.SockAddr))
254
parseAddress opts defport = do
255
  let port = maybe defport fromIntegral $ optPort opts
256
  def_family <- Ssconf.getPrimaryIPFamily Nothing
257
  ainfo <- case optBindAddress opts of
258
             Nothing -> return (def_family >>= defaultBindAddr port)
259
             Just saddr -> catch (resolveAddr port saddr)
260
                           (annotateIOError $ "Invalid address " ++ saddr)
261
  return ainfo
262

    
263
-- | Run an I/O action as a daemon.
264
--
265
-- WARNING: this only works in single-threaded mode (either using the
266
-- single-threaded runtime, or using the multi-threaded one but with
267
-- only one OS thread, i.e. -N1).
268
--
269
-- FIXME: this doesn't support error reporting and the prepfn
270
-- functionality.
271
daemonize :: IO () -> IO ()
272
daemonize action = do
273
  -- first fork
274
  _ <- forkProcess $ do
275
    -- in the child
276
    setupDaemonEnv "/" (unionFileModes groupModes otherModes)
277
    _ <- forkProcess action
278
    exitImmediately ExitSuccess
279
  exitImmediately ExitSuccess
280

    
281
-- | Generic daemon startup.
282
genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
283
genericMain daemon options main = do
284
  let progname = daemonName daemon
285
  (opts, args) <- parseArgs progname options
286

    
287
  when (optShowHelp opts) $ do
288
    putStr $ usageHelp progname options
289
    exitWith ExitSuccess
290
  when (optShowVer opts) $ do
291
    printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
292
           progname Version.version
293
           compilerName (Data.Version.showVersion compilerVersion)
294
           os arch :: IO ()
295
    exitWith ExitSuccess
296

    
297
  exitUnless (null args) "This program doesn't take any arguments"
298

    
299
  unless (optNoUserChecks opts) $ do
300
    runtimeEnts <- getEnts
301
    ents <- exitIfBad "Can't find required user/groups" runtimeEnts
302
    verifyDaemonUser daemon ents
303

    
304
  syslog <- case optSyslogUsage opts of
305
              Nothing -> exitIfBad "Invalid cluster syslog setting" $
306
                         syslogUsageFromRaw C.syslogUsage
307
              Just v -> return v
308
  let processFn = if optDaemonize opts then daemonize else id
309
  processFn $ innerMain daemon opts syslog (main opts)
310

    
311
-- | Inner daemon function.
312
--
313
-- This is executed after daemonization.
314
innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
315
innerMain daemon opts syslog main = do
316
  setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
317
                 (not (optDaemonize opts)) False syslog
318
  pid_fd <- writePidFile (daemonPidFile daemon)
319
  _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
320
  logNotice "starting"
321
  main