Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Daemon.hs @ e817723c

History | View | Annotate | Download (15.6 kB)

1 6ec7a50e Iustin Pop
{-| Implementation of the generic daemon functionality.
2 6ec7a50e Iustin Pop
3 6ec7a50e Iustin Pop
-}
4 6ec7a50e Iustin Pop
5 6ec7a50e Iustin Pop
{-
6 6ec7a50e Iustin Pop
7 6ec7a50e Iustin Pop
Copyright (C) 2011, 2012 Google Inc.
8 6ec7a50e Iustin Pop
9 6ec7a50e Iustin Pop
This program is free software; you can redistribute it and/or modify
10 6ec7a50e Iustin Pop
it under the terms of the GNU General Public License as published by
11 6ec7a50e Iustin Pop
the Free Software Foundation; either version 2 of the License, or
12 6ec7a50e Iustin Pop
(at your option) any later version.
13 6ec7a50e Iustin Pop
14 6ec7a50e Iustin Pop
This program is distributed in the hope that it will be useful, but
15 6ec7a50e Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
16 6ec7a50e Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 6ec7a50e Iustin Pop
General Public License for more details.
18 6ec7a50e Iustin Pop
19 6ec7a50e Iustin Pop
You should have received a copy of the GNU General Public License
20 6ec7a50e Iustin Pop
along with this program; if not, write to the Free Software
21 6ec7a50e Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 6ec7a50e Iustin Pop
02110-1301, USA.
23 6ec7a50e Iustin Pop
24 6ec7a50e Iustin Pop
-}
25 6ec7a50e Iustin Pop
26 6ec7a50e Iustin Pop
module Ganeti.Daemon
27 6ec7a50e Iustin Pop
  ( DaemonOptions(..)
28 6ec7a50e Iustin Pop
  , OptType
29 2ac2e420 Iustin Pop
  , CheckFn
30 2ac2e420 Iustin Pop
  , PrepFn
31 2ac2e420 Iustin Pop
  , MainFn
32 6ec7a50e Iustin Pop
  , defaultOptions
33 6ec7a50e Iustin Pop
  , oShowHelp
34 6ec7a50e Iustin Pop
  , oShowVer
35 6ec7a50e Iustin Pop
  , oNoDaemonize
36 6ec7a50e Iustin Pop
  , oNoUserChecks
37 6ec7a50e Iustin Pop
  , oDebug
38 6ec7a50e Iustin Pop
  , oPort
39 152e05e1 Iustin Pop
  , oBindAddress
40 b714ff89 Iustin Pop
  , oSyslogUsage
41 6ec7a50e Iustin Pop
  , parseArgs
42 152e05e1 Iustin Pop
  , parseAddress
43 0d0ac025 Iustin Pop
  , cleanupSocket
44 e14b84e9 Iustin Pop
  , describeError
45 6ec7a50e Iustin Pop
  , genericMain
46 6ec7a50e Iustin Pop
  ) where
