X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=tools%2Fwhenjobs.ml;h=582f259921490c244842cec84ce104c9eaba1240;hp=60795ba4c7d6eb0bcc4d81fb48ee6ce1f7bffadd;hb=cdfbf1623f1d81cfca15f8efbe2bf444e6b1ef5a;hpb=65b5a307fc1c55a197ee337180842ac6885ba784 diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml index 60795ba..582f259 100644 --- a/tools/whenjobs.ml +++ b/tools/whenjobs.ml @@ -20,6 +20,11 @@ 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 = @@ -66,36 +71,59 @@ let jobsdir = let rec main () = (* Parse the command line arguments. *) let mode = ref None in - let typ = ref "string" 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), " Display the variable"; + "--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"; - "--type", Arg.Set_string typ, "bool|int|float|string Set the variable type"; + "--start", Arg.Unit (set_mode `Start), "name Start a job manually"; + "--tail", Arg.Unit (set_mode `Tail), "serial Tail job output"; + "--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"; ] in - let args = ref [] in - let anon_fun str = args := str :: !args 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 mode 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. @@ -109,7 +137,7 @@ Editing the script: Get and set variables: whenjobs --get variable - whenjobs --set variable value + whenjobs --set variable=value Start and stop the per-user daemon: @@ -123,16 +151,10 @@ Options: Arg.parse argspec anon_fun usage_msg; let mode = !mode in - let args = List.rev !args in - - let typ = match !typ with - | "bool"|"boolean" -> `Bool - | "string" -> `String - | "int" -> `Int - | "float"|"double" -> `Float - | t -> - eprintf "whenjobs: --type: unknown type (%s)\n" t; - exit 1 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 @@ -154,21 +176,26 @@ Options: upload_file () | Some `Set -> - if List.length args != 2 then ( - eprintf "whenjobs --set variable value\n"; - eprintf "If 'value' contains spaces, you may need to quote it.\n"; + 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 ); - set_variable (List.hd args) (List.hd (List.tl args)) typ + (* 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 `Get -> - if List.length args != 1 then ( + if nr_args != 1 then ( eprintf "whenjobs --get variable\n"; suggest_help (); exit 1 ); - get_variable (List.hd args) + get_variable arg1 | Some `Variables -> unused_error args "--variables"; @@ -190,6 +217,39 @@ Options: 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. @@ -248,7 +308,7 @@ and upload_file () = ); (* Test-load the jobs file to ensure it makes sense. *) - Whenfile.init (); + Whenfile.init Whenstate.empty; (try Dynlink.loadfile cmo_file with @@ -270,33 +330,27 @@ and upload_file () = ); stop_client client -and set_variable name value typ = - let value = match typ with - | `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 - ) in +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_variable client (name, value) with + (match Whenproto_clnt.When.V1.set_variables client vars with | `ok -> () | `error msg -> eprintf "whenjobs: set: %s\n" msg; @@ -341,6 +395,69 @@ and daemon_restart () = and daemon_status () = assert false +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; @@ -384,11 +501,42 @@ 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