Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Daemon.hs @ 152e05e1

History | View | Annotate | Download (10.5 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
  , parseArgs
38
  , parseAddress
39
  , writePidFile
40
  , genericMain
41
  ) where
42

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

    
59
import Ganeti.Logging
60
import Ganeti.Runtime
61
import Ganeti.BasicTypes
62
import Ganeti.HTools.Utils
63
import qualified Ganeti.HTools.Version as Version(version)
64
import qualified Ganeti.Constants as C
65
import qualified Ganeti.Ssconf as Ssconf
66

    
67
-- * Data types
68

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

    
80
-- | Default values for the command line options.
81
defaultOptions :: DaemonOptions
82
defaultOptions  = DaemonOptions
83
  { optShowHelp     = False
84
  , optShowVer      = False
85
  , optDaemonize    = True
86
  , optPort         = Nothing
87
  , optDebug        = False
88
  , optNoUserChecks = False
89
  , optBindAddress  = Nothing
90
  }
91

    
92
-- | Abrreviation for the option type.
93
type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
94

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

    
106
-- * Command line options
107

    
108
oShowHelp :: OptType
109
oShowHelp = Option "h" ["help"]
110
            (NoArg (\ opts -> Ok opts { optShowHelp = True}))
111
            "Show the help message and exit"
112

    
113
oShowVer :: OptType
114
oShowVer = Option "V" ["version"]
115
           (NoArg (\ opts -> Ok opts { optShowVer = True}))
116
           "Show the version of the program and exit"
117

    
118
oNoDaemonize :: OptType
119
oNoDaemonize = Option "f" ["foreground"]
120
               (NoArg (\ opts -> Ok opts { optDaemonize = False}))
121
               "Don't detach from the current terminal"
122

    
123
oDebug :: OptType
124
oDebug = Option "d" ["debug"]
125
         (NoArg (\ opts -> Ok opts { optDebug = True }))
126
         "Enable debug messages"
127

    
128
oNoUserChecks :: OptType
129
oNoUserChecks = Option "" ["no-user-checks"]
130
         (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
131
         "Ignore user checks"
132

    
133
oPort :: Int -> OptType
134
oPort def = Option "p" ["port"]
135
            (reqWithConversion (tryRead "reading port")
136
             (\port opts -> Ok opts { optPort = Just port }) "PORT")
137
            ("Network port (default: " ++ show def ++ ")")
138

    
139
oBindAddress :: OptType
140
oBindAddress = Option "b" ["bind"]
141
               (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
142
                "ADDR")
143
               "Bind address (default depends on cluster configuration)"
144

    
145
-- | Usage info.
146
usageHelp :: String -> [OptType] -> String
147
usageHelp progname =
148
  usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
149
             progname Version.version progname)
150

    
151
-- | Command line parser, using the 'Options' structure.
152
parseOpts :: [String]               -- ^ The command line arguments
153
          -> String                 -- ^ The program name
154
          -> [OptType]              -- ^ The supported command line options
155
          -> IO (DaemonOptions, [String]) -- ^ The resulting options
156
                                          -- and leftover arguments
157
parseOpts argv progname options =
158
  case getOpt Permute options argv of
159
    (opt_list, args, []) ->
160
      do
161
        parsed_opts <-
162
          case foldM (flip id) defaultOptions opt_list of
163
            Bad msg -> do
164
              hPutStrLn stderr "Error while parsing command\
165
                               \line arguments:"
166
              hPutStrLn stderr msg
167
              exitWith $ ExitFailure 1
168
            Ok val -> return val
169
        return (parsed_opts, args)
170
    (_, _, errs) -> do
171
      hPutStrLn stderr $ "Command line error: "  ++ concat errs
172
      hPutStrLn stderr $ usageHelp progname options
173
      exitWith $ ExitFailure 2
174

    
175
-- | Small wrapper over getArgs and 'parseOpts'.
176
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
177
parseArgs cmd options = do
178
  cmd_args <- getArgs
179
  parseOpts cmd_args cmd options
180

    
181
-- * Daemon-related functions
182
-- | PID file mode.
183
pidFileMode :: FileMode
184
pidFileMode = unionFileModes ownerReadMode ownerWriteMode
185

    
186
-- | Writes a PID file and locks it.
187
_writePidFile :: FilePath -> IO Fd
188
_writePidFile path = do
189
  fd <- createFile path pidFileMode
190
  setLock fd (WriteLock, AbsoluteSeek, 0, 0)
191
  my_pid <- getProcessID
192
  _ <- fdWrite fd (show my_pid ++ "\n")
193
  return fd