47 6ec7a50e Iustin Pop
48 80adbbe1 Michele Tartara
import Control.Concurrent
49 79ac58fa Iustin Pop
import Control.Exception
50 6ec7a50e Iustin Pop
import Control.Monad
51 ecff332f Thomas Thrainer
import Data.Maybe (fromMaybe, listToMaybe)
52 6ec7a50e Iustin Pop
import Data.Word
53 0c28bee1 Iustin Pop
import GHC.IO.Handle (hDuplicateTo)
54 670e954a Thomas Thrainer
import Network.BSD (getHostName)
55 152e05e1 Iustin Pop
import qualified Network.Socket as Socket
56 6ec7a50e Iustin Pop
import System.Console.GetOpt
57 80adbbe1 Michele Tartara
import System.Directory
58 6ec7a50e Iustin Pop
import System.Exit
59 6ec7a50e Iustin Pop
import System.Environment
60 6ec7a50e Iustin Pop
import System.IO
61 e14b84e9 Iustin Pop
import System.IO.Error (isDoesNotExistError, modifyIOError, annotateIOError)
62 6ec7a50e Iustin Pop
import System.Posix.Directory
63 6ec7a50e Iustin Pop
import System.Posix.Files
64 6ec7a50e Iustin Pop
import System.Posix.IO
65 6ec7a50e Iustin Pop
import System.Posix.Process
66 6ec7a50e Iustin Pop
import System.Posix.Types
67 36691f08 Iustin Pop
import System.Posix.Signals
68 6ec7a50e Iustin Pop
69 51000365 Iustin Pop
import Ganeti.Common as Common
70 6ec7a50e Iustin Pop
import Ganeti.Logging
71 6ec7a50e Iustin Pop
import Ganeti.Runtime
72 6ec7a50e Iustin Pop
import Ganeti.BasicTypes
73 26d62e4c Iustin Pop
import Ganeti.Utils
74 6ec7a50e Iustin Pop
import qualified Ganeti.Constants as C
75 152e05e1 Iustin Pop
import qualified Ganeti.Ssconf as Ssconf
76 6ec7a50e Iustin Pop
77 0c28bee1 Iustin Pop
-- * Constants
78 0c28bee1 Iustin Pop
79 0c28bee1 Iustin Pop
-- | \/dev\/null path.
80 0c28bee1 Iustin Pop
devNull :: FilePath
81 0c28bee1 Iustin Pop
devNull = "/dev/null"
82 0c28bee1 Iustin Pop
83 b9097468 Iustin Pop
-- | Error message prefix, used in two separate paths (when forking
84 b9097468 Iustin Pop
-- and when not).
85 b9097468 Iustin Pop
daemonStartupErr :: String -> String
86 b9097468 Iustin Pop
daemonStartupErr = ("Error when starting the daemon process: " ++)
87 b9097468 Iustin Pop
88 6ec7a50e Iustin Pop
-- * Data types
89 6ec7a50e Iustin Pop
90 6ec7a50e Iustin Pop
-- | Command line options structure.
91 6ec7a50e Iustin Pop
data DaemonOptions = DaemonOptions
92 6ec7a50e Iustin Pop
  { optShowHelp     :: Bool           -- ^ Just show the help
93 6ec7a50e Iustin Pop
  , optShowVer      :: Bool           -- ^ Just show the program version
94 097ad7ee Iustin Pop
  , optShowComp     :: Bool           -- ^ Just show the completion info
95 6ec7a50e Iustin Pop
  , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
96 6ec7a50e Iustin Pop
  , optPort         :: Maybe Word16   -- ^ Override for the network port
97 6ec7a50e Iustin Pop
  , optDebug        :: Bool           -- ^ Enable debug messages
98 6ec7a50e Iustin Pop
  , optNoUserChecks :: Bool           -- ^ Ignore user checks
99 152e05e1 Iustin Pop
  , optBindAddress  :: Maybe String   -- ^ Override for the bind address
100 b714ff89 Iustin Pop
  , optSyslogUsage  :: Maybe SyslogUsage -- ^ Override for Syslog usage
101 6ec7a50e Iustin Pop
  }
102 6ec7a50e Iustin Pop
103 6ec7a50e Iustin Pop
-- | Default values for the command line options.
104 6ec7a50e Iustin Pop
defaultOptions :: DaemonOptions
105 6ec7a50e Iustin Pop
defaultOptions  = DaemonOptions
106 6ec7a50e Iustin Pop
  { optShowHelp     = False
107 6ec7a50e Iustin Pop
  , optShowVer      = False
108 097ad7ee Iustin Pop
  , optShowComp     = False
109 6ec7a50e Iustin Pop
  , optDaemonize    = True
110 6ec7a50e Iustin Pop
  , optPort         = Nothing
111 6ec7a50e Iustin Pop
  , optDebug        = False
112 6ec7a50e Iustin Pop
  , optNoUserChecks = False
113 152e05e1 Iustin Pop
  , optBindAddress  = Nothing
114 b714ff89 Iustin Pop
  , optSyslogUsage  = Nothing
115 6ec7a50e Iustin Pop
  }
116 6ec7a50e Iustin Pop
117 51000365 Iustin Pop
instance StandardOptions DaemonOptions where
118 51000365 Iustin Pop
  helpRequested = optShowHelp
119 51000365 Iustin Pop
  verRequested  = optShowVer
120 097ad7ee Iustin Pop
  compRequested = optShowComp
121 5b11f8db Iustin Pop
  requestHelp o = o { optShowHelp = True }
122 5b11f8db Iustin Pop
  requestVer  o = o { optShowVer  = True }
123 097ad7ee Iustin Pop
  requestComp o = o { optShowComp = True }
