X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=tools%2Fwhenjobs.ml;h=440d4251bc1fd290308a685829531f0e0f91125e;hp=db32eaf54879f173d903cd0067365c9f27592834;hb=efddbf83a5287c5d668cc04a0c7328cf5ca3e648;hpb=46130209a2535fe06801f933e164c65084119705 diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml index db32eaf..440d425 100644 --- a/tools/whenjobs.ml +++ b/tools/whenjobs.ml @@ -116,12 +116,13 @@ let rec main () = "--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 and `Test modes we need to record the type of - * each argument as well, so we keep that in a separate list + * 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 @@ -195,6 +196,10 @@ Options: 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"; @@ -302,26 +307,76 @@ and list_file () = 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 ); @@ -374,7 +429,7 @@ and test_variables argtypes = let i = try String.index def '=' with Not_found -> - eprintf "whenjobs: set: missing = sign in variable definition\n"; + eprintf "whenjobs: test: missing = sign in variable definition\n"; suggest_help (); exit 1 in let name = String.sub def 0 i in @@ -390,6 +445,35 @@ and test_variables argtypes = 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 @@ -407,7 +491,7 @@ and list_variables () = stop_client client and daemon_start () = - assert false + exit (Sys.command "whenjobsd") and daemon_stop () = let client = start_client () in @@ -421,7 +505,14 @@ and daemon_stop () = 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 () = let r = @@ -514,6 +605,13 @@ and suggest_check_server_logs () = 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;