X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=tools%2Fwhenjobs.ml;h=49a398de7a47051be5f44b0e6d919961ecfbc529;hp=dade6c2b0936c5091fd4a67d543682f80d2c0669;hb=cb8bbd5621366d5adc82e59bff62bd8cc50d8e85;hpb=61cad7bbaf63389b520b695eefdd735bc11a8aa6

diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml
index dade6c2..49a398d 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,62 @@ 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";
+    "--whisper", Arg.Unit (set_mode `Whisper), " Set the variable, quietly";
   ] 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, `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.
@@ -109,7 +140,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 +154,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 +179,34 @@ 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 `Test ->
+    if nr_args > 0 then
+      test_variables argtypes
+
+  | Some `Whisper ->
+    if nr_args > 0 then
+      whisper_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 +228,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.
@@ -236,26 +307,39 @@ 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
-  if Sys.command cmd <> 0 then (
-    eprintf "whenjobs: could not compile jobs script, see earlier error messages\n";
-    eprintf "compile command was:\n%s\n" cmd;
-    exit 1
-  );
+  (* Recompile the jobs file(s). *)
+  let files = get_multijobs_filenames () in
+  List.iter (
+    fun file ->
+      let cmd = sprintf "%s c -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s"
+        Config.ocamlfind !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;
 
-  (* Test-load the jobs file to ensure it makes sense. *)
-  Whenfile.init ();
+  let cmo_files = List.map (
+    fun file ->
+      let n = String.length file in
+      if n < 4 then assert false;
+      String.sub file 0 (n-3) ^ ".cmo"
+  ) files in
+
+  (* Test-load the jobs files to ensure they make sense. *)
+  Whenfile.init Whenstate.empty;
   (try
-     Dynlink.loadfile cmo_file
+     List.iter Dynlink.loadfile cmo_files
    with
      Dynlink.Error err ->
        eprintf "whenjobs: %s\n" (Dynlink.error_message err);
-       (* Since it failed, unlink it. *)
-       (try unlink cmo_file with Unix_error _ -> ());
+       (* Since it failed, unlink the cmo files. *)
+       List.iter (
+         fun cmo_file ->
+           (try unlink cmo_file with Unix_error _ -> ())
+       ) cmo_files;
        exit 1
   );
 
@@ -270,33 +354,87 @@ 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
-  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: 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 =
@@ -316,16 +454,102 @@ and list_variables () =
   stop_client client
 
 and daemon_start () =
-  assert false
+  exit (Sys.command "whenjobsd")
 
 and daemon_stop () =
-  assert false
+  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 () =
-  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
+  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 (
@@ -344,6 +568,17 @@ 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 ->
+      let n = String.length file in
+      n >= 4 && String.sub file (n-3) 3 = ".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;
@@ -352,10 +587,7 @@ and create_tutorial file =
 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";
@@ -366,15 +598,52 @@ and start_client () =
       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