124 51000365 Iustin Pop
125 6ec7a50e Iustin Pop
-- | Abrreviation for the option type.
126 51000365 Iustin Pop
type OptType = GenericOptType DaemonOptions
127 6ec7a50e Iustin Pop
128 2ac2e420 Iustin Pop
-- | Check function type.
129 2ac2e420 Iustin Pop
type CheckFn a = DaemonOptions -> IO (Either ExitCode a)
130 2ac2e420 Iustin Pop
131 2ac2e420 Iustin Pop
-- | Prepare function type.
132 2ac2e420 Iustin Pop
type PrepFn a b = DaemonOptions -> a -> IO b
133 2ac2e420 Iustin Pop
134 2ac2e420 Iustin Pop
-- | Main execution function type.
135 2ac2e420 Iustin Pop
type MainFn a b = DaemonOptions -> a -> b -> IO ()
136 2ac2e420 Iustin Pop
137 6ec7a50e Iustin Pop
-- * Command line options
138 6ec7a50e Iustin Pop
139 6ec7a50e Iustin Pop
oNoDaemonize :: OptType
140 ce207617 Iustin Pop
oNoDaemonize =
141 ce207617 Iustin Pop
  (Option "f" ["foreground"]
142 ce207617 Iustin Pop
   (NoArg (\ opts -> Ok opts { optDaemonize = False}))
143 ce207617 Iustin Pop
   "Don't detach from the current terminal",
144 ce207617 Iustin Pop
   OptComplNone)
145 6ec7a50e Iustin Pop
146 6ec7a50e Iustin Pop
oDebug :: OptType
147 ce207617 Iustin Pop
oDebug =
148 ce207617 Iustin Pop
  (Option "d" ["debug"]
149 ce207617 Iustin Pop
   (NoArg (\ opts -> Ok opts { optDebug = True }))
150 ce207617 Iustin Pop
   "Enable debug messages",
151 ce207617 Iustin Pop
   OptComplNone)
