(* whenjobs daemon * Copyright (C) 2012 Red Hat Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) open Big_int open Unix open Printf open Whenutils (* Ensures that Whentools module is linked to the whenjobs tool. *) let _ = Whentools.set_variable let libdir = ref Libdir.libdir let jobsdir = (* Running the program as root is a mistake. It must be run as a * non-root user. *) let euid = geteuid () in if euid = 0 then ( eprintf "whenjobs: this program must not be run as root\n"; exit 1 ); (* $HOME must be defined and must exist and be a directory and must be * owned by the current user. *) let home = try getenv "HOME" with Not_found -> eprintf "whenjobs: $HOME environment variable must be defined\n"; exit 1 in let stat = try lstat home with Unix_error (err, fn, _) -> eprintf "whenjobs: %s: %s ($HOME): %s\n" fn home (error_message err); exit 1 in if stat.st_kind != S_DIR then ( eprintf "whenjobs: %s ($HOME): not a directory\n" home; exit 1 ); if stat.st_uid != euid then ( eprintf "whenjobs: %s ($HOME): not owned by the current user (uid %d)\n" home euid; exit 1 ); (* Make the $HOME/.whenjobs directory if it doesn't exist. *) let jobsdir = sprintf "%s/.whenjobs" home in (try mkdir jobsdir 0o700 with Unix_error _ -> ()); jobsdir let rec main () = (* Parse the command line arguments. *) let mode = ref None in let typ = ref `String in let set_mode m () = mode := Some m in let set_type t = typ := match t with | "bool"|"boolean" -> `Bool | "string" -> `String | "int" -> `Int | "float"|"double" -> `Float | "unit" -> `Unit | _ -> eprintf "whenjobs: --type: unknown type (%s)\n" t; exit 1 in let display_version () = printf "%s %s\n" Config.package_name Config.package_version; exit 0 in let argspec = Arg.align [ "--cancel", Arg.Unit (set_mode `Cancel), " Cancel a job"; "--daemon-start", Arg.Unit (set_mode `Daemon_start), " Start the daemon"; "--daemon-status", Arg.Unit (set_mode `Daemon_status), " Display the status of the daemon"; "--daemon-stop", Arg.Unit (set_mode `Daemon_stop), " Stop the daemon"; "--daemon-restart", Arg.Unit (set_mode `Daemon_restart), " Restart the daemon"; "-e", Arg.Unit (set_mode `Edit), " Edit and upload the script"; "--edit", Arg.Unit (set_mode `Edit), " Edit and upload the script"; "--get", Arg.Unit (set_mode `Get), "var Display the variable"; "--job-names", Arg.Unit (set_mode `JobNames), " List names of loaded jobs"; "--jobs", Arg.Unit (set_mode `Jobs), " List running jobs"; "-l", Arg.Unit (set_mode `List), " List the script"; "--list", Arg.Unit (set_mode `List), " List the script"; "--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo"; "--set", Arg.Unit (set_mode `Set), " Set the variable"; "--start", Arg.Unit (set_mode `Start), "name Start a job manually"; "--tail", Arg.Unit (set_mode `Tail), "serial Tail job output"; "--test", Arg.Unit (set_mode `Test), " Test the effect of setting variables"; "--type", Arg.String set_type, "bool|int|float|string|.. Set the variable type"; "--upload", Arg.Unit (set_mode `Upload), " Upload the script"; "--variables", Arg.Unit (set_mode `Variables), " Display all variables and values"; "-V", Arg.Unit display_version, " Display version number and exit"; "--version", Arg.Unit display_version, " Display version number and exit"; "--whisper", Arg.Unit (set_mode `Whisper), " Set the variable, quietly"; ] in (* anon_fun normally just collects up the anonymous arguments as * strings, and most modes just use 'args' as a list of strings. * However for `Set, `Test and `Whisper modes we need to record the * type of each argument as well, so we keep that in a separate list * (argtypes). *) let argtypes = ref [] in let anon_fun str = argtypes := (str, !typ) :: !argtypes in let usage_msg = "\ Whenjobs is a powerful but simple cron replacement. Whenjobs copyright (C) 2012 Red Hat Inc. Editing the script: whenjobs -e | --edit whenjobs -l | --list Get and set variables: whenjobs --get variable whenjobs --set variable=value Start and stop the per-user daemon: whenjobs --daemon-start | --daemon-stop | --daemon-status For documentation see the whenjobs(1) man page. Options: " in Arg.parse argspec anon_fun usage_msg; let mode = !mode in let argtypes = List.rev !argtypes in let args = List.map fst argtypes in let nr_args = List.length args in let arg1 = match args with [] -> "" | a::_ -> a in (* Depending on the selected mode, perform a different action. *) match mode with | None -> eprintf "whenjobs: no operation selected.\n"; suggest_help (); exit 1 | Some `Edit -> unused_error args "-e"; edit_file () | Some `List -> unused_error args "-l"; list_file () | Some `Upload -> unused_error args "--upload"; upload_file () | Some `Set -> if nr_args = 2 && not (String.contains arg1 '=') then ( eprintf "'whenjobs --set variable value' is the old whenjobs <= 0.5 syntax!\n"; eprintf "You need to change this to:\n"; eprintf " whenjobs --set variable=value\n"; suggest_help (); exit 1 ); (* Just ignore the case where no variables are defined, to make * it easier to write shell scripts. *) if nr_args > 0 then set_variables argtypes | Some `Test -> if nr_args > 0 then test_variables argtypes | Some `Whisper -> if nr_args > 0 then whisper_variables argtypes | Some `Get -> if nr_args != 1 then ( eprintf "whenjobs --get variable\n"; suggest_help (); exit 1 ); get_variable arg1 | Some `Variables -> unused_error args "--variables"; list_variables () | Some `Daemon_start -> unused_error args "--daemon-start"; daemon_start () | Some `Daemon_stop -> unused_error args "--daemon-stop"; daemon_stop () | Some `Daemon_restart -> unused_error args "--daemon-restart"; daemon_restart () | Some `Daemon_status -> unused_error args "--daemon-status"; daemon_status () | Some `Jobs -> unused_error args "--jobs"; jobs () | Some `Cancel -> if nr_args != 1 then ( eprintf "whenjobs --cancel serial\n"; suggest_help (); exit 1 ); cancel_job arg1 | Some `Start -> if nr_args != 1 then ( eprintf "whenjobs --start jobname\n"; eprintf "If 'value' contains spaces, you may need to quote it.\n"; suggest_help (); exit 1 ); start_job arg1 | Some `Tail -> if nr_args != 1 then ( eprintf "whenjobs --tail serial\n"; suggest_help (); exit 1 ); tail arg1 | Some `JobNames -> unused_error args "--job-names"; job_names () and edit_file () = (* If there is no initial file, create an empty one containing the * tutorial. *) let file = get_jobs_filename () in if not (Sys.file_exists file) then create_tutorial file; (* Is $EDITOR set? If not, use a default. *) let editor = try getenv "EDITOR" with Not_found -> "vi" in (* Get the (size, MD5) of the file to tell if it changed. *) let file_stamp () = try (lstat file).st_size, Digest.file file with Unix_error (err, fn, _) -> eprintf "whenjobs: %s: %s: %s\n" fn file (error_message err); exit 1 in let old_stamp = file_stamp () in let cmd = sprintf "%s %s" editor file in if Sys.command cmd != 0 then ( eprintf "whenjobs: error editing file (is $EDITOR set correctly?)\n"; exit 1 ); let new_stamp = file_stamp () in if old_stamp <> new_stamp then upload_file () and list_file () = let file = get_jobs_filename () in if not (Sys.file_exists file) then ( eprintf "whenjobs: there is no jobs file, use 'whenjobs -e' to create one\n"; exit 1 ); let chan = open_in file in let rec loop () = printf "%s\n" (input_line chan); loop () in (try loop () with End_of_file -> ()); close_in chan and upload_file () = let suffix = if not Config.have_ocamlopt then "cmo" else "cmx" in (* Recompile the jobs file(s). *) let files = get_multijobs_filenames () in (* Choose a random name for the output file. time_t is convenient. * See: https://sympa-roc.inria.fr/wws/arc/caml-list/2012-03/msg00276.html?checked_cas=2 *) let t = Int64.of_float (time ()) in (* Compilation step. *) List.iter ( fun file -> let cmd = if not Config.have_ocamlopt then (* bytecode *) sprintf "%s c -for-pack Jobs__%Ld -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s" Config.ocamlfind t !libdir !libdir file else (* native code *) sprintf "%s opt -for-pack Jobs__%Ld -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s" Config.ocamlfind t !libdir !libdir file in if Sys.command cmd <> 0 then ( eprintf "whenjobs: %s: could not compile jobs script, see earlier errors\n" file; eprintf "compile command was:\n%s\n" cmd; exit 1 ) ) files; (* Pack into a single file. *) let filename = sprintf "%s/jobs__%Ld.%s" jobsdir t suffix in let cmd = let objects = List.map ( fun file -> let base = Filename.chop_extension file in base ^ if not Config.have_ocamlopt then ".cmo" else ".cmx" ) files in sprintf "%s %s -pack -o %s %s" Config.ocamlfind (if not Config.have_ocamlopt then "c" else "opt") filename (String.concat " " objects) in if Sys.command cmd <> 0 then ( eprintf "whenjobs: could not pack jobs script, see earlier errors\n"; eprintf "compile command was:\n%s\n" cmd; exit 1 ); (* For native code only, write a *.cmxs file. *) let filename = if Config.have_ocamlopt then ( let cmd = sprintf "%s opt -shared -linkall %s -o %ss" Config.ocamlfind filename filename in if Sys.command cmd <> 0 then ( eprintf "whenjobs: could not convert to *.cmxs, see earlier errors\n"; eprintf "compile command was:\n%s\n" cmd; exit 1 ); filename ^ "s" (* .cmx -> .cmxs *) ) else filename in (* Test-load the jobs files to ensure they make sense. *) Whenfile.init Whenstate.empty; (try Dynlink.loadfile filename with Dynlink.Error err -> eprintf "whenjobs: dynlink: %s\n" (Dynlink.error_message err); (* Since it failed, unlink the compiled file. *) (try unlink filename with Unix_error _ -> ()); exit 1 ); (* OK now let's tell the daemon to reload it. *) let client = start_client () in (match Whenproto_clnt.When.V1.reload_file client () with | `ok -> () | `error msg -> eprintf "whenjobs: reload: %s\n" msg; suggest_check_server_logs (); exit 1 ); stop_client client and set_variables argtypes = let vars = List.map ( fun (def, typ) -> (* 'def' should have the form "name=value". The value part may * be missing, but the equals sign is required. *) let i = try String.index def '=' with Not_found -> eprintf "whenjobs: set: missing = sign in variable definition\n"; suggest_help (); exit 1 in let name = String.sub def 0 i in let value = String.sub def (i+1) (String.length def - (i+1)) in let value = value_of_string value typ in { Whenproto_aux.sv_name = name; sv_value = value } ) argtypes in let vars = Array.of_list vars in let client = start_client () in (match Whenproto_clnt.When.V1.set_variables client vars with | `ok -> () | `error msg -> eprintf "whenjobs: set: %s\n" msg; suggest_check_server_logs (); exit 1 ); stop_client client and test_variables argtypes = let vars = List.map ( fun (def, typ) -> (* 'def' should have the form "name=value". The value part may * be missing, but the equals sign is required. *) let i = try String.index def '=' with Not_found -> eprintf "whenjobs: test: missing = sign in variable definition\n"; suggest_help (); exit 1 in let name = String.sub def 0 i in let value = String.sub def (i+1) (String.length def - (i+1)) in let value = value_of_string value typ in { Whenproto_aux.sv_name = name; sv_value = value } ) argtypes in let vars = Array.of_list vars in let client = start_client () in let jobnames = Whenproto_clnt.When.V1.test_variables client vars in stop_client client; Array.iter print_endline jobnames and whisper_variables argtypes = let vars = List.map ( fun (def, typ) -> (* 'def' should have the form "name=value". The value part may * be missing, but the equals sign is required. *) let i = try String.index def '=' with Not_found -> eprintf "whenjobs: whisper: missing = sign in variable definition\n"; suggest_help (); exit 1 in let name = String.sub def 0 i in let value = String.sub def (i+1) (String.length def - (i+1)) in let value = value_of_string value typ in { Whenproto_aux.sv_name = name; sv_value = value } ) argtypes in let vars = Array.of_list vars in let client = start_client () in (match Whenproto_clnt.When.V1.whisper_variables client vars with | `ok -> () | `error msg -> eprintf "whenjobs: whisper: %s\n" msg; suggest_check_server_logs (); exit 1 ); stop_client client and get_variable name = let client = start_client () in let value = Whenproto_clnt.When.V1.get_variable client name in print_endline (string_of_variable value); stop_client client and list_variables () = let client = start_client () in let names = Whenproto_clnt.When.V1.get_variable_names client () in Array.iter ( fun name -> let value = Whenproto_clnt.When.V1.get_variable client name in printf "%s=%s\n" name (string_of_variable value) ) names; stop_client client and daemon_start () = exit (Sys.command "whenjobsd") and daemon_stop () = let client = start_client () in (match Whenproto_clnt.When.V1.exit_daemon client () with | `ok -> () | `error msg -> eprintf "whenjobs: daemon-stop: %s\n" msg; suggest_check_server_logs (); exit 1 ); stop_client client and daemon_restart () = (try let client = start_client_no_exit () in ignore (Whenproto_clnt.When.V1.exit_daemon client ()); stop_client client with _ -> () ); sleep 1; daemon_start () and daemon_status () = let r = try let client = start_client_no_exit () in let r = Whenproto_clnt.When.V1.ping_daemon client () in stop_client client; r = `ok with exn -> false in print_endline (if r then "up" else "down") and jobs () = let client = start_client () in let jobs = Whenproto_clnt.When.V1.get_jobs client () in stop_client client; let cmp { Whenproto_aux.job_name = name1; job_serial = serial1 } { Whenproto_aux.job_name = name2; job_serial = serial2 } = let i = compare name1 name2 in if i <> 0 then i else compare_big_int (big_int_of_string serial1) (big_int_of_string serial2) in Array.sort cmp jobs; Array.iter ( fun { Whenproto_aux.job_serial = serial; job_name = name; job_tmpdir = tmpdir; job_start_time = time } -> printf "%s %s\n\trunning in: %s\n\tstarted at: %s\n" serial name tmpdir (string_of_time_t ~localtime:true (Int64.to_float time)) ) jobs and cancel_job serial = let client = start_client () in (match Whenproto_clnt.When.V1.cancel_job client serial with | `ok -> () | `error msg -> eprintf "whenjobs: cancel-job: %s\n" msg; suggest_check_server_logs (); exit 1 ); stop_client client and start_job name = let client = start_client () in (match Whenproto_clnt.When.V1.start_job client name with | `ok -> () | `error msg -> eprintf "whenjobs: start-job: %s\n" msg; suggest_check_server_logs (); exit 1 ); stop_client client (* This only works for local. If we ever make whenjobs work * remotely we'll have to change the implementation to use * the server. *) and tail serial = let client = start_client () in let job = Whenproto_clnt.When.V1.get_job client serial in stop_client client; let cmd = sprintf "tail -f %s/output.txt" (Filename.quote job.Whenproto_aux.job_tmpdir) in exit (Sys.command cmd) and job_names () = let client = start_client () in let names = Whenproto_clnt.When.V1.get_job_names client () in stop_client client; Array.iter print_endline names and unused_error args op = if args <> [] then ( eprintf "whenjobs %s: unused parameters on the command line.\n" op; suggest_help (); exit 1 ) and suggest_help () = eprintf "Use 'whenjobs --help' for a summary of options or read whenjobs(1) man page.\n" and suggest_check_server_logs () = eprintf "Look at the server logs (/var/log/cron or /var/log/syslog usually) for\n"; eprintf "further information on why this daemon operation failed.\n" and get_jobs_filename () = sprintf "%s/jobs.ml" jobsdir and get_multijobs_filenames () = (* Get dir/*.ml *) let files = Array.to_list (Sys.readdir jobsdir) in let files = List.filter (fun file -> string_endswith file ".ml") files in let files = List.map (fun file -> jobsdir // file) files in List.sort compare files and create_tutorial file = let chan = open_out file in output_string chan Tutorial.tutorial; close_out chan and start_client () = let addr = sprintf "%s/socket" jobsdir in let client = try start_client_no_exit () with | Unix_error ((ECONNREFUSED|ENOENT), _, _) -> eprintf "whenjobs: error: the daemon ('whenjobsd') is not running\n"; eprintf "Use 'whenjobs --daemon-start' to start the daemon.\n"; exit 1 | Unix_error (err, fn, _) -> eprintf "whenjobs: %s: %s: %s\n" fn addr (error_message err); exit 1 in client and start_client_no_exit () = let addr = sprintf "%s/socket" jobsdir in Whenproto_clnt.When.V1.create_client (Rpc_client.Unix addr) Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *) and stop_client client = Rpc_client.shut_down client and string_of_variable = function | `unit_t -> "" | `bool_t b -> string_of_bool b | `string_t s -> s | `int_t i -> i (* passed on the wire as a string *) | `float_t f -> string_of_float f and value_of_string value = function | `Bool -> (match value with | "true"|"t"|"yes"|"y"|"on"|"1" -> `bool_t true | "false"|"f"|"no"|"n"|"off"|"0" -> `bool_t false | _ -> eprintf "whenjobs: variable does not have a boolean value\n"; exit 1 ) | `String -> `string_t value | `Int -> (try ignore (big_int_of_string value) with Failure _ -> eprintf "whenjobs: variable is not an integer\n"; exit 1 ); `int_t value (* the string is what we pass over the wire *) | `Float -> (try `float_t (float_of_string value) with Failure _ -> eprintf "whenjobs: variable is not a floating point number\n"; exit 1 ) | `Unit -> if value <> "" then ( eprintf "whenjobs: unit variables must be empty strings\n"; exit 1 ); `unit_t let () = try main () with (* Pretty print some of the exceptions that main can throw. *) | Rpc.Rpc_server err -> eprintf "whenjobs: rpc error: %s\n" (Rpc.string_of_server_error err); suggest_check_server_logs (); exit 1 | Failure msg -> eprintf "whenjobs: error: %s\n" msg; exit 1 | Invalid_argument msg -> eprintf "whenjobs: invalid argument: %s\n" msg; exit 1 | exn -> eprintf "whenjobs: error: %s\n" (Printexc.to_string exn); exit 1