diff options
author | Richard Jones <rjones@redhat.com> | 2010-06-16 15:25:45 +0100 |
---|---|---|
committer | Richard Jones <rjones@redhat.com> | 2010-06-16 15:32:20 +0100 |
commit | 1079f74704a06c06996e547fdecf20a8f92799c6 (patch) | |
tree | 32b272a9b86952f06f8565526c1fe5d8cf09bee7 /ocaml | |
parent | 1e568f057e8bb7b36cc14e0e531d74b75ad9cb6c (diff) | |
download | libguestfs-1079f74704a06c06996e547fdecf20a8f92799c6.tar.gz libguestfs-1079f74704a06c06996e547fdecf20a8f92799c6.tar.xz libguestfs-1079f74704a06c06996e547fdecf20a8f92799c6.zip |
ocaml: Fix thread safety of strings in bindings (RHBZ#604691).
There's a thread safety issue with the current OCaml bindings which
is well explained in the bug report:
https://bugzilla.redhat.com/show_bug.cgi?id=604691
This commit fixes the safety issue by copying strings temporarily
before releasing the thread lock. Updated code looks like this:
char *filename = guestfs_safe_strdup (g, String_val (filenamev));
int r;
caml_enter_blocking_section ();
r = guestfs_add_drive_ro (g, filename);
caml_leave_blocking_section ();
free (filename);
if (r == -1)
ocaml_guestfs_raise_error (g, "add_drive_ro");
Also included is a regression test.
Diffstat (limited to 'ocaml')
-rw-r--r-- | ocaml/Makefile.am | 11 | ||||
-rw-r--r-- | ocaml/guestfs_c.c | 15 | ||||
-rw-r--r-- | ocaml/guestfs_c.h | 2 | ||||
-rw-r--r-- | ocaml/t/guestfs_070_threads.ml | 72 |
4 files changed, 89 insertions, 11 deletions
diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am index 38238f69..99bb390f 100644 --- a/ocaml/Makefile.am +++ b/ocaml/Makefile.am @@ -67,10 +67,10 @@ TESTS_ENVIRONMENT = \ TESTS = run-bindtests \ t/guestfs_005_load t/guestfs_010_launch t/guestfs_050_lvcreate \ - t/guestfs_060_readdir t/guestfs_500_inspect + t/guestfs_060_readdir t/guestfs_070_threads t/guestfs_500_inspect noinst_DATA += bindtests \ t/guestfs_005_load t/guestfs_010_launch t/guestfs_050_lvcreate \ - t/guestfs_060_readdir t/guestfs_500_inspect + t/guestfs_060_readdir t/guestfs_070_threads t/guestfs_500_inspect bindtests: bindtests.cmx mlguestfs.cmxa mkdir -p t @@ -92,12 +92,19 @@ t/guestfs_060_readdir: t/guestfs_060_readdir.cmx mlguestfs.cmxa mkdir -p t $(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/src/.libs -I . -package xml-light,unix -linkpkg mlguestfs.cmxa $< -o $@ +t/guestfs_070_threads: t/guestfs_070_threads.cmx mlguestfs.cmxa + mkdir -p t + $(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/src/.libs -I . -package unix,threads -thread -linkpkg mlguestfs.cmxa $< -o $@ + t/guestfs_500_inspect: t/guestfs_500_inspect.cmx mlguestfs.cmxa mkdir -p t $(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/src/.libs -I . -package xml-light,unix -linkpkg mlguestfs.cmxa $< -o $@ # Need to rebuild the tests from source if the main library has # changed at all, otherwise we get inconsistent assumptions. +t/guestfs_070_threads.cmx: t/guestfs_070_threads.ml mlguestfs.cmxa + $(OCAMLFIND) ocamlopt -package unix,threads -thread -linkpkg -c $< -o $@ + t/%.cmx: t/%.ml mlguestfs.cmxa $(OCAMLFIND) ocamlopt -package xml-light,unix -linkpkg -c $< -o $@ diff --git a/ocaml/guestfs_c.c b/ocaml/guestfs_c.c index f7d8dff8..71f416ab 100644 --- a/ocaml/guestfs_c.c +++ b/ocaml/guestfs_c.c @@ -136,11 +136,7 @@ ocaml_guestfs_close (value gv) CAMLreturn (Val_unit); } -/* Copy string array value. - * The return value is only 'safe' provided we don't allocate anything - * further on the OCaml heap (ie. cannot trigger the OCaml GC) because - * that could move the strings around. - */ +/* Copy string array value. */ char ** ocaml_guestfs_strings_val (guestfs_h *g, value sv) { @@ -150,7 +146,7 @@ ocaml_guestfs_strings_val (guestfs_h *g, value sv) r = guestfs_safe_malloc (g, sizeof (char *) * (Wosize_val (sv) + 1)); for (i = 0; i < Wosize_val (sv); ++i) - r[i] = String_val (Field (sv, i)); + r[i] = guestfs_safe_strdup (g, String_val (Field (sv, i))); r[i] = NULL; CAMLreturnT (char **, r); @@ -160,8 +156,9 @@ ocaml_guestfs_strings_val (guestfs_h *g, value sv) void ocaml_guestfs_free_strings (char **argv) { - /* Don't free the actual strings - they are String_vals on - * the OCaml heap. - */ + unsigned int i; + + for (i = 0; argv[i] != NULL; ++i) + free (argv[i]); free (argv); } diff --git a/ocaml/guestfs_c.h b/ocaml/guestfs_c.h index cd1d73b1..29da0532 100644 --- a/ocaml/guestfs_c.h +++ b/ocaml/guestfs_c.h @@ -19,6 +19,8 @@ #ifndef GUESTFS_OCAML_C_H #define GUESTFS_OCAML_C_H +#include "guestfs-internal.h" + #define Guestfs_val(v) (*((guestfs_h **)Data_custom_val(v))) extern void ocaml_guestfs_raise_error (guestfs_h *g, const char *func) Noreturn; diff --git a/ocaml/t/guestfs_070_threads.ml b/ocaml/t/guestfs_070_threads.ml new file mode 100644 index 00000000..e13ac7b6 --- /dev/null +++ b/ocaml/t/guestfs_070_threads.ml @@ -0,0 +1,72 @@ +(* libguestfs OCaml bindings + * Copyright (C) 2010 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., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +open Unix + +(* Start a background thread which does lots of allocation and + * GC activity. + *) +let thread = Thread.create ( + fun () -> + while true do + Gc.compact (); + ignore (Array.init 1000 (fun i -> Thread.yield (); String.create (8*i))) + done +) () + +let () = + let g = Guestfs.create () in + + let fd = openfile "test.img" [O_WRONLY;O_CREAT;O_NOCTTY;O_TRUNC] 0o666 in + ftruncate fd (500 * 1024 * 1024); + close fd; + + (* Copy these strings so they're located on the heap and + * subject to garbage collection. + *) + let s = String.copy "test.img" in + Guestfs.add_drive_ro g s; + Guestfs.launch g; + + let dev = String.copy "/dev/sda" in + Guestfs.pvcreate g dev; + let vg = String.copy "VG" in + Guestfs.vgcreate g vg [|dev|]; + let s = String.copy "LV1" in + Guestfs.lvcreate g s vg 200; + let s = String.copy "LV2" in + Guestfs.lvcreate g s vg 200; + + let lvs = Guestfs.lvs g in + if lvs <> [|"/dev/VG/LV1"; "/dev/VG/LV2"|] then + failwith "Guestfs.lvs returned incorrect result"; + + let s = String.copy "ext3" in + let lv = String.copy "/dev/VG/LV1" in + Guestfs.mkfs g s lv; + let s = String.copy "/" in + Guestfs.mount_options g "" lv s; + let s = String.copy "/test" in + Guestfs.touch g s; + + Guestfs.umount_all g; + Guestfs.sync g; + Guestfs.close g; + unlink "test.img"; + Gc.compact (); + exit 0 |