whenjobs initial version.
[whenjobs.git] / daemon / whenjobsd.ml
1 (* whenjobs daemon
2  * Copyright (C) 2012 Red Hat Inc.
3  *
4  * This program is free software; you can redistribute it and/or modify
5  * it under the terms of the GNU General Public License as published by
6  * the Free Software Foundation; either version 2 of the License, or
7  * (at your option) any later version.
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License along
15  * with this program; if not, write to the Free Software Foundation, Inc.,
16  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17  *)
18
19 open Unix
20 open Printf
21
22 let () =
23   (* Running the daemon as root is a mistake.  It must be run as a
24    * non-root user.
25    *)
26   let euid = geteuid () in
27   if euid = 0 then (
28     eprintf "whenjobsd: this daemon must run as the local user, NOT root\n";
29     exit 1
30   );
31
32   (* $HOME must be defined and must exist and be a directory and must be
33    * owned by the current user.
34    *)
35   let home =
36     try getenv "HOME"
37     with Not_found ->
38       eprintf "whenjobsd: $HOME environment variable must be defined\n";
39       exit 1 in
40
41   let stat =
42     try lstat home
43     with Unix_error (err, fn, _) ->
44       eprintf "whenjobsd: %s: %s ($HOME): %s\n" fn home (error_message err);
45       exit 1 in
46   if stat.st_kind != S_DIR then (
47     eprintf "whenjobsd: %s ($HOME): not a directory\n" home;
48     exit 1
49   );
50
51   if stat.st_uid != euid then (
52     eprintf "whenjobsd: %s ($HOME): not owned by the current user (uid %d)\n"
53       home euid;
54     exit 1
55   );
56
57   (* Parse the command line arguments. *)
58   let debug = ref false in
59   let do_fork = ref true in
60
61   let display_version () =
62     printf "%s %s\n" Config.package_name Config.package_version;
63     exit 0
64   in
65
66   let argspec = Arg.align [
67     "-d", Arg.Set debug, " Enable extra debugging messages";
68     "-f", Arg.Clear do_fork, " Don't fork into background";
69     "-V", Arg.Unit display_version, " Display version number and exit";
70     "--version", Arg.Unit display_version, " Display version number and exit";
71   ] in
72
73   let anon_fun _ = raise (Arg.Bad "unknown command line argument") in
74
75   let usage_msg = "\
76 Usage:
77   whenjobsd [--options]
78
79 For documentation see the whenjobs(1) and whenjobsd(8) man pages.
80
81 Options:
82 " in
83
84   Arg.parse argspec anon_fun usage_msg;
85
86   let debug = !debug in
87   let do_fork = !do_fork in
88
89   (* Make the $HOME/.whenjobs directory if it doesn't exist. *)
90   let jobsdir = sprintf "%s/.whenjobs" home in
91   (try mkdir jobsdir 0o700 with Unix_error _ -> ());
92
93   (* Create the socket. *)
94   Daemon.init jobsdir debug;
95
96   (* Fork into background. *)
97   if do_fork then (
98     let pid = fork () in
99     if pid > 0 then exit 0;
100
101     (* chdir / so we don't prevent filesystems from being unmounted. *)
102     chdir "/";
103
104     (* Close file descriptors. *)
105     close stdin;
106     close stdout;
107     close stderr;
108
109     (* Create a new session. *)
110     ignore (setsid ());
111
112     (* Ignore SIGHUP. *)
113     Sys.set_signal Sys.sighup Sys.Signal_ignore;
114
115     (* Update the PID file since we just forked. *)
116     Whenlock.update_pid ();
117   );
118
119   (* Start syslog. *)
120   Syslog.notice "daemon started: uid=%d home=%s" euid home;
121
122   (* If there is a jobs.cmo file, load it. *)
123   let () =
124     let file = sprintf "%s/jobs.cmo" jobsdir in
125     if Sys.file_exists file then
126       try Daemon.reload_file () with Failure _ -> () in
127
128   (* Go into main loop. *)
129   Daemon.main_loop ()