From aa3b139e751349542d190607ea707897ede1f1a6 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 26 Jul 2011 19:05:40 +0100
Subject: [PATCH] Add upstream patch to fix segfault in OCaml bindings.

---
 ...ocaml-Fix-locking-in-event-callbacks.patch | 79 +++++++++++++++++++
 libguestfs.spec                               |  9 ++-
 2 files changed, 86 insertions(+), 2 deletions(-)
 create mode 100644 0001-ocaml-Fix-locking-in-event-callbacks.patch

diff --git a/0001-ocaml-Fix-locking-in-event-callbacks.patch b/0001-ocaml-Fix-locking-in-event-callbacks.patch
new file mode 100644
index 0000000..4ae9311
--- /dev/null
+++ b/0001-ocaml-Fix-locking-in-event-callbacks.patch
@@ -0,0 +1,79 @@
+From 2b8b3f9794ceb43eabd3083e225c669896d8b186 Mon Sep 17 00:00:00 2001
+From: "Richard W.M. Jones" <rjones@redhat.com>
+Date: Tue, 26 Jul 2011 18:57:19 +0100
+Subject: [PATCH] ocaml: Fix locking in event callbacks.
+
+We weren't acquiring the GC lock around some allocations, resulting in
+segfaults when an event callback ran at the same time as a main thread
+allocation or garbage collection.
+
+In particular this fixes a noticable crash in guestfs-browser.
+---
+ ocaml/guestfs_c.c |   36 +++++++++++++++++++++++++++---------
+ 1 files changed, 27 insertions(+), 9 deletions(-)
+
+diff --git a/ocaml/guestfs_c.c b/ocaml/guestfs_c.c
+index 3f862ea..96e8a35 100644
+--- a/ocaml/guestfs_c.c
++++ b/ocaml/guestfs_c.c
+@@ -327,13 +327,13 @@ event_bitmask_to_event (uint64_t event)
+ }
+ 
+ static void
+-event_callback_wrapper (guestfs_h *g,
+-                        void *data,
+-                        uint64_t event,
+-                        int event_handle,
+-                        int flags,
+-                        const char *buf, size_t buf_len,
+-                        const uint64_t *array, size_t array_len)
++event_callback_wrapper_locked (guestfs_h *g,
++                               void *data,
++                               uint64_t event,
++                               int event_handle,
++                               int flags,
++                               const char *buf, size_t buf_len,
++                               const uint64_t *array, size_t array_len)
+ {
+   CAMLparam0 ();
+   CAMLlocal5 (gv, evv, ehv, bufv, arrayv);
+@@ -360,9 +360,7 @@ event_callback_wrapper (guestfs_h *g,
+ 
+   value args[5] = { gv, evv, ehv, bufv, arrayv };
+ 
+-  caml_leave_blocking_section ();
+   rv = caml_callbackN_exn (*(value*)data, 5, args);
+-  caml_enter_blocking_section ();
+ 
+   /* Callbacks shouldn't throw exceptions.  There's not much we can do
+    * except to print it.
+@@ -375,6 +373,26 @@ event_callback_wrapper (guestfs_h *g,
+   CAMLreturn0;
+ }
+ 
++static void
++event_callback_wrapper (guestfs_h *g,
++                        void *data,
++                        uint64_t event,
++                        int event_handle,
++                        int flags,
++                        const char *buf, size_t buf_len,
++                        const uint64_t *array, size_t array_len)
++{
++  /* Ensure we are holding the GC lock before any GC operations are
++   * possible. (RHBZ#725824)
++   */
++  caml_leave_blocking_section ();
++
++  event_callback_wrapper_locked (g, data, event, event_handle, flags,
++                                 buf, buf_len, array, array_len);
++
++  caml_enter_blocking_section ();
++}
++
+ value
+ ocaml_guestfs_last_errno (value gv)
+ {
+-- 
+1.7.5.2
+
diff --git a/libguestfs.spec b/libguestfs.spec
index 3eb8917..cf512ba 100644
--- a/libguestfs.spec
+++ b/libguestfs.spec
@@ -30,7 +30,7 @@ Summary:       Access and modify virtual machine disk images
 Name:          libguestfs
 Epoch:         1
 Version:       1.12.1
-Release:       3%{?dist}
+Release:       4%{?dist}
 License:       LGPLv2+
 Group:         Development/Libraries
 URL:           http://libguestfs.org/
@@ -48,6 +48,9 @@ Patch2:        libguestfs-1.12.0-configure-force-machine-accel-tcg.patch
 # option so that this patch would not be needed.
 Patch3:        0001-Fix-qemu-machine-option-for-latest-qemu-thanks-Marku.patch
 
+# Upstream patch to fix segfault in OCaml bindings.
+Patch4:        0001-ocaml-Fix-locking-in-event-callbacks.patch
+
 # Basic build requirements:
 BuildRequires: /usr/bin/pod2man
 BuildRequires: /usr/bin/pod2text
@@ -501,6 +504,7 @@ for %{name}.
 %patch0 -p1
 %patch2 -p1
 %patch3 -p1
+%patch4 -p1
 
 mkdir -p daemon/m4
 
@@ -866,10 +870,11 @@ rm -rf $RPM_BUILD_ROOT
 
 
 %changelog
-* Tue Jul 26 2011 Richard W.M. Jones <rjones@redhat.com> - 1:1.12.1-3
+* Tue Jul 26 2011 Richard W.M. Jones <rjones@redhat.com> - 1:1.12.1-4
 - New upstream stable branch version 1.12.1.
 - Remove 5 x upstream patches.
 - Add non-upstream patch to deal with broken qemu -machine option.
+- Add upstream patch to fix segfault in OCaml bindings.
 
 * Tue Jul 26 2011 Richard W.M. Jones <rjones@redhat.com> - 1:1.12.0-11
 - Bump and rebuild.