194

    
195
-- | Wrapper over '_writePidFile' that transforms IO exceptions into a
196
-- 'Bad' value.
197
writePidFile :: FilePath -> IO (Result Fd)
198
writePidFile path = do
199
  catch (fmap Ok $ _writePidFile path) (return . Bad . show)
200

    
201
-- | Sets up a daemon's environment.
202
setupDaemonEnv :: FilePath -> FileMode -> IO ()
203
setupDaemonEnv cwd umask = do
204
  changeWorkingDirectory cwd
205
  _ <- setFileCreationMask umask
206
  _ <- createSession
207
  return ()
208

    
209
-- | Computes the default bind address for a given family.
210
defaultBindAddr :: Int                  -- ^ The port we want
211
                -> Socket.Family        -- ^ The cluster IP family
212
                -> Result (Socket.Family, Socket.SockAddr)
213
defaultBindAddr port Socket.AF_INET =
214
  Ok $ (Socket.AF_INET,
215
        Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
216
defaultBindAddr port Socket.AF_INET6 =
217
  Ok $ (Socket.AF_INET6,
218
        Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
219
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
220

    
221
-- | Default hints for the resolver
222
resolveAddrHints :: Maybe Socket.AddrInfo
223
resolveAddrHints =
224
  Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
225
                                                 Socket.AI_NUMERICSERV] }
226

    
227
-- | Resolves a numeric address.
228
resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
229
resolveAddr port str = do
230
  resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
231
  return $ case resolved of
232
             [] -> Bad "Invalid results from lookup?"
233
             best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best)
234

    
235
-- | Based on the options, compute the socket address to use for the
236
-- daemon.
237
parseAddress :: DaemonOptions      -- ^ Command line options
238
             -> Int                -- ^ Default port for this daemon
239
             -> IO (Result (Socket.Family, Socket.SockAddr))
240
parseAddress opts defport = do
241
  let port = maybe defport fromIntegral $ optPort opts
242
  def_family <- Ssconf.getPrimaryIPFamily Nothing
243
  ainfo <- case optBindAddress opts of
244
             Nothing -> return (def_family >>= defaultBindAddr port)
245
             Just saddr -> catch (resolveAddr port saddr)
246
                           (annotateIOError $ "Invalid address " ++ saddr)
247
  return ainfo
248

    
249
-- | Run an I/O action as a daemon.
250
--
251
-- WARNING: this only works in single-threaded mode (either using the
252
-- single-threaded runtime, or using the multi-threaded one but with
253
-- only one OS thread, i.e. -N1).
254
--
255
-- FIXME: this doesn't support error reporting and the prepfn
256
-- functionality.
257
daemonize :: IO () -> IO ()
258
daemonize action = do
259
  -- first fork
260
  _ <- forkProcess $ do
261
    -- in the child
262
    setupDaemonEnv "/" (unionFileModes groupModes otherModes)
263
    _ <- forkProcess action
264
    exitImmediately ExitSuccess
265
  exitImmediately ExitSuccess
266

    
267
-- | Generic daemon startup.
268
genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
269
genericMain daemon options main = do
270
  let progname = daemonName daemon
271
  (opts, args) <- parseArgs progname options
272

    
273
  when (optShowHelp opts) $ do
274
    putStr $ usageHelp progname options
275
    exitWith ExitSuccess
276
  when (optShowVer opts) $ do
277
    printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
278
           progname Version.version
279
           compilerName (Data.Version.showVersion compilerVersion)
280
           os arch :: IO ()
281
    exitWith ExitSuccess
282
  unless (null args) $ do
283
         hPutStrLn stderr "This program doesn't take any arguments"
284
         exitWith $ ExitFailure C.exitFailure
285

    
286
  unless (optNoUserChecks opts) $ do
287
    runtimeEnts <- getEnts
288
    case runtimeEnts of
289
      Bad msg -> do
290
        hPutStrLn stderr $ "Can't find required user/groups: " ++ msg
291
        exitWith $ ExitFailure C.exitFailure
292
      Ok ents -> verifyDaemonUser daemon ents
293

    
294
  let processFn = if optDaemonize opts then daemonize else id
295
  processFn $ innerMain daemon opts (main opts)
296

    
297
-- | Inner daemon function.
298
--
299
-- This is executed after daemonization.
300
innerMain :: GanetiDaemon -> DaemonOptions -> IO () -> IO ()
301
innerMain daemon opts main = do
302
  setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
303
                 (not (optDaemonize opts)) False
304
  pid_fd <- writePidFile (daemonPidFile daemon)
305
  case pid_fd of
306
    Bad msg -> do
307
         hPutStrLn stderr $ "Cannot write PID file; already locked? Error: " ++
308
                   msg
309
         exitWith $ ExitFailure 1
310
    _ -> return ()
311
  logNotice "starting"
312
  main