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 =
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";
+ "--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";
] 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 and `Test 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.
Get and set variables:
whenjobs --get variable
- whenjobs --set variable value
+ whenjobs --set variable=value
Start and stop the per-user daemon:
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
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 `Test ->
+ if nr_args > 0 then
+ test_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";
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.
);
(* Test-load the jobs file to ensure it makes sense. *)
- Whenfile.init ();
+ Whenfile.init Whenstate.empty;
(try
Dynlink.loadfile cmo_file
with
);
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
- Whenproto_clnt.When.V1.set_variable client (name, value);
+ (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: 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
+ let jobnames = Whenproto_clnt.When.V1.test_variables client vars in
+ stop_client client;
+
+ Array.iter print_endline jobnames
+
and get_variable name =
let client = start_client () in
let value = Whenproto_clnt.When.V1.get_variable client name in
assert false
and daemon_status () =
- assert false
+ 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 (
and start_client () =
let addr = sprintf "%s/socket" jobsdir in
let client =
- try
- Whenproto_clnt.When.V1.create_client
- (Rpc_client.Unix addr)
- Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *)
+ try start_client_no_exit ()
with
| Unix_error ((ECONNREFUSED|ENOENT), _, _) ->
eprintf "whenjobs: error: the daemon ('whenjobsd') is not running\n";
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
git.annexia.org / whenjobs.git / blobdiff