[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]

[Libguestfs] [PATCH 2/2] Add test of parallel mount-local calls.



From: "Richard W.M. Jones" <rjones redhat com>

---
 .gitignore                                  |    2 +
 ocaml/Makefile.am                           |   25 +++-
 ocaml/t/exit.c                              |   44 +++++++
 ocaml/t/guestfs_500_parallel_mount_local.ml |  189 +++++++++++++++++++++++++++
 po/POTFILES.in                              |    1 +
 5 files changed, 259 insertions(+), 2 deletions(-)
 create mode 100644 ocaml/t/exit.c
 create mode 100644 ocaml/t/guestfs_500_parallel_mount_local.ml

diff --git a/.gitignore b/.gitignore
index e33f718..31cdc3e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -236,6 +236,8 @@ ocaml/t/guestfs_400_events.bc
 ocaml/t/guestfs_400_events.opt
 ocaml/t/guestfs_400_progress.bc
 ocaml/t/guestfs_400_progress.opt
+ocaml/t/guestfs_500_parallel_mount_local.bc
+ocaml/t/guestfs_500_parallel_mount_local.opt
 *.orig
 *.patch
 perl/bindtests.pl
diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am
index c313532..8c742a2 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 0000000..ca392de
--- /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 0000000..6cb2b91
--- /dev/null
+++ b/ocaml/t/guestfs_500_parallel_mount_local.ml
@@ -0,0 +1,189 @@
+(* 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"
+
+let nr_threads = 2
+let total_time = 60.                 (* seconds, excluding launch *)
+let debug = true                     (* overview debugging messages *)
+
+let rec main () =
+  Random.self_init ();
+
+  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" "/";
+
+  let test_pid = ref 0 in
+  ignore (g#set_event_callback (mounted test_pid) [Guestfs.EVENT_MOUNTED]);
+
+  (* Randomly mount the filesystem and repeat.  Keep going until we
+   * finish the test.  The interesting stuff is happening in the
+   * 'mounted' event callback.
+   *)
+  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;
+      test_pid := 0;
+      g#mount_local mp;
+      assert (!test_pid <> 0); (* mounted callback should have been called *)
+      let _, status = waitpid [] !test_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 callback is called when the filesystem at 'mp' is mounted and
+ * ready to use.  We cannot run tests directly here, but must run them
+ * from another process.  We cannot just fork and run the tests because
+ * that's not signal-safe, so we must fork and immediately exec a
+ * separate test program.
+ *)
+and mounted return_pid _ _ _ mp _ =
+  let args = [| Sys.executable_name; "--test"; mp |] in
+  let pid = fork () in
+  if pid <> 0 then			(* parent *)
+    return_pid := pid
+  else (				(* child *)
+    try execv Sys.executable_name args
+    with exn -> prerr_endline (Printexc.to_string exn); _exit 1
+  )
+
+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
diff --git a/po/POTFILES.in b/po/POTFILES.in
index 1f0bb36..5df8b93 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -135,6 +135,7 @@ inspector/virt-inspector.c
 java/com_redhat_et_libguestfs_GuestFS.c
 ocaml/guestfs_c.c
 ocaml/guestfs_c_actions.c
+ocaml/t/exit.c
 perl/Guestfs.c
 perl/bindtests.pl
 perl/lib/Sys/Guestfs.pm
-- 
1.7.9.3


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]