152 6ec7a50e Iustin Pop
153 6ec7a50e Iustin Pop
oNoUserChecks :: OptType
154 ce207617 Iustin Pop
oNoUserChecks =
155 ce207617 Iustin Pop
  (Option "" ["no-user-checks"]
156 ce207617 Iustin Pop
   (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
157 ce207617 Iustin Pop
   "Ignore user checks",
158 ce207617 Iustin Pop
   OptComplNone)
159 6ec7a50e Iustin Pop
160 6ec7a50e Iustin Pop
oPort :: Int -> OptType
161 ce207617 Iustin Pop
oPort def =
162 ce207617 Iustin Pop
  (Option "p" ["port"]
163 ce207617 Iustin Pop
   (reqWithConversion (tryRead "reading port")
164 ce207617 Iustin Pop
    (\port opts -> Ok opts { optPort = Just port }) "PORT")
165 ce207617 Iustin Pop
   ("Network port (default: " ++ show def ++ ")"),
166 ecebe9f6 Iustin Pop
   OptComplInteger)
167 6ec7a50e Iustin Pop
168 152e05e1 Iustin Pop
oBindAddress :: OptType
169 ce207617 Iustin Pop
oBindAddress =
170 ce207617 Iustin Pop
  (Option "b" ["bind"]
171 ce207617 Iustin Pop
   (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
172 ce207617 Iustin Pop
    "ADDR")
173 ce207617 Iustin Pop
   "Bind address (default depends on cluster configuration)",
174 ce207617 Iustin Pop
   OptComplInetAddr)
175 152e05e1 Iustin Pop
176 b714ff89 Iustin Pop
oSyslogUsage :: OptType
177 ce207617 Iustin Pop
oSyslogUsage =
178 ce207617 Iustin Pop
  (Option "" ["syslog"]
179 ce207617 Iustin Pop
   (reqWithConversion syslogUsageFromRaw
180 ce207617 Iustin Pop
    (\su opts -> Ok opts { optSyslogUsage = Just su })
181 ce207617 Iustin Pop
    "SYSLOG")
182 ce207617 Iustin Pop
   ("Enable logging to syslog (except debug \
183 ce207617 Iustin Pop
    \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
184 ce207617 Iustin Pop
    "]"),
185 ce207617 Iustin Pop
   OptComplChoices ["yes", "no", "only"])
186 b714ff89 Iustin Pop
187 42834645 Iustin Pop
-- | Generic options.
188 42834645 Iustin Pop
genericOpts :: [OptType]
189 42834645 Iustin Pop
genericOpts = [ oShowHelp
190 42834645 Iustin Pop
              , oShowVer
191 097ad7ee Iustin Pop
              , oShowComp
192 42834645 Iustin Pop
              ]
193 42834645 Iustin Pop
194 7413b229 Iustin Pop
-- | Annotates and transforms IOErrors into a Result type. This can be
195 7413b229 Iustin Pop
-- used in the error handler argument to 'catch', for example.
196 7413b229 Iustin Pop
ioErrorToResult :: String -> IOError -> IO (Result a)
197 7413b229 Iustin Pop
ioErrorToResult description exc =
198 7413b229 Iustin Pop
  return . Bad $ description ++ ": " ++ show exc
199 7413b229 Iustin Pop
200 6ec7a50e Iustin Pop
-- | Small wrapper over getArgs and 'parseOpts'.
201 6ec7a50e Iustin Pop
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
202 6ec7a50e Iustin Pop
parseArgs cmd options = do
203 6ec7a50e Iustin Pop
  cmd_args <- getArgs
204 22278fa7 Iustin Pop
  parseOpts defaultOptions cmd_args cmd (options ++ genericOpts) []
205 6ec7a50e Iustin Pop
206 6ec7a50e Iustin Pop
-- * Daemon-related functions
207 a4c0fe1e Iustin Pop
208 6ec7a50e Iustin Pop
-- | PID file mode.
209 6ec7a50e Iustin Pop
pidFileMode :: FileMode
210 6ec7a50e Iustin Pop
pidFileMode = unionFileModes ownerReadMode ownerWriteMode
211 6ec7a50e Iustin Pop
212 a4c0fe1e Iustin Pop
-- | PID file open flags.
213 a4c0fe1e Iustin Pop
pidFileFlags :: OpenFileFlags
214 a4c0fe1e Iustin Pop
pidFileFlags = defaultFileFlags { noctty = True, trunc = False }
215 a4c0fe1e Iustin Pop
216 6ec7a50e Iustin Pop
-- | Writes a PID file and locks it.
217 e14b84e9 Iustin Pop
writePidFile :: FilePath -> IO Fd
218 e14b84e9 Iustin Pop
writePidFile path = do
219 a4c0fe1e Iustin Pop
  fd <- openFd path ReadWrite (Just pidFileMode) pidFileFlags
220 6ec7a50e Iustin Pop
  setLock fd (WriteLock, AbsoluteSeek, 0, 0)
221 6ec7a50e Iustin Pop
  my_pid <- getProcessID
222 6ec7a50e Iustin Pop
  _ <- fdWrite fd (show my_pid ++ "\n")
223 6ec7a50e Iustin Pop
  return fd
224 6ec7a50e Iustin Pop
225 0d0ac025 Iustin Pop
-- | Helper function to ensure a socket doesn't exist. Should only be
226 0d0ac025 Iustin Pop
-- called once we have locked the pid file successfully.
227 0d0ac025 Iustin Pop
cleanupSocket :: FilePath -> IO ()
228 5b11f8db Iustin Pop
cleanupSocket socketPath =
229 0d0ac025 Iustin Pop
  catchJust (guard . isDoesNotExistError) (removeLink socketPath)
230 0d0ac025 Iustin Pop
            (const $ return ())
231 0d0ac025 Iustin Pop
232 6ec7a50e Iustin Pop
-- | Sets up a daemon's environment.
233 6ec7a50e Iustin Pop
setupDaemonEnv :: FilePath -> FileMode -> IO ()
234 6ec7a50e Iustin Pop
setupDaemonEnv cwd umask = do
235 6ec7a50e Iustin Pop
  changeWorkingDirectory cwd
236 6ec7a50e Iustin Pop
  _ <- setFileCreationMask umask
237 6ec7a50e Iustin Pop
  _ <- createSession
238 6ec7a50e Iustin Pop
  return ()
239 6ec7a50e Iustin Pop
240 80adbbe1 Michele Tartara
-- | Cleanup function, performing all the operations that need to be done prior
241 80adbbe1 Michele Tartara
-- to shutting down a daemon.
242 80adbbe1 Michele Tartara
finalCleanup :: FilePath -> IO ()
243 80adbbe1 Michele Tartara
finalCleanup = removeFile
244 80adbbe1 Michele Tartara
245 80adbbe1 Michele Tartara
-- | Signal handler for the termination signal.
246 80adbbe1 Michele Tartara
handleSigTerm :: ThreadId -> IO ()
247 80adbbe1 Michele Tartara
handleSigTerm mainTID =
248 80adbbe1 Michele Tartara
  -- Throw termination exception to the main thread, so that the daemon is
249 80adbbe1 Michele Tartara
  -- actually stopped in the proper way, executing all the functions waiting on
250 80adbbe1 Michele Tartara
  -- "finally" statement.
251 80adbbe1 Michele Tartara
  Control.Exception.throwTo mainTID ExitSuccess
252 80adbbe1 Michele Tartara
253 36691f08 Iustin Pop
-- | Signal handler for reopening log files.
254 36691f08 Iustin Pop
handleSigHup :: FilePath -> IO ()
255 36691f08 Iustin Pop
handleSigHup path = do
256 36691f08 Iustin Pop
  setupDaemonFDs (Just path)
257 36691f08 Iustin Pop
  logInfo "Reopening log files after receiving SIGHUP"
258 36691f08 Iustin Pop
259 0c28bee1 Iustin Pop
-- | Sets up a daemon's standard file descriptors.
260 0c28bee1 Iustin Pop
setupDaemonFDs :: Maybe FilePath -> IO ()
261 0c28bee1 Iustin Pop
setupDaemonFDs logfile = do
262 0c28bee1 Iustin Pop
  null_in_handle <- openFile devNull ReadMode
263 0c28bee1 Iustin Pop
  null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
264 0c28bee1 Iustin Pop
  hDuplicateTo null_in_handle stdin
265 0c28bee1 Iustin Pop
  hDuplicateTo null_out_handle stdout
266 0c28bee1 Iustin Pop
  hDuplicateTo null_out_handle stderr
267 0c28bee1 Iustin Pop
  hClose null_in_handle
268 0c28bee1 Iustin Pop
  hClose null_out_handle
269 0c28bee1 Iustin Pop
270 152e05e1 Iustin Pop
-- | Computes the default bind address for a given family.
271 152e05e1 Iustin Pop
defaultBindAddr :: Int                  -- ^ The port we want
272 152e05e1 Iustin Pop
                -> Socket.Family        -- ^ The cluster IP family
273 152e05e1 Iustin Pop
                -> Result (Socket.Family, Socket.SockAddr)
274 152e05e1 Iustin Pop
defaultBindAddr port Socket.AF_INET =
275 5b11f8db Iustin Pop
  Ok (Socket.AF_INET,
276 5b11f8db Iustin Pop
      Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
277 152e05e1 Iustin Pop
defaultBindAddr port Socket.AF_INET6 =
278 5b11f8db Iustin Pop
  Ok (Socket.AF_INET6,
279 5b11f8db Iustin Pop
      Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
280 152e05e1 Iustin Pop
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
281 152e05e1 Iustin Pop
282 152e05e1 Iustin Pop
-- | Based on the options, compute the socket address to use for the
283 152e05e1 Iustin Pop
-- daemon.
284 152e05e1 Iustin Pop
parseAddress :: DaemonOptions      -- ^ Command line options
285 152e05e1 Iustin Pop
             -> Int                -- ^ Default port for this daemon
286 152e05e1 Iustin Pop
             -> IO (Result (Socket.Family, Socket.SockAddr))
287 152e05e1 Iustin Pop
parseAddress opts defport = do
288 152e05e1 Iustin Pop
  let port = maybe defport fromIntegral $ optPort opts
289 152e05e1 Iustin Pop
  def_family <- Ssconf.getPrimaryIPFamily Nothing
290 5b11f8db Iustin Pop
  case optBindAddress opts of
291 5b11f8db Iustin Pop
    Nothing -> return (def_family >>= defaultBindAddr port)
292 b9612abb Iustin Pop
    Just saddr -> Control.Exception.catch
293 b9612abb Iustin Pop
                    (resolveAddr port saddr)
294 7413b229 Iustin Pop
                    (ioErrorToResult $ "Invalid address " ++ saddr)
295 152e05e1 Iustin Pop
296 670e954a Thomas Thrainer
-- | Environment variable to override the assumed host name of the
297 670e954a Thomas Thrainer
-- current node.
298 670e954a Thomas Thrainer
vClusterHostNameEnvVar :: String
299 670e954a Thomas Thrainer
vClusterHostNameEnvVar = "GANETI_HOSTNAME"
300 670e954a Thomas Thrainer
301 ecff332f Thomas Thrainer
getFQDN :: IO String
302 ecff332f Thomas Thrainer
getFQDN = do
303 ecff332f Thomas Thrainer
  hostname <- getHostName
304 ecff332f Thomas Thrainer
  addrInfos <- Socket.getAddrInfo Nothing (Just hostname) Nothing
305 ecff332f Thomas Thrainer
  let address = listToMaybe addrInfos >>= (Just . Socket.addrAddress)
306 ecff332f Thomas Thrainer
  case address of
307 ecff332f Thomas Thrainer
    Just a -> do
308 ecff332f Thomas Thrainer
      fqdn <- liftM fst $ Socket.getNameInfo [] True False a
309 ecff332f Thomas Thrainer
      return (fromMaybe hostname fqdn)
310 ecff332f Thomas Thrainer
    Nothing -> return hostname
311 ecff332f Thomas Thrainer
312 670e954a Thomas Thrainer
-- | Returns if the current node is the master node.
313 670e954a Thomas Thrainer
isMaster :: IO Bool
314 670e954a Thomas Thrainer
isMaster = do
315 670e954a Thomas Thrainer
  let ioErrorToNothing :: IOError -> IO (Maybe String)
316 670e954a Thomas Thrainer
      ioErrorToNothing _ = return Nothing
317 670e954a Thomas Thrainer
  vcluster_node <- Control.Exception.catch
318 670e954a Thomas Thrainer
                     (liftM Just (getEnv vClusterHostNameEnvVar))
319 670e954a Thomas Thrainer
                     ioErrorToNothing
320 670e954a Thomas Thrainer
  curNode <- case vcluster_node of
321 670e954a Thomas Thrainer
    Just node_name -> return node_name
322 ecff332f Thomas Thrainer
    Nothing -> getFQDN
323 670e954a Thomas Thrainer
  masterNode <- Ssconf.getMasterNode Nothing
324 670e954a Thomas Thrainer
  case masterNode of
325 670e954a Thomas Thrainer
    Ok n -> return (curNode == n)
326 670e954a Thomas Thrainer
    Bad _ -> return False
327 670e954a Thomas Thrainer
328 670e954a Thomas Thrainer
-- | Ensures that the daemon runs on the right node (and exits
329 670e954a Thomas Thrainer
-- gracefully if it doesnt)
330 670e954a Thomas Thrainer
ensureNode :: GanetiDaemon -> IO ()
331 670e954a Thomas Thrainer
ensureNode daemon = do
332 670e954a Thomas Thrainer
  is_master <- isMaster
333 670e954a Thomas Thrainer
  when (daemonOnlyOnMaster daemon && not is_master) $ do
334 670e954a Thomas Thrainer
    putStrLn "Not master, exiting."
335 670e954a Thomas Thrainer
    exitWith (ExitFailure C.exitNotmaster)
336 670e954a Thomas Thrainer
337 e14b84e9 Iustin Pop
-- | Run an I\/O action that might throw an I\/O error, under a
338 e14b84e9 Iustin Pop
-- handler that will simply annotate and re-throw the exception.
339 e14b84e9 Iustin Pop
describeError :: String -> Maybe Handle -> Maybe FilePath -> IO a -> IO a
340 e14b84e9 Iustin Pop
describeError descr hndl fpath =
341 e14b84e9 Iustin Pop
  modifyIOError (\e -> annotateIOError e descr hndl fpath)
342 e14b84e9 Iustin Pop
343 e14b84e9 Iustin Pop
-- | Run an I\/O action as a daemon.
344 6ec7a50e Iustin Pop
--
345 6ec7a50e Iustin Pop
-- WARNING: this only works in single-threaded mode (either using the
346 6ec7a50e Iustin Pop
-- single-threaded runtime, or using the multi-threaded one but with
347 6ec7a50e Iustin Pop
-- only one OS thread, i.e. -N1).
348 b9097468 Iustin Pop
daemonize :: FilePath -> (Maybe Fd -> IO ()) -> IO ()
349 0c28bee1 Iustin Pop
daemonize logfile action = do
350 b9097468 Iustin Pop
  (rpipe, wpipe) <- createPipe
351 6ec7a50e Iustin Pop
  -- first fork
352 6ec7a50e Iustin Pop
  _ <- forkProcess $ do
353 6ec7a50e Iustin Pop
    -- in the child
354 b9097468 Iustin Pop
    closeFd rpipe
355 1a865afe Iustin Pop
    let wpipe' = Just wpipe
356 6ec7a50e Iustin Pop
    setupDaemonEnv "/" (unionFileModes groupModes otherModes)
357 1a865afe Iustin Pop
    setupDaemonFDs (Just logfile) `Control.Exception.catch`
358 1a865afe Iustin Pop
      handlePrepErr False wpipe'
359 36691f08 Iustin Pop
    _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
360 b9097468 Iustin Pop
    -- second fork, launches the actual child code; standard
361 b9097468 Iustin Pop
    -- double-fork technique
362 1a865afe Iustin Pop
    _ <- forkProcess (action wpipe')
363 6ec7a50e Iustin Pop
    exitImmediately ExitSuccess
364 b9097468 Iustin Pop
  closeFd wpipe
365 b9097468 Iustin Pop
  hndl <- fdToHandle rpipe
366 b9097468 Iustin Pop
  errors <- hGetContents hndl
367 b9097468 Iustin Pop
  ecode <- if null errors
368 b9097468 Iustin Pop
             then return ExitSuccess
369 b9097468 Iustin Pop
             else do
370 b9097468 Iustin Pop
               hPutStrLn stderr $ daemonStartupErr errors
371 b9097468 Iustin Pop
               return $ ExitFailure C.exitFailure
372 b9097468 Iustin Pop
  exitImmediately ecode
373 6ec7a50e Iustin Pop
374 6ec7a50e Iustin Pop
-- | Generic daemon startup.
375 2ac2e420 Iustin Pop
genericMain :: GanetiDaemon -- ^ The daemon we're running
376 2ac2e420 Iustin Pop
            -> [OptType]    -- ^ The available options
377 2ac2e420 Iustin Pop
            -> CheckFn a    -- ^ Check function
378 2ac2e420 Iustin Pop
            -> PrepFn  a b  -- ^ Prepare function
379 2ac2e420 Iustin Pop
            -> MainFn  a b  -- ^ Execution function
380 2ac2e420 Iustin Pop
            -> IO ()
381 2ac2e420 Iustin Pop
genericMain daemon options check_fn prep_fn exec_fn = do
382 6ec7a50e Iustin Pop
  let progname = daemonName daemon
383 670e954a Thomas Thrainer
384 6ec7a50e Iustin Pop
  (opts, args) <- parseArgs progname options
385 6ec7a50e Iustin Pop
386 670e954a Thomas Thrainer
  ensureNode daemon
387 670e954a Thomas Thrainer
388 88a10df5 Iustin Pop
  exitUnless (null args) "This program doesn't take any arguments"
389 6ec7a50e Iustin Pop
390 6ec7a50e Iustin Pop
  unless (optNoUserChecks opts) $ do
391 6ec7a50e Iustin Pop
    runtimeEnts <- getEnts
392 88a10df5 Iustin Pop
    ents <- exitIfBad "Can't find required user/groups" runtimeEnts
393 88a10df5 Iustin Pop
    verifyDaemonUser daemon ents
394 6ec7a50e Iustin Pop
395 b714ff89 Iustin Pop
  syslog <- case optSyslogUsage opts of
396 88a10df5 Iustin Pop
              Nothing -> exitIfBad "Invalid cluster syslog setting" $
397 b714ff89 Iustin Pop
                         syslogUsageFromRaw C.syslogUsage
398 b714ff89 Iustin Pop
              Just v -> return v
399 2ac2e420 Iustin Pop
400 29a30533 Iustin Pop
  log_file <- daemonLogFile daemon
401 2ac2e420 Iustin Pop
  -- run the check function and optionally exit if it returns an exit code
402 2ac2e420 Iustin Pop
  check_result <- check_fn opts
403 2ac2e420 Iustin Pop
  check_result' <- case check_result of
404 2ac2e420 Iustin Pop
                     Left code -> exitWith code
405 2ac2e420 Iustin Pop
                     Right v -> return v
406 2ac2e420 Iustin Pop
407 0c28bee1 Iustin Pop
  let processFn = if optDaemonize opts
408 29a30533 Iustin Pop
                    then daemonize log_file
409 b9097468 Iustin Pop
                    else \action -> action Nothing
410 2ac2e420 Iustin Pop
  processFn $ innerMain daemon opts syslog check_result' prep_fn exec_fn
411 6ec7a50e Iustin Pop
412 b9097468 Iustin Pop
-- | Full prepare function.
413 b9097468 Iustin Pop
--
414 b9097468 Iustin Pop
-- This is executed after daemonization, and sets up both the log
415 b9097468 Iustin Pop
-- files (a generic functionality) and the custom prepare function of
416 b9097468 Iustin Pop
-- the daemon.
417 b9097468 Iustin Pop
fullPrep :: GanetiDaemon  -- ^ The daemon we're running
418 b9097468 Iustin Pop
         -> DaemonOptions -- ^ The options structure, filled from the cmdline
419 b9097468 Iustin Pop
         -> SyslogUsage   -- ^ Syslog mode
420 b9097468 Iustin Pop
         -> a             -- ^ Check results
421 b9097468 Iustin Pop
         -> PrepFn a b    -- ^ Prepare function
422 80adbbe1 Michele Tartara
         -> IO (FilePath, b)
423 b9097468 Iustin Pop
fullPrep daemon opts syslog check_result prep_fn = do
424 29a30533 Iustin Pop
  logfile <- if optDaemonize opts
425 29a30533 Iustin Pop
               then return Nothing
426 29a30533 Iustin Pop
               else liftM Just $ daemonLogFile daemon
427 29a30533 Iustin Pop
  pidfile <- daemonPidFile daemon
428 29a30533 Iustin Pop
  let dname = daemonName daemon
429 48483a2e Iustin Pop
  setupLogging logfile dname (optDebug opts) True False syslog
430 e14b84e9 Iustin Pop
  _ <- describeError "writing PID file; already locked?"
431 e14b84e9 Iustin Pop
         Nothing (Just pidfile) $ writePidFile pidfile
432 48483a2e Iustin Pop
  logNotice $ dname ++ " daemon startup"
433 80adbbe1 Michele Tartara
  prep_res <- prep_fn opts check_result
434 80adbbe1 Michele Tartara
  tid <- myThreadId
435 80adbbe1 Michele Tartara
  _ <- installHandler sigTERM (Catch $ handleSigTerm tid) Nothing
436 80adbbe1 Michele Tartara
  return (pidfile, prep_res)
437 b9097468 Iustin Pop
438 6ec7a50e Iustin Pop
-- | Inner daemon function.
439 6ec7a50e Iustin Pop
--
440 6ec7a50e Iustin Pop
-- This is executed after daemonization.
441 2ac2e420 Iustin Pop
innerMain :: GanetiDaemon  -- ^ The daemon we're running
442 2ac2e420 Iustin Pop
          -> DaemonOptions -- ^ The options structure, filled from the cmdline
443 2ac2e420 Iustin Pop
          -> SyslogUsage   -- ^ Syslog mode
444 2ac2e420 Iustin Pop
          -> a             -- ^ Check results
445 2ac2e420 Iustin Pop
          -> PrepFn a b    -- ^ Prepare function
446 2ac2e420 Iustin Pop
          -> MainFn a b    -- ^ Execution function
447 b9097468 Iustin Pop
          -> Maybe Fd      -- ^ Error reporting function
448 2ac2e420 Iustin Pop
          -> IO ()
449 b9097468 Iustin Pop
innerMain daemon opts syslog check_result prep_fn exec_fn fd = do
450 80adbbe1 Michele Tartara
  (pidFile, prep_result) <- fullPrep daemon opts syslog check_result prep_fn
451 1a865afe Iustin Pop
                 `Control.Exception.catch` handlePrepErr True fd
452 b9097468 Iustin Pop
  -- no error reported, we should now close the fd
453 b9097468 Iustin Pop
  maybeCloseFd fd
454 80adbbe1 Michele Tartara
  finally (exec_fn opts check_result prep_result) (finalCleanup pidFile)
455 b9097468 Iustin Pop
456 b9097468 Iustin Pop
-- | Daemon prepare error handling function.
457 1a865afe Iustin Pop
handlePrepErr :: Bool -> Maybe Fd -> IOError -> IO a
458 1a865afe Iustin Pop
handlePrepErr logging_setup fd err = do
459 b9097468 Iustin Pop
  let msg = show err
460 b9097468 Iustin Pop
  case fd of
461 b9097468 Iustin Pop
    -- explicitly writing to the fd directly, since when forking it's
462 b9097468 Iustin Pop
    -- better (safer) than trying to convert this into a full handle
463 b9097468 Iustin Pop
    Just fd' -> fdWrite fd' msg >> return ()
464 b9097468 Iustin Pop
    Nothing  -> hPutStrLn stderr (daemonStartupErr msg)
465 1a865afe Iustin Pop
  when logging_setup $ logError msg
466 b9097468 Iustin Pop
  exitWith $ ExitFailure 1
467 b9097468 Iustin Pop
468 b9097468 Iustin Pop
-- | Close a file descriptor.
469 b9097468 Iustin Pop
maybeCloseFd :: Maybe Fd -> IO ()
470 b9097468 Iustin Pop
maybeCloseFd Nothing   = return ()
471 b9097468 Iustin Pop
maybeCloseFd (Just fd) = closeFd fd