2 * Copyright (C) 2012 Red Hat Inc.
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.
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.
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.
25 (* Ensures that Whentools module is linked to the whenjobs tool. *)
26 let _ = Whentools.set_variable
28 let libdir = ref Libdir.libdir
31 (* Running the program as root is a mistake. It must be run as a
34 let euid = geteuid () in
36 eprintf "whenjobs: this program must not be run as root\n";
40 (* $HOME must be defined and must exist and be a directory and must be
41 * owned by the current user.
46 eprintf "whenjobs: $HOME environment variable must be defined\n";
51 with Unix_error (err, fn, _) ->
52 eprintf "whenjobs: %s: %s ($HOME): %s\n" fn home (error_message err);
54 if stat.st_kind != S_DIR then (
55 eprintf "whenjobs: %s ($HOME): not a directory\n" home;
59 if stat.st_uid != euid then (
60 eprintf "whenjobs: %s ($HOME): not owned by the current user (uid %d)\n"
65 (* Make the $HOME/.whenjobs directory if it doesn't exist. *)
66 let jobsdir = sprintf "%s/.whenjobs" home in
67 (try mkdir jobsdir 0o700 with Unix_error _ -> ());
72 (* Parse the command line arguments. *)
73 let mode = ref None in
74 let typ = ref `String in
76 let set_mode m () = mode := Some m in
81 | "bool"|"boolean" -> `Bool
84 | "float"|"double" -> `Float
87 eprintf "whenjobs: --type: unknown type (%s)\n" t;
91 let display_version () =
92 printf "%s %s\n" Config.package_name Config.package_version;
96 let argspec = Arg.align [
97 "--cancel", Arg.Unit (set_mode `Cancel), " Cancel a job";
98 "--daemon-start", Arg.Unit (set_mode `Daemon_start), " Start the daemon";
99 "--daemon-status", Arg.Unit (set_mode `Daemon_status), " Display the status of the daemon";
100 "--daemon-stop", Arg.Unit (set_mode `Daemon_stop), " Stop the daemon";
101 "--daemon-restart", Arg.Unit (set_mode `Daemon_restart), " Restart the daemon";
102 "-e", Arg.Unit (set_mode `Edit), " Edit and upload the script";
103 "--edit", Arg.Unit (set_mode `Edit), " Edit and upload the script";
104 "--get", Arg.Unit (set_mode `Get), "var Display the variable";
105 "--job-names", Arg.Unit (set_mode `JobNames), " List names of loaded jobs";
106 "--jobs", Arg.Unit (set_mode `Jobs), " List running jobs";
107 "-l", Arg.Unit (set_mode `List), " List the script";
108 "--list", Arg.Unit (set_mode `List), " List the script";
109 "--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo";
110 "--set", Arg.Unit (set_mode `Set), " Set the variable";
111 "--start", Arg.Unit (set_mode `Start), "name Start a job manually";
112 "--tail", Arg.Unit (set_mode `Tail), "serial Tail job output";
113 "--test", Arg.Unit (set_mode `Test), " Test the effect of setting variables";
114 "--type", Arg.String set_type, "bool|int|float|string|.. Set the variable type";
115 "--upload", Arg.Unit (set_mode `Upload), " Upload the script";
116 "--variables", Arg.Unit (set_mode `Variables), " Display all variables and values";
117 "-V", Arg.Unit display_version, " Display version number and exit";
118 "--version", Arg.Unit display_version, " Display version number and exit";
119 "--whisper", Arg.Unit (set_mode `Whisper), " Set the variable, quietly";
122 (* anon_fun normally just collects up the anonymous arguments as
123 * strings, and most modes just use 'args' as a list of strings.
124 * However for `Set, `Test and `Whisper modes we need to record the
125 * type of each argument as well, so we keep that in a separate list
128 let argtypes = ref [] in
129 let anon_fun str = argtypes := (str, !typ) :: !argtypes in
132 Whenjobs is a powerful but simple cron replacement.
133 Whenjobs copyright (C) 2012 Red Hat Inc.
140 Get and set variables:
142 whenjobs --get variable
143 whenjobs --set variable=value
145 Start and stop the per-user daemon:
147 whenjobs --daemon-start | --daemon-stop | --daemon-status
149 For documentation see the whenjobs(1) man page.
154 Arg.parse argspec anon_fun usage_msg;
157 let argtypes = List.rev !argtypes in
158 let args = List.map fst argtypes in
159 let nr_args = List.length args in
160 let arg1 = match args with [] -> "" | a::_ -> a in
162 (* Depending on the selected mode, perform a different action. *)
165 eprintf "whenjobs: no operation selected.\n";
170 unused_error args "-e";
174 unused_error args "-l";
178 unused_error args "--upload";
182 if nr_args = 2 && not (String.contains arg1 '=') then (
183 eprintf "'whenjobs --set variable value' is the old whenjobs <= 0.5 syntax!\n";
184 eprintf "You need to change this to:\n";
185 eprintf " whenjobs --set variable=value\n";
189 (* Just ignore the case where no variables are defined, to make
190 * it easier to write shell scripts.
193 set_variables argtypes
197 test_variables argtypes
201 whisper_variables argtypes
204 if nr_args != 1 then (
205 eprintf "whenjobs --get variable\n";
212 unused_error args "--variables";
215 | Some `Daemon_start ->
216 unused_error args "--daemon-start";
219 | Some `Daemon_stop ->
220 unused_error args "--daemon-stop";
223 | Some `Daemon_restart ->
224 unused_error args "--daemon-restart";
227 | Some `Daemon_status ->
228 unused_error args "--daemon-status";
232 unused_error args "--jobs";
236 if nr_args != 1 then (
237 eprintf "whenjobs --cancel serial\n";
244 if nr_args != 1 then (
245 eprintf "whenjobs --start jobname\n";
246 eprintf "If 'value' contains spaces, you may need to quote it.\n";
253 if nr_args != 1 then (
254 eprintf "whenjobs --tail serial\n";
261 unused_error args "--job-names";
265 (* If there is no initial file, create an empty one containing the
268 let file = get_jobs_filename () in
269 if not (Sys.file_exists file) then
270 create_tutorial file;
272 (* Is $EDITOR set? If not, use a default. *)
273 let editor = try getenv "EDITOR" with Not_found -> "vi" in
275 (* Get the (size, MD5) of the file to tell if it changed. *)
277 try (lstat file).st_size, Digest.file file
278 with Unix_error (err, fn, _) ->
279 eprintf "whenjobs: %s: %s: %s\n" fn file (error_message err);
282 let old_stamp = file_stamp () in
284 let cmd = sprintf "%s %s" editor file in
285 if Sys.command cmd != 0 then (
286 eprintf "whenjobs: error editing file (is $EDITOR set correctly?)\n";
290 let new_stamp = file_stamp () in
292 if old_stamp <> new_stamp then
296 let file = get_jobs_filename () in
297 if not (Sys.file_exists file) then (
298 eprintf "whenjobs: there is no jobs file, use 'whenjobs -e' to create one\n";
301 let chan = open_in file in
303 printf "%s\n" (input_line chan);
306 (try loop () with End_of_file -> ());
310 let suffix = if not Config.have_ocamlopt then "cmo" else "cmx" in
312 (* Recompile the jobs file(s). *)
313 let files = get_multijobs_filenames () in
315 (* Choose a random name for the output file. time_t is convenient.
316 * See: https://sympa-roc.inria.fr/wws/arc/caml-list/2012-03/msg00276.html?checked_cas=2
318 let t = Int64.of_float (time ()) in
320 (* Compilation step. *)
324 if not Config.have_ocamlopt then
326 sprintf "%s c -for-pack Jobs__%Ld -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s"
327 Config.ocamlfind t !libdir !libdir file
330 sprintf "%s opt -for-pack Jobs__%Ld -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s"
331 Config.ocamlfind t !libdir !libdir file in
332 if Sys.command cmd <> 0 then (
333 eprintf "whenjobs: %s: could not compile jobs script, see earlier errors\n"
335 eprintf "compile command was:\n%s\n" cmd;
340 (* Pack into a single file. *)
341 let filename = sprintf "%s/jobs__%Ld.%s" jobsdir t suffix in
343 let objects = List.map (
345 let base = Filename.chop_extension file in
346 base ^ if not Config.have_ocamlopt then ".cmo" else ".cmx"
348 sprintf "%s %s -pack -o %s %s"
350 (if not Config.have_ocamlopt then "c" else "opt")
351 filename (String.concat " " objects) in
352 if Sys.command cmd <> 0 then (
353 eprintf "whenjobs: could not pack jobs script, see earlier errors\n";
354 eprintf "compile command was:\n%s\n" cmd;
358 (* For native code only, write a *.cmxs file. *)
360 if Config.have_ocamlopt then (
361 let cmd = sprintf "%s opt -shared -linkall %s -o %ss"
362 Config.ocamlfind filename filename in
363 if Sys.command cmd <> 0 then (
364 eprintf "whenjobs: could not convert to *.cmxs, see earlier errors\n";
365 eprintf "compile command was:\n%s\n" cmd;
368 filename ^ "s" (* .cmx -> .cmxs *)
372 (* Test-load the jobs files to ensure they make sense. *)
373 Whenfile.init Whenstate.empty;
374 (try Dynlink.loadfile filename
377 eprintf "whenjobs: dynlink: %s\n" (Dynlink.error_message err);
378 (* Since it failed, unlink the compiled file. *)
379 (try unlink filename with Unix_error _ -> ());
383 (* OK now let's tell the daemon to reload it. *)
384 let client = start_client () in
385 (match Whenproto_clnt.When.V1.reload_file client () with
388 eprintf "whenjobs: reload: %s\n" msg;
389 suggest_check_server_logs ();
394 and set_variables argtypes =
395 let vars = List.map (
397 (* 'def' should have the form "name=value". The value part may
398 * be missing, but the equals sign is required.
401 try String.index def '='
403 eprintf "whenjobs: set: missing = sign in variable definition\n";
406 let name = String.sub def 0 i in
407 let value = String.sub def (i+1) (String.length def - (i+1)) in
408 let value = value_of_string value typ in
409 { Whenproto_aux.sv_name = name; sv_value = value }
411 let vars = Array.of_list vars in
413 let client = start_client () in
414 (match Whenproto_clnt.When.V1.set_variables client vars with
417 eprintf "whenjobs: set: %s\n" msg;
418 suggest_check_server_logs ();
423 and test_variables argtypes =
424 let vars = List.map (
426 (* 'def' should have the form "name=value". The value part may
427 * be missing, but the equals sign is required.
430 try String.index def '='
432 eprintf "whenjobs: test: missing = sign in variable definition\n";
435 let name = String.sub def 0 i in
436 let value = String.sub def (i+1) (String.length def - (i+1)) in
437 let value = value_of_string value typ in
438 { Whenproto_aux.sv_name = name; sv_value = value }
440 let vars = Array.of_list vars in
442 let client = start_client () in
443 let jobnames = Whenproto_clnt.When.V1.test_variables client vars in
446 Array.iter print_endline jobnames
448 and whisper_variables argtypes =
449 let vars = List.map (
451 (* 'def' should have the form "name=value". The value part may
452 * be missing, but the equals sign is required.
455 try String.index def '='
457 eprintf "whenjobs: whisper: missing = sign in variable definition\n";
460 let name = String.sub def 0 i in
461 let value = String.sub def (i+1) (String.length def - (i+1)) in
462 let value = value_of_string value typ in
463 { Whenproto_aux.sv_name = name; sv_value = value }
465 let vars = Array.of_list vars in
467 let client = start_client () in
468 (match Whenproto_clnt.When.V1.whisper_variables client vars with
471 eprintf "whenjobs: whisper: %s\n" msg;
472 suggest_check_server_logs ();
477 and get_variable name =
478 let client = start_client () in
479 let value = Whenproto_clnt.When.V1.get_variable client name in
480 print_endline (string_of_variable value);
483 and list_variables () =
484 let client = start_client () in
485 let names = Whenproto_clnt.When.V1.get_variable_names client () in
488 let value = Whenproto_clnt.When.V1.get_variable client name in
489 printf "%s=%s\n" name (string_of_variable value)
493 and daemon_start () =
494 exit (Sys.command "whenjobsd")
497 let client = start_client () in
498 (match Whenproto_clnt.When.V1.exit_daemon client () with
501 eprintf "whenjobs: daemon-stop: %s\n" msg;
502 suggest_check_server_logs ();
507 and daemon_restart () =
509 let client = start_client_no_exit () in
510 ignore (Whenproto_clnt.When.V1.exit_daemon client ());
517 and daemon_status () =
520 let client = start_client_no_exit () in
521 let r = Whenproto_clnt.When.V1.ping_daemon client () in
526 print_endline (if r then "up" else "down")
529 let client = start_client () in
530 let jobs = Whenproto_clnt.When.V1.get_jobs client () in
533 let cmp { Whenproto_aux.job_name = name1; job_serial = serial1 }
534 { Whenproto_aux.job_name = name2; job_serial = serial2 } =
535 let i = compare name1 name2 in
538 compare_big_int (big_int_of_string serial1) (big_int_of_string serial2)
543 fun { Whenproto_aux.job_serial = serial; job_name = name;
544 job_tmpdir = tmpdir; job_start_time = time } ->
545 printf "%s %s\n\trunning in: %s\n\tstarted at: %s\n"
547 (string_of_time_t ~localtime:true (Int64.to_float time))
550 and cancel_job serial =
551 let client = start_client () in
552 (match Whenproto_clnt.When.V1.cancel_job client serial with
555 eprintf "whenjobs: cancel-job: %s\n" msg;
556 suggest_check_server_logs ();
562 let client = start_client () in
563 (match Whenproto_clnt.When.V1.start_job client name with
566 eprintf "whenjobs: start-job: %s\n" msg;
567 suggest_check_server_logs ();
572 (* This only works for local. If we ever make whenjobs work
573 * remotely we'll have to change the implementation to use
577 let client = start_client () in
578 let job = Whenproto_clnt.When.V1.get_job client serial in
581 sprintf "tail -f %s/output.txt"
582 (Filename.quote job.Whenproto_aux.job_tmpdir) in
583 exit (Sys.command cmd)
586 let client = start_client () in
587 let names = Whenproto_clnt.When.V1.get_job_names client () in
589 Array.iter print_endline names
591 and unused_error args op =
593 eprintf "whenjobs %s: unused parameters on the command line.\n" op;
598 and suggest_help () =
599 eprintf "Use 'whenjobs --help' for a summary of options or read whenjobs(1) man page.\n"
601 and suggest_check_server_logs () =
602 eprintf "Look at the server logs (/var/log/cron or /var/log/syslog usually) for\n";
603 eprintf "further information on why this daemon operation failed.\n"
605 and get_jobs_filename () =
606 sprintf "%s/jobs.ml" jobsdir
608 and get_multijobs_filenames () =
610 let files = Array.to_list (Sys.readdir jobsdir) in
611 let files = List.filter (fun file -> string_endswith file ".ml") files in
612 let files = List.map (fun file -> jobsdir // file) files in
613 List.sort compare files
615 and create_tutorial file =
616 let chan = open_out file in
617 output_string chan Tutorial.tutorial;
620 and start_client () =
621 let addr = sprintf "%s/socket" jobsdir in
623 try start_client_no_exit ()
625 | Unix_error ((ECONNREFUSED|ENOENT), _, _) ->
626 eprintf "whenjobs: error: the daemon ('whenjobsd') is not running\n";
627 eprintf "Use 'whenjobs --daemon-start' to start the daemon.\n";
629 | Unix_error (err, fn, _) ->
630 eprintf "whenjobs: %s: %s: %s\n" fn addr (error_message err);
634 and start_client_no_exit () =
635 let addr = sprintf "%s/socket" jobsdir in
636 Whenproto_clnt.When.V1.create_client
637 (Rpc_client.Unix addr)
638 Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *)
640 and stop_client client =
641 Rpc_client.shut_down client
643 and string_of_variable = function
645 | `bool_t b -> string_of_bool b
647 | `int_t i -> i (* passed on the wire as a string *)
648 | `float_t f -> string_of_float f
650 and value_of_string value = function
653 | "true"|"t"|"yes"|"y"|"on"|"1" -> `bool_t true
654 | "false"|"f"|"no"|"n"|"off"|"0" -> `bool_t false
656 eprintf "whenjobs: variable does not have a boolean value\n";
659 | `String -> `string_t value
661 (try ignore (big_int_of_string value)
663 eprintf "whenjobs: variable is not an integer\n";
666 `int_t value (* the string is what we pass over the wire *)
668 (try `float_t (float_of_string value)
670 eprintf "whenjobs: variable is not a floating point number\n";
674 if value <> "" then (
675 eprintf "whenjobs: unit variables must be empty strings\n";
683 (* Pretty print some of the exceptions that main can throw. *)
684 | Rpc.Rpc_server err ->
685 eprintf "whenjobs: rpc error: %s\n" (Rpc.string_of_server_error err);
686 suggest_check_server_logs ();
689 eprintf "whenjobs: error: %s\n" msg;
691 | Invalid_argument msg ->
692 eprintf "whenjobs: invalid argument: %s\n" msg;
695 eprintf "whenjobs: error: %s\n" (Printexc.to_string exn);