Document job names.
[whenjobs.git] / tools / whenjobs.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 Big_int
20 open Unix
21 open Printf
22
23 let libdir = ref Libdir.libdir
24
25 let jobsdir =
26   (* Running the program as root is a mistake.  It must be run as a
27    * non-root user.
28    *)
29   let euid = geteuid () in
30   if euid = 0 then (
31     eprintf "whenjobs: this program must not be run as root\n";
32     exit 1
33   );
34
35   (* $HOME must be defined and must exist and be a directory and must be
36    * owned by the current user.
37    *)
38   let home =
39     try getenv "HOME"
40     with Not_found ->
41       eprintf "whenjobs: $HOME environment variable must be defined\n";
42       exit 1 in
43
44   let stat =
45     try lstat home
46     with Unix_error (err, fn, _) ->
47       eprintf "whenjobs: %s: %s ($HOME): %s\n" fn home (error_message err);
48       exit 1 in
49   if stat.st_kind != S_DIR then (
50     eprintf "whenjobs: %s ($HOME): not a directory\n" home;
51     exit 1
52   );
53
54   if stat.st_uid != euid then (
55     eprintf "whenjobs: %s ($HOME): not owned by the current user (uid %d)\n"
56       home euid;
57     exit 1
58   );
59
60   (* Make the $HOME/.whenjobs directory if it doesn't exist. *)
61   let jobsdir = sprintf "%s/.whenjobs" home in
62   (try mkdir jobsdir 0o700 with Unix_error _ -> ());
63
64   jobsdir
65
66 let rec main () =
67   (* Parse the command line arguments. *)
68   let mode = ref None in
69   let typ = ref "string" in
70
71   let set_mode m () = mode := Some m in
72
73   let display_version () =
74     printf "%s %s\n" Config.package_name Config.package_version;
75     exit 0
76   in
77
78   let argspec = Arg.align [
79     "--daemon-start", Arg.Unit (set_mode `Daemon_start), " Start the daemon";
80     "--daemon-status", Arg.Unit (set_mode `Daemon_status), " Display the status of the daemon";
81     "--daemon-stop", Arg.Unit (set_mode `Daemon_stop), " Stop the daemon";
82     "--daemon-restart", Arg.Unit (set_mode `Daemon_restart), " Restart the daemon";
83     "-e", Arg.Unit (set_mode `Edit), " Edit and upload the script";
84     "--edit", Arg.Unit (set_mode `Edit), " Edit and upload the script";
85     "--get", Arg.Unit (set_mode `Get), " Display the variable";
86     "-l", Arg.Unit (set_mode `List), " List the script";
87     "--list", Arg.Unit (set_mode `List), " List the script";
88     "--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo";
89     "--set", Arg.Unit (set_mode `Set), " Set the variable";
90     "--type", Arg.Set_string typ, "bool|int|float|string|unit Set the variable type";
91     "--upload", Arg.Unit (set_mode `Upload), " Upload the script";
92     "--variables", Arg.Unit (set_mode `Variables), " Display all variables and values";
93     "-V", Arg.Unit display_version, " Display version number and exit";
94     "--version", Arg.Unit display_version, " Display version number and exit";
95   ] in
96
97   let args = ref [] in
98   let anon_fun str = args := str :: !args in
99
100   let usage_msg = "\
101 Whenjobs is a powerful but simple cron replacement.
102 Whenjobs copyright (C) 2012 Red Hat Inc.
103
104 Editing the script:
105
106   whenjobs -e | --edit
107   whenjobs -l | --list
108
109 Get and set variables:
110
111   whenjobs --get variable
112   whenjobs --set variable value
113
114 Start and stop the per-user daemon:
115
116   whenjobs --daemon-start | --daemon-stop | --daemon-status
117
118 For documentation see the whenjobs(1) man page.
119
120 Options:
121 " in
122
123   Arg.parse argspec anon_fun usage_msg;
124
125   let mode = !mode in
126   let args = List.rev !args in
127
128   let typ = match !typ with
129     | "bool"|"boolean" -> `Bool
130     | "string" -> `String
131     | "int" -> `Int
132     | "float"|"double" -> `Float
133     | "unit" -> `Unit
134     | t ->
135       eprintf "whenjobs: --type: unknown type (%s)\n" t;
136       exit 1 in
137
138   (* Depending on the selected mode, perform a different action. *)
139   match mode with
140   | None ->
141     eprintf "whenjobs: no operation selected.\n";
142     suggest_help ();
143     exit 1
144
145   | Some `Edit ->
146     unused_error args "-e";
147     edit_file ()
148
149   | Some `List ->
150     unused_error args "-l";
151     list_file ()
152
153   | Some `Upload ->
154     unused_error args "--upload";
155     upload_file ()
156
157   | Some `Set ->
158     if List.length args != 2 then (
159       eprintf "whenjobs --set variable value\n";
160       eprintf "If 'value' contains spaces, you may need to quote it.\n";
161       suggest_help ();
162       exit 1
163     );
164     set_variable (List.hd args) (List.hd (List.tl args)) typ
165
166   | Some `Get ->
167     if List.length args != 1 then (
168       eprintf "whenjobs --get variable\n";
169       suggest_help ();
170       exit 1
171     );
172     get_variable (List.hd args)
173
174   | Some `Variables ->
175     unused_error args "--variables";
176     list_variables ()
177
178   | Some `Daemon_start ->
179     unused_error args "--daemon-start";
180     daemon_start ()
181
182   | Some `Daemon_stop ->
183     unused_error args "--daemon-stop";
184     daemon_stop ()
185
186   | Some `Daemon_restart ->
187     unused_error args "--daemon-restart";
188     daemon_restart ()
189
190   | Some `Daemon_status ->
191     unused_error args "--daemon-status";
192     daemon_status ()
193
194 and edit_file () =
195   (* If there is no initial file, create an empty one containing the
196    * tutorial.
197    *)
198   let file = get_jobs_filename () in
199   if not (Sys.file_exists file) then
200     create_tutorial file;
201
202   (* Is $EDITOR set?  If not, use a default. *)
203   let editor = try getenv "EDITOR" with Not_found -> "vi" in
204
205   (* Get the (size, MD5) of the file to tell if it changed. *)
206   let file_stamp () =
207     try (lstat file).st_size, Digest.file file
208     with Unix_error (err, fn, _) ->
209       eprintf "whenjobs: %s: %s: %s\n" fn file (error_message err);
210       exit 1
211   in
212   let old_stamp = file_stamp () in
213
214   let cmd = sprintf "%s %s" editor file in
215   if Sys.command cmd != 0 then (
216     eprintf "whenjobs: error editing file (is $EDITOR set correctly?)\n";
217     exit 1
218   );
219
220   let new_stamp = file_stamp () in
221
222   if old_stamp <> new_stamp then
223     upload_file ()
224
225 and list_file () =
226   let file = get_jobs_filename () in
227   if not (Sys.file_exists file) then (
228     eprintf "whenjobs: there is no jobs file, use 'whenjobs -e' to create one\n";
229     exit 1
230   );
231   let chan = open_in file in
232   let rec loop () =
233     printf "%s\n" (input_line chan);
234     loop ()
235   in
236   (try loop () with End_of_file -> ());
237   close_in chan
238
239 and upload_file () =
240   (* Recompile the jobs file. *)
241   let file = get_jobs_filename () in
242   let cmo_file = sprintf "%s/jobs.cmo" jobsdir in
243   let cmd = sprintf "ocamlfind ocamlc -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s -o %s"
244     !libdir !libdir file cmo_file in
245   if Sys.command cmd <> 0 then (
246     eprintf "whenjobs: could not compile jobs script, see earlier error messages\n";
247     eprintf "compile command was:\n%s\n" cmd;
248     exit 1
249   );
250
251   (* Test-load the jobs file to ensure it makes sense. *)
252   Whenfile.init Whenstate.empty;
253   (try
254      Dynlink.loadfile cmo_file
255    with
256      Dynlink.Error err ->
257        eprintf "whenjobs: %s\n" (Dynlink.error_message err);
258        (* Since it failed, unlink it. *)
259        (try unlink cmo_file with Unix_error _ -> ());
260        exit 1
261   );
262
263   (* OK now let's tell the daemon to reload it. *)
264   let client = start_client () in
265   (match Whenproto_clnt.When.V1.reload_file client () with
266   | `ok -> ()
267   | `error msg ->
268     eprintf "whenjobs: reload: %s\n" msg;
269     suggest_check_server_logs ();
270     exit 1
271   );
272   stop_client client
273
274 and set_variable name value typ =
275   let value = match typ with
276     | `Bool ->
277       (match value with
278       | "true"|"t"|"yes"|"y"|"on"|"1" -> `bool_t true
279       | "false"|"f"|"no"|"n"|"off"|"0" -> `bool_t false
280       | _ ->
281         eprintf "whenjobs: variable does not have a boolean value\n";
282         exit 1
283       )
284     | `String -> `string_t value
285     | `Int ->
286       (try ignore (big_int_of_string value)
287        with Failure _ ->
288          eprintf "whenjobs: variable is not an integer\n";
289          exit 1
290       );
291       `int_t value (* the string is what we pass over the wire *)
292     | `Float ->
293       (try `float_t (float_of_string value)
294        with Failure _ ->
295          eprintf "whenjobs: variable is not a floating point number\n";
296          exit 1
297       )
298     | `Unit ->
299       if value <> "" then (
300         eprintf "whenjobs: unit variables must be empty strings\n";
301         exit 1
302       );
303       `unit_t in
304
305   let client = start_client () in
306   (match Whenproto_clnt.When.V1.set_variable client (name, value) with
307   | `ok -> ()
308   | `error msg ->
309     eprintf "whenjobs: set: %s\n" msg;
310     suggest_check_server_logs ();
311     exit 1
312   );
313   stop_client client
314
315 and get_variable name =
316   let client = start_client () in
317   let value = Whenproto_clnt.When.V1.get_variable client name in
318   print_endline (string_of_variable value);
319   stop_client client
320
321 and list_variables () =
322   let client = start_client () in
323   let names = Whenproto_clnt.When.V1.get_variable_names client () in
324   Array.iter (
325     fun name ->
326       let value = Whenproto_clnt.When.V1.get_variable client name in
327       printf "%s=%s\n" name (string_of_variable value)
328   ) names;
329   stop_client client
330
331 and daemon_start () =
332   assert false
333
334 and daemon_stop () =
335   let client = start_client () in
336   (match Whenproto_clnt.When.V1.exit_daemon client () with
337   | `ok -> ()
338   | `error msg ->
339     eprintf "whenjobs: daemon-stop: %s\n" msg;
340     suggest_check_server_logs ();
341     exit 1
342   );
343   stop_client client
344
345 and daemon_restart () =
346   assert false
347
348 and daemon_status () =
349   assert false
350
351 and unused_error args op =
352   if args <> [] then (
353     eprintf "whenjobs %s: unused parameters on the command line.\n" op;
354     suggest_help ();
355     exit 1
356   )
357
358 and suggest_help () =
359   eprintf "Use 'whenjobs --help' for a summary of options or read whenjobs(1) man page.\n"
360
361 and suggest_check_server_logs () =
362   eprintf "Look at the server logs (/var/log/cron or /var/log/syslog usually) for\n";
363   eprintf "further information on why this daemon operation failed.\n"
364
365 and get_jobs_filename () =
366   sprintf "%s/jobs.ml" jobsdir
367
368 and create_tutorial file =
369   let chan = open_out file in
370   output_string chan Tutorial.tutorial;
371   close_out chan
372
373 and start_client () =
374   let addr = sprintf "%s/socket" jobsdir in
375   let client =
376     try
377       Whenproto_clnt.When.V1.create_client
378         (Rpc_client.Unix addr)
379         Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *)
380     with
381     | Unix_error ((ECONNREFUSED|ENOENT), _, _) ->
382       eprintf "whenjobs: error: the daemon ('whenjobsd') is not running\n";
383       eprintf "Use 'whenjobs --daemon-start' to start the daemon.\n";
384       exit 1
385     | Unix_error (err, fn, _) ->
386       eprintf "whenjobs: %s: %s: %s\n" fn addr (error_message err);
387       exit 1 in
388   client
389
390 and stop_client client =
391   Rpc_client.shut_down client
392
393 and string_of_variable = function
394   | `unit_t -> ""
395   | `bool_t b -> string_of_bool b
396   | `string_t s -> s
397   | `int_t i -> i (* passed on the wire as a string *)
398   | `float_t f -> string_of_float f
399
400 let () =
401   try main ()
402   with
403     (* Pretty print some of the exceptions that main can throw. *)
404   | Rpc.Rpc_server err ->
405     eprintf "whenjobs: rpc error: %s\n" (Rpc.string_of_server_error err);
406     suggest_check_server_logs ();
407     exit 1
408   | Failure msg ->
409     eprintf "whenjobs: error: %s\n" msg;
410     exit 1
411   | Invalid_argument msg ->
412     eprintf "whenjobs: invalid argument: %s\n" msg;
413     exit 1
414   | exn ->
415     eprintf "whenjobs: error: %s\n" (Printexc.to_string exn);
416     exit 1