root / htools / Ganeti / Daemon.hs @ d575c755
History | View | Annotate | Download (8.3 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 | 6ec7a50e | Iustin Pop | , defaultOptions |
30 | 6ec7a50e | Iustin Pop | , oShowHelp |
31 | 6ec7a50e | Iustin Pop | , oShowVer |
32 | 6ec7a50e | Iustin Pop | , oNoDaemonize |
33 | 6ec7a50e | Iustin Pop | , oNoUserChecks |
34 | 6ec7a50e | Iustin Pop | , oDebug |
35 | 6ec7a50e | Iustin Pop | , oPort |
36 | 6ec7a50e | Iustin Pop | , parseArgs |
37 | 6ec7a50e | Iustin Pop | , writePidFile |
38 | 6ec7a50e | Iustin Pop | , genericMain |
39 | 6ec7a50e | Iustin Pop | ) where |
40 | 6ec7a50e | Iustin Pop | |
41 | 6ec7a50e | Iustin Pop | import Control.Monad |
42 | 6ec7a50e | Iustin Pop | import qualified Data.Version |
43 | 6ec7a50e | Iustin Pop | import Data.Word |
44 | 6ec7a50e | Iustin Pop | import System.Console.GetOpt |
45 | 6ec7a50e | Iustin Pop | import System.Exit |
46 | 6ec7a50e | Iustin Pop | import System.Environment |
47 | 6ec7a50e | Iustin Pop | import System.Info |
48 | 6ec7a50e | Iustin Pop | import System.IO |
49 | 6ec7a50e | Iustin Pop | import System.Posix.Directory |
50 | 6ec7a50e | Iustin Pop | import System.Posix.Files |
51 | 6ec7a50e | Iustin Pop | import System.Posix.IO |
52 | 6ec7a50e | Iustin Pop | import System.Posix.Process |
53 | 6ec7a50e | Iustin Pop | import System.Posix.Types |
54 | 6ec7a50e | Iustin Pop | import Text.Printf |
55 | 6ec7a50e | Iustin Pop | |
56 | 6ec7a50e | Iustin Pop | import Ganeti.Logging |
57 | 6ec7a50e | Iustin Pop | import Ganeti.Runtime |
58 | 6ec7a50e | Iustin Pop | import Ganeti.BasicTypes |
59 | 6ec7a50e | Iustin Pop | import Ganeti.HTools.Utils |
60 | 6ec7a50e | Iustin Pop | import qualified Ganeti.HTools.Version as Version(version) |
61 | 6ec7a50e | Iustin Pop | import qualified Ganeti.Constants as C |
62 | 6ec7a50e | Iustin Pop | |
63 | 6ec7a50e | Iustin Pop | -- * Data types |
64 | 6ec7a50e | Iustin Pop | |
65 | 6ec7a50e | Iustin Pop | -- | Command line options structure. |
66 | 6ec7a50e | Iustin Pop | data DaemonOptions = DaemonOptions |
67 | 6ec7a50e | Iustin Pop | { optShowHelp :: Bool -- ^ Just show the help |
68 | 6ec7a50e | Iustin Pop | , optShowVer :: Bool -- ^ Just show the program version |
69 | 6ec7a50e | Iustin Pop | , optDaemonize :: Bool -- ^ Whether to daemonize or not |
70 | 6ec7a50e | Iustin Pop | , optPort :: Maybe Word16 -- ^ Override for the network port |
71 | 6ec7a50e | Iustin Pop | , optDebug :: Bool -- ^ Enable debug messages |
72 | 6ec7a50e | Iustin Pop | , optNoUserChecks :: Bool -- ^ Ignore user checks |
73 | 6ec7a50e | Iustin Pop | } |
74 | 6ec7a50e | Iustin Pop | |
75 | 6ec7a50e | Iustin Pop | -- | Default values for the command line options. |
76 | 6ec7a50e | Iustin Pop | defaultOptions :: DaemonOptions |
77 | 6ec7a50e | Iustin Pop | defaultOptions = DaemonOptions |
78 | 6ec7a50e | Iustin Pop | { optShowHelp = False |
79 | 6ec7a50e | Iustin Pop | , optShowVer = False |
80 | 6ec7a50e | Iustin Pop | , optDaemonize = True |
81 | 6ec7a50e | Iustin Pop | , optPort = Nothing |
82 | 6ec7a50e | Iustin Pop | , optDebug = False |
83 | 6ec7a50e | Iustin Pop | , optNoUserChecks = False |
84 | 6ec7a50e | Iustin Pop | } |
85 | 6ec7a50e | Iustin Pop | |
86 | 6ec7a50e | Iustin Pop | -- | Abrreviation for the option type. |
87 | 6ec7a50e | Iustin Pop | type OptType = OptDescr (DaemonOptions -> Result DaemonOptions) |
88 | 6ec7a50e | Iustin Pop | |
89 | 6ec7a50e | Iustin Pop | -- | Helper function for required arguments which need to be converted |
90 | 6ec7a50e | Iustin Pop | -- as opposed to stored just as string. |
91 | 6ec7a50e | Iustin Pop | reqWithConversion :: (String -> Result a) |
92 | 6ec7a50e | Iustin Pop | -> (a -> DaemonOptions -> Result DaemonOptions) |
93 | 6ec7a50e | Iustin Pop | -> String |
94 | 6ec7a50e | Iustin Pop | -> ArgDescr (DaemonOptions -> Result DaemonOptions) |
95 | 6ec7a50e | Iustin Pop | reqWithConversion conversion_fn updater_fn metavar = |
96 | 6ec7a50e | Iustin Pop | ReqArg (\string_opt opts -> do |
97 | 6ec7a50e | Iustin Pop | parsed_value <- conversion_fn string_opt |
98 | 6ec7a50e | Iustin Pop | updater_fn parsed_value opts) metavar |
99 | 6ec7a50e | Iustin Pop | |
100 | 6ec7a50e | Iustin Pop | -- * Command line options |
101 | 6ec7a50e | Iustin Pop | |
102 | 6ec7a50e | Iustin Pop | oShowHelp :: OptType |
103 | 6ec7a50e | Iustin Pop | oShowHelp = Option "h" ["help"] |
104 | 6ec7a50e | Iustin Pop | (NoArg (\ opts -> Ok opts { optShowHelp = True})) |
105 | 6ec7a50e | Iustin Pop | "Show the help message and exit" |
106 | 6ec7a50e | Iustin Pop | |
107 | 6ec7a50e | Iustin Pop | oShowVer :: OptType |
108 | 6ec7a50e | Iustin Pop | oShowVer = Option "V" ["version"] |
109 | 6ec7a50e | Iustin Pop | (NoArg (\ opts -> Ok opts { optShowVer = True})) |
110 | 6ec7a50e | Iustin Pop | "Show the version of the program and exit" |
111 | 6ec7a50e | Iustin Pop | |
112 | 6ec7a50e | Iustin Pop | oNoDaemonize :: OptType |
113 | 6ec7a50e | Iustin Pop | oNoDaemonize = Option "f" ["foreground"] |
114 | 6ec7a50e | Iustin Pop | (NoArg (\ opts -> Ok opts { optDaemonize = False})) |
115 | 6ec7a50e | Iustin Pop | "Don't detach from the current terminal" |
116 | 6ec7a50e | Iustin Pop | |
117 | 6ec7a50e | Iustin Pop | oDebug :: OptType |
118 | 6ec7a50e | Iustin Pop | oDebug = Option "d" ["debug"] |
119 | 6ec7a50e | Iustin Pop | (NoArg (\ opts -> Ok opts { optDebug = True })) |
120 | 6ec7a50e | Iustin Pop | "Enable debug messages" |
121 | 6ec7a50e | Iustin Pop | |
122 | 6ec7a50e | Iustin Pop | oNoUserChecks :: OptType |
123 | 6ec7a50e | Iustin Pop | oNoUserChecks = Option "" ["no-user-checks"] |
124 | 6ec7a50e | Iustin Pop | (NoArg (\ opts -> Ok opts { optNoUserChecks = True })) |
125 | 6ec7a50e | Iustin Pop | "Ignore user checks" |
126 | 6ec7a50e | Iustin Pop | |
127 | 6ec7a50e | Iustin Pop | oPort :: Int -> OptType |
128 | 6ec7a50e | Iustin Pop | oPort def = Option "p" ["--port"] |
129 | 6ec7a50e | Iustin Pop | (reqWithConversion (tryRead "reading port") |
130 | 6ec7a50e | Iustin Pop | (\port opts -> Ok opts { optPort = Just port }) "PORT") |
131 | 6ec7a50e | Iustin Pop | ("Network port (default: " ++ show def ++ ")") |
132 | 6ec7a50e | Iustin Pop | |
133 | 6ec7a50e | Iustin Pop | -- | Usage info. |
134 | 6ec7a50e | Iustin Pop | usageHelp :: String -> [OptType] -> String |
135 | 6ec7a50e | Iustin Pop | usageHelp progname = |
136 | 6ec7a50e | Iustin Pop | usageInfo (printf "%s %s\nUsage: %s [OPTION...]" |
137 | 6ec7a50e | Iustin Pop | progname Version.version progname) |
138 | 6ec7a50e | Iustin Pop | |
139 | 6ec7a50e | Iustin Pop | -- | Command line parser, using the 'Options' structure. |
140 | 6ec7a50e | Iustin Pop | parseOpts :: [String] -- ^ The command line arguments |
141 | 6ec7a50e | Iustin Pop | -> String -- ^ The program name |
142 | 6ec7a50e | Iustin Pop | -> [OptType] -- ^ The supported command line options |
143 | 6ec7a50e | Iustin Pop | -> IO (DaemonOptions, [String]) -- ^ The resulting options |
144 | 6ec7a50e | Iustin Pop | -- and leftover arguments |
145 | 6ec7a50e | Iustin Pop | parseOpts argv progname options = |
146 | 6ec7a50e | Iustin Pop | case getOpt Permute options argv of |
147 | 6ec7a50e | Iustin Pop | (opt_list, args, []) -> |
148 | 6ec7a50e | Iustin Pop | do |
149 | 6ec7a50e | Iustin Pop | parsed_opts <- |
150 | 6ec7a50e | Iustin Pop | case foldM (flip id) defaultOptions opt_list of |
151 | 6ec7a50e | Iustin Pop | Bad msg -> do |
152 | 6ec7a50e | Iustin Pop | hPutStrLn stderr "Error while parsing command\ |
153 | 6ec7a50e | Iustin Pop | \line arguments:" |
154 | 6ec7a50e | Iustin Pop | hPutStrLn stderr msg |
155 | 6ec7a50e | Iustin Pop | exitWith $ ExitFailure 1 |
156 | 6ec7a50e | Iustin Pop | Ok val -> return val |
157 | 6ec7a50e | Iustin Pop | return (parsed_opts, args) |
158 | 6ec7a50e | Iustin Pop | (_, _, errs) -> do |
159 | 6ec7a50e | Iustin Pop | hPutStrLn stderr $ "Command line error: " ++ concat errs |
160 | 6ec7a50e | Iustin Pop | hPutStrLn stderr $ usageHelp progname options |
161 | 6ec7a50e | Iustin Pop | exitWith $ ExitFailure 2 |
162 | 6ec7a50e | Iustin Pop | |
163 | 6ec7a50e | Iustin Pop | -- | Small wrapper over getArgs and 'parseOpts'. |
164 | 6ec7a50e | Iustin Pop | parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String]) |
165 | 6ec7a50e | Iustin Pop | parseArgs cmd options = do |
166 | 6ec7a50e | Iustin Pop | cmd_args <- getArgs |
167 | 6ec7a50e | Iustin Pop | parseOpts cmd_args cmd options |
168 | 6ec7a50e | Iustin Pop | |
169 | 6ec7a50e | Iustin Pop | -- * Daemon-related functions |
170 | 6ec7a50e | Iustin Pop | -- | PID file mode. |
171 | 6ec7a50e | Iustin Pop | pidFileMode :: FileMode |
172 | 6ec7a50e | Iustin Pop | pidFileMode = unionFileModes ownerReadMode ownerWriteMode |
173 | 6ec7a50e | Iustin Pop | |
174 | 6ec7a50e | Iustin Pop | -- | Writes a PID file and locks it. |
175 | 6ec7a50e | Iustin Pop | _writePidFile :: FilePath -> IO Fd |
176 | 6ec7a50e | Iustin Pop | _writePidFile path = do |
177 | 6ec7a50e | Iustin Pop | fd <- createFile path pidFileMode |
178 | 6ec7a50e | Iustin Pop | setLock fd (WriteLock, AbsoluteSeek, 0, 0) |
179 | 6ec7a50e | Iustin Pop | my_pid <- getProcessID |
180 | 6ec7a50e | Iustin Pop | _ <- fdWrite fd (show my_pid ++ "\n") |
181 | 6ec7a50e | Iustin Pop | return fd |
182 | 6ec7a50e | Iustin Pop | |
183 | 6ec7a50e | Iustin Pop | -- | Wrapper over '_writePidFile' that transforms IO exceptions into a |
184 | 6ec7a50e | Iustin Pop | -- 'Bad' value. |
185 | 6ec7a50e | Iustin Pop | writePidFile :: FilePath -> IO (Result Fd) |
186 | 6ec7a50e | Iustin Pop | writePidFile path = do |
187 | 6ec7a50e | Iustin Pop | catch (fmap Ok $ _writePidFile path) (return . Bad . show) |
188 | 6ec7a50e | Iustin Pop | |
189 | 6ec7a50e | Iustin Pop | -- | Sets up a daemon's environment. |
190 | 6ec7a50e | Iustin Pop | setupDaemonEnv :: FilePath -> FileMode -> IO () |
191 | 6ec7a50e | Iustin Pop | setupDaemonEnv cwd umask = do |
192 | 6ec7a50e | Iustin Pop | changeWorkingDirectory cwd |
193 | 6ec7a50e | Iustin Pop | _ <- setFileCreationMask umask |
194 | 6ec7a50e | Iustin Pop | _ <- createSession |
195 | 6ec7a50e | Iustin Pop | return () |
196 | 6ec7a50e | Iustin Pop | |
197 | 6ec7a50e | Iustin Pop | -- | Run an I/O action as a daemon. |
198 | 6ec7a50e | Iustin Pop | -- |
199 | 6ec7a50e | Iustin Pop | -- WARNING: this only works in single-threaded mode (either using the |
200 | 6ec7a50e | Iustin Pop | -- single-threaded runtime, or using the multi-threaded one but with |
201 | 6ec7a50e | Iustin Pop | -- only one OS thread, i.e. -N1). |
202 | 6ec7a50e | Iustin Pop | -- |
203 | 6ec7a50e | Iustin Pop | -- FIXME: this doesn't support error reporting and the prepfn |
204 | 6ec7a50e | Iustin Pop | -- functionality. |
205 | 6ec7a50e | Iustin Pop | daemonize :: IO () -> IO () |
206 | 6ec7a50e | Iustin Pop | daemonize action = do |
207 | 6ec7a50e | Iustin Pop | -- first fork |
208 | 6ec7a50e | Iustin Pop | _ <- forkProcess $ do |
209 | 6ec7a50e | Iustin Pop | -- in the child |
210 | 6ec7a50e | Iustin Pop | setupDaemonEnv "/" (unionFileModes groupModes otherModes) |
211 | 6ec7a50e | Iustin Pop | _ <- forkProcess action |
212 | 6ec7a50e | Iustin Pop | exitImmediately ExitSuccess |
213 | 6ec7a50e | Iustin Pop | exitImmediately ExitSuccess |
214 | 6ec7a50e | Iustin Pop | |
215 | 6ec7a50e | Iustin Pop | -- | Generic daemon startup. |
216 | 6ec7a50e | Iustin Pop | genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO () |
217 | 6ec7a50e | Iustin Pop | genericMain daemon options main = do |
218 | 6ec7a50e | Iustin Pop | let progname = daemonName daemon |
219 | 6ec7a50e | Iustin Pop | (opts, args) <- parseArgs progname options |
220 | 6ec7a50e | Iustin Pop | |
221 | 6ec7a50e | Iustin Pop | when (optShowHelp opts) $ do |
222 | 6ec7a50e | Iustin Pop | putStr $ usageHelp progname options |
223 | 6ec7a50e | Iustin Pop | exitWith ExitSuccess |
224 | 6ec7a50e | Iustin Pop | when (optShowVer opts) $ do |
225 | 6ec7a50e | Iustin Pop | printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
226 | 6ec7a50e | Iustin Pop | progname Version.version |
227 | 6ec7a50e | Iustin Pop | compilerName (Data.Version.showVersion compilerVersion) |
228 | 6ec7a50e | Iustin Pop | os arch :: IO () |
229 | 6ec7a50e | Iustin Pop | exitWith ExitSuccess |
230 | 6ec7a50e | Iustin Pop | unless (null args) $ do |
231 | 6ec7a50e | Iustin Pop | hPutStrLn stderr "This program doesn't take any arguments" |
232 | 6ec7a50e | Iustin Pop | exitWith $ ExitFailure C.exitFailure |
233 | 6ec7a50e | Iustin Pop | |
234 | 6ec7a50e | Iustin Pop | unless (optNoUserChecks opts) $ do |
235 | 6ec7a50e | Iustin Pop | runtimeEnts <- getEnts |
236 | 6ec7a50e | Iustin Pop | case runtimeEnts of |
237 | 6ec7a50e | Iustin Pop | Bad msg -> do |
238 | 6ec7a50e | Iustin Pop | hPutStrLn stderr $ "Can't find required user/groups: " ++ msg |
239 | 6ec7a50e | Iustin Pop | exitWith $ ExitFailure C.exitFailure |
240 | 6ec7a50e | Iustin Pop | Ok ents -> verifyDaemonUser daemon ents |
241 | 6ec7a50e | Iustin Pop | |
242 | 6ec7a50e | Iustin Pop | let processFn = if optDaemonize opts then daemonize else id |
243 | 6ec7a50e | Iustin Pop | processFn $ innerMain daemon opts (main opts) |
244 | 6ec7a50e | Iustin Pop | |
245 | 6ec7a50e | Iustin Pop | -- | Inner daemon function. |
246 | 6ec7a50e | Iustin Pop | -- |
247 | 6ec7a50e | Iustin Pop | -- This is executed after daemonization. |
248 | 6ec7a50e | Iustin Pop | innerMain :: GanetiDaemon -> DaemonOptions -> IO () -> IO () |
249 | 6ec7a50e | Iustin Pop | innerMain daemon opts main = do |
250 | 6ec7a50e | Iustin Pop | setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts) |
251 | 6ec7a50e | Iustin Pop | (not (optDaemonize opts)) False |
252 | 6ec7a50e | Iustin Pop | pid_fd <- writePidFile (daemonPidFile daemon) |
253 | 6ec7a50e | Iustin Pop | case pid_fd of |
254 | 6ec7a50e | Iustin Pop | Bad msg -> do |
255 | 6ec7a50e | Iustin Pop | hPutStrLn stderr $ "Cannot write PID file; already locked? Error: " ++ |
256 | 6ec7a50e | Iustin Pop | msg |
257 | 6ec7a50e | Iustin Pop | exitWith $ ExitFailure 1 |
258 | 6ec7a50e | Iustin Pop | _ -> return () |
259 | 6ec7a50e | Iustin Pop | logNotice "starting" |
260 | 6ec7a50e | Iustin Pop | main |