daemon/gnulib: Include glob module.
[libguestfs.git] / src / generator.ml
old mode 100644 (file)
new mode 100755 (executable)
index c261ea2..a1d3549
@@ -35,6 +35,7 @@
 #load "unix.cma";;
 #load "str.cma";;
 
+open Unix
 open Printf
 
 type style = ret * args
@@ -346,13 +347,13 @@ and cmd = string list
 
 (* Generate a random UUID (used in tests). *)
 let uuidgen () =
-  let chan = Unix.open_process_in "uuidgen" in
+  let chan = open_process_in "uuidgen" in
   let uuid = input_line chan in
-  (match Unix.close_process_in chan with
-   | Unix.WEXITED 0 -> ()
-   | Unix.WEXITED _ ->
+  (match close_process_in chan with
+   | WEXITED 0 -> ()
+   | WEXITED _ ->
        failwith "uuidgen: process exited with non-zero status"
-   | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+   | WSIGNALED _ | WSTOPPED _ ->
        failwith "uuidgen: process signalled or stopped by signal"
   );
   uuid
@@ -4696,7 +4697,7 @@ let check_functions () =
   ) all_functions
 
 (* 'pr' prints to the current output file. *)
-let chan = ref stdout
+let chan = ref Pervasives.stdout
 let pr fs = ksprintf (output_string !chan) fs
 
 (* Generate a header block in a number of standard styles. *)
@@ -8650,7 +8651,7 @@ and pod2text ~width name longdesc =
     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
     close_out chan;
     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
-    let chan = Unix.open_process_in cmd in
+    let chan = open_process_in cmd in
     let lines = ref [] in
     let rec loop i =
       let line = input_line chan in
@@ -8662,12 +8663,12 @@ and pod2text ~width name longdesc =
         loop (i+1)
       ) in
     let lines = try loop 1 with End_of_file -> List.rev !lines in
-    Unix.unlink filename;
-    (match Unix.close_process_in chan with
-     | Unix.WEXITED 0 -> ()
-     | Unix.WEXITED i ->
+    unlink filename;
+    (match close_process_in chan with
+     | WEXITED 0 -> ()
+     | WEXITED i ->
          failwithf "pod2text: process exited with non-zero status (%d)" i
-     | Unix.WSIGNALED i | Unix.WSTOPPED i ->
+     | WSIGNALED i | WSTOPPED i ->
          failwithf "pod2text: process signalled or stopped by signal %d" i
     );
     Hashtbl.add pod2text_memo key lines;
@@ -10161,33 +10162,54 @@ let output_to filename =
   chan := open_out filename_new;
   let close () =
     close_out !chan;
-    chan := stdout;
+    chan := Pervasives.stdout;
 
     (* Is the new file different from the current file? *)
     if Sys.file_exists filename && files_equal filename filename_new then
-      Unix.unlink filename_new         (* same, so skip it *)
+      unlink filename_new              (* same, so skip it *)
     else (
       (* different, overwrite old one *)
-      (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
-      Unix.rename filename_new filename;
-      Unix.chmod filename 0o444;
+      (try chmod filename 0o644 with Unix_error _ -> ());
+      rename filename_new filename;
+      chmod filename 0o444;
       printf "written %s\n%!" filename;
     )
   in
   close
 
+let perror msg = function
+  | Unix_error (err, _, _) ->
+      eprintf "%s: %s\n" msg (error_message err)
+  | exn ->
+      eprintf "%s: %s\n" msg (Printexc.to_string exn)
+
 (* Main program. *)
 let () =
-  check_functions ();
-
-  if not (Sys.file_exists "HACKING") then (
-    eprintf "\
+  let lock_fd =
+    try openfile "HACKING" [O_RDWR] 0
+    with
+    | Unix_error (ENOENT, _, _) ->
+        eprintf "\
 You are probably running this from the wrong directory.
 Run it from the top source directory using the command
   src/generator.ml
 ";
-    exit 1
-  );
+        exit 1
+    | exn ->
+        perror "open: HACKING" exn;
+        exit 1 in
+
+  (* Acquire a lock so parallel builds won't try to run the generator
+   * twice at the same time.  Subsequent builds will wait for the first
+   * one to finish.  Note the lock is released implicitly when the
+   * program exits.
+   *)
+  (try lockf lock_fd F_LOCK 1
+   with exn ->
+     perror "lock: HACKING" exn;
+     exit 1);
+
+  check_functions ();
 
   let close = output_to "src/guestfs_protocol.x" in
   generate_xdr ();