"-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";
"--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 mode we need to record the type of each argument
- * as well, so we keep that in a separate list (argtypes).
+ * 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
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";
);
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.
close_in chan
and upload_file () =
- (* Recompile the jobs file. *)
- let file = get_jobs_filename () in
- let cmo_file = sprintf "%s/jobs.cmo" jobsdir in
- let cmd = sprintf "ocamlfind ocamlc -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s -o %s"
- !libdir !libdir file cmo_file in
+ 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 compile jobs script, see earlier error messages\n";
+ eprintf "whenjobs: could not pack jobs script, see earlier errors\n";
eprintf "compile command was:\n%s\n" cmd;
exit 1
);
- (* Test-load the jobs file to ensure it makes sense. *)
+ (* 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 cmo_file
+ (try Dynlink.loadfile filename
with
Dynlink.Error err ->
- eprintf "whenjobs: %s\n" (Dynlink.error_message err);
- (* Since it failed, unlink it. *)
- (try unlink cmo_file with Unix_error _ -> ());
+ eprintf "whenjobs: dynlink: %s\n" (Dynlink.error_message err);
+ (* Since it failed, unlink the compiled file. *)
+ (try unlink filename with Unix_error _ -> ());
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
stop_client client
and daemon_start () =
- assert false
+ exit (Sys.command "whenjobsd")
and daemon_stop () =
let client = start_client () in
stop_client client
and daemon_restart () =
- assert false
+ (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 () =
- 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
(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;
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;
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