Renumber the jobs file so that it can be reloaded in native code.

See:
https://sympa-roc.inria.fr/wws/arc/caml-list/2012-03/msg00276.html?checked_cas=2

diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index bc4f51a..64d4012 100644 (file)
--- a/daemon/daemon.ml
+++ b/daemon/daemon.ml
@@ -292,13 +292,38 @@ and proc_whisper_variables vars =
 
 (* Reload the jobs file(s). *)
 and reload_files () =
 
 (* Reload the jobs file(s). *)
 and reload_files () =

-  (* Get dir/*.cmo (bytecode) or dir/*.cmxs (native code) *)
-  let suffix = if not Dynlink.is_native then ".cmo" else ".cmxs" in
-  let dir = !jobsdir in
-  let files = Array.to_list (Sys.readdir dir) in
-  let files = List.filter (fun file -> string_endswith file suffix) files in
-  let files = List.map (fun file -> dir // file) files in
-  let files = List.sort compare files in
+  (* Get the highest numbered dir/jobs__*.cmo (bytecode) or
+   * dir/jobs__*.cmxs (native code) file and load it.  Delete
+   * lower-numbered (== older) files.
+   *)
+  let filename =
+    let suffix, slen =
+      if not Dynlink.is_native then ".cmo", 4 else ".cmxs", 5 in
+    let dir = !jobsdir in
+    let files = Array.to_list (Sys.readdir dir) in
+    let times = filter_map (
+      fun file ->
+        if not (string_startswith file "jobs__") ||
+          not (string_endswith file suffix) then
+          None
+        else (
+          let len = String.length file in
+          let t = String.sub file 6 (len-slen-6) in
+          try Some (int_of_string t) with Failure "int_of_string" -> None
+        )
+    ) files in
+    let times = List.rev (List.sort compare times) in
+    match times with
+    | [] -> None
+    | x::xs ->
+      (* Unlink the older files. *)
+      List.iter (
+        fun t ->
+          try unlink (dir // sprintf "jobs__%d%s" t suffix)
+          with Unix_error _ -> ()
+      ) xs;
+      (* Return the newest (highest numbered) file. *)
+      Some (dir // sprintf "jobs__%d%s" x suffix) in

 
   (* As we are reloading the file, we want to create a new state
    * that has no jobs, but has all the variables from the previous
 
   (* As we are reloading the file, we want to create a new state
    * that has no jobs, but has all the variables from the previous


@@ -308,19 +333,24 @@ and reload_files () =
   Whenfile.init s;
 
   let s =
   Whenfile.init s;
 
   let s =

-    try
-      List.iter Dynlink.loadfile files;
-      let s = Whenfile.get_state () in
-      Syslog.notice "loaded %d job(s) from %d file(s)"
-        (Whenstate.nr_jobs s) (List.length files);
+    match filename with
+    | None ->
+      (* no jobs file, return the same state *)
+      Syslog.notice "no jobs file found";

       s
       s

-    with
-    | Dynlink.Error err ->
-      let err = Dynlink.error_message err in
-      Syslog.error "error loading jobs: %s" err;
-      failwith err
-    | exn ->
-      failwith (Printexc.to_string exn) in
+    | Some filename ->
+      try
+        Dynlink.loadfile filename;
+        let s = Whenfile.get_state () in
+        Syslog.notice "loaded %d job(s)" (Whenstate.nr_jobs s);
+        s
+      with
+      | Dynlink.Error err ->
+        let err = Dynlink.error_message err in
+        Syslog.error "error loading jobs: %s" err;
+        failwith err
+      | exn ->
+        failwith (Printexc.to_string exn) in

 
   let s = Whenstate.copy_prev_state !state s in
   state := s;
 
   let s = Whenstate.copy_prev_state !state s in
   state := s;

diff --git a/daemon/whenjobsd.ml b/daemon/whenjobsd.ml
index 3028503..f5e766a 100644 (file)
--- a/daemon/whenjobsd.ml
+++ b/daemon/whenjobsd.ml
@@ -126,12 +126,8 @@ Options:
   Syslog.notice "daemon started: version=%s uid=%d home=%s"
     Config.package_version euid home;
 
   Syslog.notice "daemon started: version=%s uid=%d home=%s"
     Config.package_version euid home;
 

-  (* If there is a jobs.cmo/jobs.cmxs file, load it. *)
-  let () =
-    let suffix = if not Dynlink.is_native then "cmo" else "cmxs" in
-    let file = sprintf "%s/jobs.%s" jobsdir suffix in
-    if Sys.file_exists file then
-      try Daemon.reload_files () with Failure _ -> () in
+  (* If there is a jobs__*.cmo/jobs__*.cmxs file, load it. *)
+  (try Daemon.reload_files () with Failure _ -> ());

 
   (* Go into main loop. *)
   Daemon.main_loop ()
 
   (* Go into main loop. *)
   Daemon.main_loop ()

diff --git a/daemon/whenjobsd.pod b/daemon/whenjobsd.pod
index 7139cb3..923a3d2 100644 (file)
--- a/daemon/whenjobsd.pod
+++ b/daemon/whenjobsd.pod
@@ -80,14 +80,19 @@ This contains the process ID of the daemon.  The daemon also holds an
 advisory (L<flock(2)>-style) exclusive lock on this file while it is
 running.
 
 advisory (L<flock(2)>-style) exclusive lock on this file while it is
 running.
 

-=item C<$HOME/.whenjobs/*.cmo>
+=item C<$HOME/.whenjobs/jobs__*.cmo> (bytecode daemon)

 
 

-The compiled jobs specification file(s) which the daemon loads on
-start up, or reloads when instructed to by the L<whenjobs(1)> tool.
+=item C<$HOME/.whenjobs/jobs__*.cmxs> (native code daemon)

 
 

-Normally you only have one, called C<jobs.cmo>, corresponding to the
-source file C<jobs.ml> which is edited by C<whenjobs -e>.  It is
-possible to have multiple files, see L<whenjobs(1)/MULTIPLE JOBS FILES>.
+The compiled jobs specification file which the daemon loads on start
+up, or reloads when instructed to by the L<whenjobs(1)> tool.
+
+The source jobs ml file(s) are compiled down to a single module with a
+random name (each source file is a submodule).  Only the highest
+numbered file is loaded; the others are assumed to be earlier versions
+and deleted.
+
+See also L<whenjobs(1)/MULTIPLE JOBS FILES>.

 
 =item C<$HOME/.whenjobs/socket>
 
 
 =item C<$HOME/.whenjobs/socket>
 

diff --git a/lib/whenutils.ml b/lib/whenutils.ml
index 5f7c4ee..79a653f 100644 (file)
--- a/lib/whenutils.ml
+++ b/lib/whenutils.ml
@@ -64,6 +64,11 @@ let string_of_time_t ?(localtime = false) t =
     tm.tm_hour tm.tm_min tm.tm_sec
     (if localtime then "" else " UTC")
 
     tm.tm_hour tm.tm_min tm.tm_sec
     (if localtime then "" else " UTC")
 

+let string_startswith str prefix =
+  let len = String.length str in
+  let plen = String.length prefix in
+  len >= plen && String.sub str 0 plen = prefix
+

 let string_endswith str suffix =
   let len = String.length str in
   let slen = String.length suffix in
 let string_endswith str suffix =
   let len = String.length str in
   let slen = String.length suffix in

diff --git a/lib/whenutils.mli b/lib/whenutils.mli
index da51c70..ef3f591 100644 (file)
--- a/lib/whenutils.mli
+++ b/lib/whenutils.mli
@@ -161,5 +161,9 @@ val string_of_time_t : ?localtime:bool -> float -> string
 (** Convert string to time in ISO format.  If [~localtime] is true
     then it uses localtime, else UTC. *)
 
 (** Convert string to time in ISO format.  If [~localtime] is true
     then it uses localtime, else UTC. *)
 

+val string_startswith : string -> string -> bool
+(** [string_startswith str prefix] returns true iff [str] starts
+    with [prefix]. *)
+

 val string_endswith : string -> string -> bool
 (** [string_endswith str suffix] returns true iff [str] ends with [suffix]. *)
 val string_endswith : string -> string -> bool
 (** [string_endswith str suffix] returns true iff [str] ends with [suffix]. *)

diff --git a/tests/jobs/Makefile.am b/tests/jobs/Makefile.am
index 1ae468b..052d5ce 100644 (file)
--- a/tests/jobs/Makefile.am
+++ b/tests/jobs/Makefile.am
@@ -24,7 +24,8 @@ TESTS = \
        t102_manyjobs.ml \
        t103_whisper.ml \
        t200_ocaml_jobnames.ml \
        t102_manyjobs.ml \
        t103_whisper.ml \
        t200_ocaml_jobnames.ml \

-       t201_ocaml_set_variable.ml
+       t201_ocaml_set_variable.ml \
+       t300_reload.ml

 
 OCAMLPACKAGES = -package unix,num,camlp4.lib,calendar,rpc -I ../../lib
 
 
 OCAMLPACKAGES = -package unix,num,camlp4.lib,calendar,rpc -I ../../lib
 

diff --git a/tests/jobs/t300_reload.ml b/tests/jobs/t300_reload.ml
new file mode 100644 (file)
index 0000000..f7c6532
--- /dev/null
+++ b/tests/jobs/t300_reload.ml
@@ -0,0 +1,49 @@
+(* whenjobs
+ * Copyright (C) 2012 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Test reloading the script. *)
+
+let () =
+  Whentools.set_variable_int "counter" 1;
+  Whentools.set_variable "state" "A"
+
+every 2 seconds :
+<<
+  echo $JOBSERIAL $JOBNAME $counter >\> $HOME/test_output
+  whenjobs --set --type int counter=$(($counter+1))
+>>
+
+when counter == 2 :
+<<
+  echo $JOBSERIAL $JOBNAME $counter $state >\> $HOME/test_output
+
+  # Actually modify the 'set_variable' lines above in the jobs script.
+  mv $HOME/.whenjobs/jobs.ml $HOME/.whenjobs/jobs.ml.old
+  sed \
+      -e 's/"counter" 1/"counter" 3/' \
+      -e 's/"state" "A"/"state" "B"/' \
+       < $HOME/.whenjobs/jobs.ml.old > $HOME/.whenjobs/jobs.ml
+
+  whenjobs --upload --lib "$libdir"
+>>
+
+when counter == 4 :
+<<
+  echo $JOBSERIAL $JOBNAME $counter $state >\> $HOME/test_output
+  whenjobs --daemon-stop
+>>

diff --git a/tests/jobs/t300_reload.ml.expected b/tests/jobs/t300_reload.ml.expected
new file mode 100644 (file)
index 0000000..83ba6de
--- /dev/null
+++ b/tests/jobs/t300_reload.ml.expected
@@ -0,0 +1,4 @@
+1 job$1 1
+2 job$2 2 A
+3 job$1 3
+4 job$3 4 B

diff --git a/tests/jobs/test_run.sh b/tests/jobs/test_run.sh
index ad2bcde..f99e7f9 100755 (executable)
--- a/tests/jobs/test_run.sh
+++ b/tests/jobs/test_run.sh
@@ -25,6 +25,8 @@ libdir=$(cd ../../lib; pwd)
 toolsdir=$(cd ../../tools; pwd)
 daemondir=$(cd ../../daemon; pwd)
 
 toolsdir=$(cd ../../tools; pwd)
 daemondir=$(cd ../../daemon; pwd)
 

+export libdir
+

 HOME="$testdir"
 export HOME
 
 HOME="$testdir"
 export HOME
 

diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml
index a9ae7b7..440d425 100644 (file)
--- a/tools/whenjobs.ml
+++ b/tools/whenjobs.ml
@@ -307,22 +307,28 @@ and list_file () =
   close_in chan
 
 and upload_file () =
   close_in chan
 
 and upload_file () =

+  let suffix = if not Config.have_ocamlopt then "cmo" else "cmx" in
+

   (* Recompile the jobs file(s). *)
   let files = get_multijobs_filenames () 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 *)
   List.iter (
     fun file ->
       let cmd =
         if not Config.have_ocamlopt then
           (* bytecode *)

-          sprintf "%s c -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s"
-            Config.ocamlfind !libdir !libdir file
-        else (
+          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 *)
           (* native code *)

-          let base = Filename.chop_extension file in (* without .ml suffix *)
-          sprintf "%s opt -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s &&\n%s opt -shared -linkall %s.cmx -o %s.cmxs"
-            Config.ocamlfind !libdir !libdir file
-            Config.ocamlfind base base
-        ) in
+          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;
       if Sys.command cmd <> 0 then (
         eprintf "whenjobs: %s: could not compile jobs script, see earlier errors\n"
           file;


@@ -331,24 +337,46 @@ and upload_file () =
       )
   ) files;
 
       )
   ) files;
 

-  let suffix = if not Dynlink.is_native then "cmo" else "cmxs" in
+  (* 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 pack jobs script, see earlier errors\n";
+    eprintf "compile command was:\n%s\n" cmd;
+    exit 1
+  );

 
 

-  let compiled_files = List.map (
-    fun file ->
-      let n = String.length file in
-      if n < 4 then assert false;
-      sprintf "%s.%s" (String.sub file 0 (n-3)) suffix
-  ) files in
+  (* 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;
 
   (* Test-load the jobs files to ensure they make sense. *)
   Whenfile.init Whenstate.empty;

-  (try
-     List.iter Dynlink.loadfile compiled_files
+  (try Dynlink.loadfile filename

    with
      Dynlink.Error err ->
        eprintf "whenjobs: dynlink: %s\n" (Dynlink.error_message err);
    with
      Dynlink.Error err ->
        eprintf "whenjobs: dynlink: %s\n" (Dynlink.error_message err);

-       (* Since it failed, unlink the compiled files. *)
-       List.iter (fun f -> try unlink f with Unix_error _ -> ()) compiled_files;
+       (* Since it failed, unlink the compiled file. *)
+       (try unlink filename with Unix_error _ -> ());

        exit 1
   );
 
        exit 1
   );
 

diff --git a/tools/whenjobs.pod b/tools/whenjobs.pod
index 1f38d29..acc1d94 100644 (file)
--- a/tools/whenjobs.pod
+++ b/tools/whenjobs.pod
@@ -865,10 +865,7 @@ fields:
 =head1 MULTIPLE JOBS FILES
 
 The whenjobs I<-e> and I<-l> options edit and list a file called
 =head1 MULTIPLE JOBS FILES
 
 The whenjobs I<-e> and I<-l> options edit and list a file called

-C<$HOME/.whenjobs/jobs.ml>.  This is an OCaml source file which is
-compiled behind the scenes into a bytecode file called
-C<$HOME/.whenjobs/jobs.cmo>.  C<jobs.cmo> is what the daemon normally
-loads.
+C<$HOME/.whenjobs/jobs.ml>.

 
 You can also edit C<$HOME/.whenjobs/jobs.ml> by other means (eg.  your
 own editor).  After editing, to recompile and upload it, use:
 
 You can also edit C<$HOME/.whenjobs/jobs.ml> by other means (eg.  your
 own editor).  After editing, to recompile and upload it, use:


@@ -878,8 +875,7 @@ own editor).  After editing, to recompile and upload it, use:
 When you have lots of jobs, it is convenient to split the jobs across
 multiple files.  Any C<*.ml> files located in C<$HOME/.whenjobs> can
 be used (with some restrictions on filenames -- see below).  These are
 When you have lots of jobs, it is convenient to split the jobs across
 multiple files.  Any C<*.ml> files located in C<$HOME/.whenjobs> can
 be used (with some restrictions on filenames -- see below).  These are

-compiled to the corresponding C<*.cmo> files and loaded into the
-daemon using the I<--upload> command.
+compiled and loaded into the daemon using the I<--upload> command.

 
 To create multiple jobs files, you cannot use the I<-e> or I<-l>
 options.  Instead you have to create them yourself in
 
 To create multiple jobs files, you cannot use the I<-e> or I<-l>
 options.  Instead you have to create them yourself in