Add test of parallel mount-local calls.

3 files changed, 264 insertions, 2 deletions

diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am
index c3135329..8c742a22 100644
--- a/ocaml/Makefile.am
+++ b/ocaml/Makefile.am
@@ -30,6 +30,7 @@ EXTRA_DIST = \
 	html/.gitignore \
 	META.in \
 	run-bindtests \
+	t/exit.c \
 	t/*.ml
 
 CLEANFILES = *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so
@@ -87,7 +88,8 @@ if ENABLE_APPLIANCE
 test_progs += \
 	t/guestfs_010_basic \
 	t/guestfs_070_threads \
-	t/guestfs_400_progress
+	t/guestfs_400_progress \
+	t/guestfs_500_parallel_mount_local
 endif
 
 TESTS = run-bindtests \
@@ -163,13 +165,32 @@ t/guestfs_400_progress.opt: t/guestfs_400_progress.cmx mlguestfs.cmxa
 	mkdir -p t
 	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
 
-# Explicit rules for this test which requires 'threads' package.
+t/guestfs_500_parallel_mount_local.bc: t/guestfs_500_parallel_mount_local.cmo mlguestfs.cma libocamltestlib.a
+	mkdir -p t
+	LD_LIBRARY_PATH=../src/.libs \
+	$(OCAMLFIND) ocamlc -custom $(OCAMLCFLAGS) -I . -package unix,threads -thread -linkpkg mlguestfs.cma libocamltestlib.a $< -o $@
+
+t/guestfs_500_parallel_mount_local.opt: t/guestfs_500_parallel_mount_local.cmx mlguestfs.cmxa libocamltestlib.a
+	mkdir -p t
+	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix,threads -thread -linkpkg mlguestfs.cmxa libocamltestlib.a $< -o $@
+
+# Explicit rules for these tests which require 'threads' package.
 t/guestfs_070_threads.cmo: t/guestfs_070_threads.ml mlguestfs.cma
 	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
 
 t/guestfs_070_threads.cmx: t/guestfs_070_threads.ml mlguestfs.cmxa
 	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
 
+t/guestfs_500_parallel_mount_local.cmo: t/guestfs_500_parallel_mount_local.ml mlguestfs.cma
+	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
+
+t/guestfs_500_parallel_mount_local.cmx: t/guestfs_500_parallel_mount_local.ml mlguestfs.cmxa
+	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
+
+noinst_LIBRARIES += libocamltestlib.a
+libocamltestlib_a_SOURCES = t/exit.c
+libocamltestlib_a_CFLAGS = $(libguestfsocaml_a_CFLAGS)
+
 %.cmi: %.mli
 	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -package unix -c $< -o $(builddir)/$@
 %.cmo: %.ml mlguestfs.cma
diff --git a/ocaml/t/exit.c b/ocaml/t/exit.c
new file mode 100644
index 00000000..ca392def
--- /dev/null
+++ b/ocaml/t/exit.c
@@ -0,0 +1,44 @@
+/* libguestfs OCaml bindings
+ * 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.
+ */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/misc.h>
+#include <caml/mlvalues.h>
+
+value ocaml_guestfs__exit (value) Noreturn;
+
+/* _exit : int -> 'a (does not return) */
+value
+ocaml_guestfs__exit (value statusv)
+{
+  CAMLparam1 (statusv);
+  int status = Int_val (statusv);
+
+  _exit (status);
+
+  /*NOTREACHED*/
+  CAMLnoreturn;
+}
diff --git a/ocaml/t/guestfs_500_parallel_mount_local.ml b/ocaml/t/guestfs_500_parallel_mount_local.ml
new file mode 100644
index 00000000..974c8cc9
--- /dev/null
+++ b/ocaml/t/guestfs_500_parallel_mount_local.ml
@@ -0,0 +1,197 @@
+(* libguestfs OCaml bindings
+ * 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 guestfs_mount_local, from a higher level language (it will
+ * mostly be used first from Python), in parallel threads.  OCaml
+ * allows us to test this at a reasonable speed.
+ *)
+
+open Unix
+open Printf
+
+let (//) = Filename.concat
+
+(* See [exit.c]. *)
+external _exit : int -> 'a = "ocaml_guestfs__exit"
+
+(* Some settings. *)
+let total_time = 60.                 (* seconds, excluding launch *)
+let debug = true                     (* overview debugging messages *)
+let min_threads = 2
+let mbytes_per_thread = 900
+
+let rec main () =
+  Random.self_init ();
+
+  (* Choose the number of threads based on the amount of free memory. *)
+  let nr_threads =
+    let mbytes =
+      let cmd = "LANG=C free -m | grep 'buffers/cache' | awk '{print $NF}'" in
+      let chan = open_process_in cmd in
+      let mbytes = input_line chan in
+      match close_process_in chan with
+      | WEXITED 0 -> Some (int_of_string mbytes)
+      | _ -> None in
+    match mbytes with
+    | None -> min_threads (* default *)
+    | Some mbytes -> max min_threads (mbytes / mbytes_per_thread) in
+
+  let threads = ref [] in
+  for i = 1 to nr_threads do
+    let filename = sprintf "test%d.img" i in
+    let mp = sprintf "mp%d" i in
+    (try rmdir mp with Unix_error _ -> ());
+    mkdir mp 0o700;
+
+    if debug then eprintf "%s : starting thread\n%!" mp;
+    let t = Thread.create start_thread (filename, mp) in
+    threads := (t, filename, mp) :: !threads
+  done;
+
+  (* Wait until the threads terminate and delete the files and mountpoints. *)
+  List.iter (
+    fun (t, filename, mp) ->
+      Thread.join t;
+
+      if debug then eprintf "%s : cleaning up thread\n%!" mp;
+      unlink filename;
+      rmdir mp
+  ) !threads;
+
+  Gc.compact ()
+
+and start_thread (filename, mp) =
+  (* Create a filesystem for the tests. *)
+  let g = new Guestfs.guestfs () in
+
+  let fd = openfile filename [O_WRONLY;O_CREAT;O_NOCTTY;O_TRUNC] 0o666 in
+  ftruncate fd (500 * 1024 * 1024);
+  close fd;
+
+  g#add_drive_opts filename;
+  g#launch ();
+
+  g#part_disk "/dev/sda" "mbr";
+  g#mkfs "ext2" "/dev/sda1";
+  g#mount "/dev/sda1" "/";
+
+  (* Randomly mount the filesystem and repeat.  Keep going until we
+   * finish the test.
+   *)
+  let start_t = time () in
+  let rec loop () =
+    let t = time () in
+    if t -. start_t < total_time then (
+      if debug then eprintf "%s < mounting filesystem\n%!" mp;
+      g#mount_local mp;
+
+      (* Run test in an exec'd subprocess. *)
+      let args = [| Sys.executable_name; "--test"; mp |] in
+      let pid = fork () in
+      if pid = 0 then (			(* child *)
+        try execv Sys.executable_name args
+        with exn -> prerr_endline (Printexc.to_string exn); _exit 1
+      );
+
+      (* Run FUSE main loop.  This processes requests until the
+       * subprocess unmounts the filesystem.
+       *)
+      g#mount_local_run ();
+
+      let _, status = waitpid [] pid in
+      (match status with
+       | WEXITED 0 -> ()
+       | WEXITED i ->
+           eprintf "test subprocess failed (exit code %d)\n" i;
+           exit 1
+       | WSIGNALED i | WSTOPPED i ->
+           eprintf "test subprocess signaled/stopped (signal %d)\n" i;
+           exit 1
+      );
+      loop ()
+    )
+  in
+  loop ();
+
+  g#close ()
+
+(* This is run in a child program. *)
+and test_mountpoint mp =
+  if debug then eprintf "%s | testing filesystem\n%!" mp;
+
+  (* Run through the same set of tests repeatedly a number of times.
+   * The aim of this stress test is repeated mount/unmount, not testing
+   * FUSE itself, so we don't do much here.
+   *)
+  for pass = 0 to Random.int 32 do
+    mkdir (mp // "tmp.d") 0o700;
+    let chan = open_out (mp // "file") in
+    let s = String.make (Random.int (128 * 1024)) (Char.chr (Random.int 256)) in
+    output_string chan s;
+    close_out chan;
+    rename (mp // "tmp.d") (mp // "newdir");
+    link (mp // "file") (mp // "newfile");
+    if Random.int 32 = 0 then sleep 1;
+    rmdir (mp // "newdir");
+    unlink (mp // "file");
+    unlink (mp // "newfile")
+  done;
+
+  if debug then eprintf "%s > unmounting filesystem\n%!" mp;
+
+  unmount mp
+
+(* We may need to retry this a few times because of processes which
+ * run in the background jumping into mountpoints.  Only display
+ * errors if it still fails after many retries.
+ *)
+and unmount mp =
+  let logfile = sprintf "%s.fusermount.log" mp in
+  let unlink_logfile () =
+    try unlink logfile with Unix_error _ -> ()
+  in
+  unlink_logfile ();
+
+  let run_command () =
+    Sys.command (sprintf "fusermount -u %s >> %s 2>&1"
+                   (Filename.quote mp) (Filename.quote logfile)) = 0
+  in
+
+  let rec loop tries =
+    if tries <= 5 then (
+      if not (run_command ()) then (
+        sleep 1;
+        loop (tries+1)
+      )
+    ) else (
+      ignore (Sys.command (sprintf "cat %s" (Filename.quote logfile)));
+      eprintf "fusermount: %s: failed, see earlier error messages\n" mp;
+      exit 1
+    )
+  in
+  loop 0;
+
+  unlink_logfile ()
+
+let () =
+  match Array.to_list Sys.argv with
+  | [ _; "--test"; mp ] -> test_mountpoint mp
+  | [ _ ] -> main ()
+  | _ ->
+    eprintf "%s: unknown arguments given to program\n" Sys.executable_name;
+    exit 1