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