[Libguestfs] [PATCH 2/4] builder: add simple libyajl binding

Pino Toscano ptoscano at redhat.com
Mon Sep 7 14:38:04 UTC 2015


Only yajl_val and yajl_tree_parse are exposed for now.
---
 .gitignore            |   2 +
 builder/Makefile.am   |  45 ++++++++++++++--
 builder/yajl-c.c      | 143 ++++++++++++++++++++++++++++++++++++++++++++++++++
 builder/yajl.ml       |  30 +++++++++++
 builder/yajl.mli      |  33 ++++++++++++
 builder/yajl_tests.ml | 139 ++++++++++++++++++++++++++++++++++++++++++++++++
 po/POTFILES           |   1 +
 po/POTFILES-ml        |   2 +
 8 files changed, 391 insertions(+), 4 deletions(-)
 create mode 100644 builder/yajl-c.c
 create mode 100644 builder/yajl.ml
 create mode 100644 builder/yajl.mli
 create mode 100644 builder/yajl_tests.ml

diff --git a/.gitignore b/.gitignore
index e502018..db8d0a2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -60,6 +60,7 @@ Makefile.in
 /builder/index-parse.h
 /builder/index-scan.c
 /builder/libguestfs.conf
+/builder/oUnit-*
 /builder/*.qcow2
 /builder/stamp-virt-builder.pod
 /builder/stamp-virt-index-validate.pod
@@ -70,6 +71,7 @@ Makefile.in
 /builder/virt-index-validate
 /builder/virt-index-validate.1
 /builder/*.xz
+/builder/yajl_tests
 /cat/stamp-virt-*.pod
 /cat/virt-cat
 /cat/virt-cat.1
diff --git a/builder/Makefile.am b/builder/Makefile.am
index f48efb0..366b8db 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -32,7 +32,8 @@ EXTRA_DIST = \
 	test-virt-index-validate-good-2 \
 	test-virt-index-validate-good-3 \
 	virt-builder.pod \
-	virt-index-validate.pod
+	virt-index-validate.pod \
+	yajl_tests.ml
 
 CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o virt-builder
 
@@ -48,7 +49,8 @@ SOURCES_MLI = \
 	pxzcat.mli \
 	setlocale.mli \
 	sigchecker.mli \
-	sources.mli
+	sources.mli \
+	yajl.mli
 
 SOURCES_ML = \
 	utils.ml \
@@ -57,6 +59,7 @@ SOURCES_ML = \
 	checksums.ml \
 	index.ml \
 	ini_reader.ml \
+	yajl.ml \
 	paths.ml \
 	languages.ml \
 	cache.ml \
@@ -81,7 +84,8 @@ SOURCES_C = \
 	index-parse.c \
 	index-parser-c.c \
 	pxzcat-c.c \
-	setlocale-c.c
+	setlocale-c.c \
+	yajl-c.c
 
 man_MANS =
 noinst_DATA =
@@ -106,7 +110,8 @@ virt_builder_CFLAGS = \
 	-Wno-unused-macros \
 	$(LIBLZMA_CFLAGS) \
 	$(LIBTINFO_CFLAGS) \
-	$(LIBXML2_CFLAGS)
+	$(LIBXML2_CFLAGS) \
+	$(YAJL_CFLAGS)
 
 BOBJECTS = \
 	$(top_builddir)/mllib/libdir.cmo \
@@ -145,9 +150,13 @@ OCAMLPACKAGES = \
 	-I $(top_builddir)/ocaml \
 	-I $(top_builddir)/mllib \
 	-I $(top_builddir)/customize
+OCAMLPACKAGES_TESTS =
 if HAVE_OCAML_PKG_GETTEXT
 OCAMLPACKAGES += -package gettext-stub
 endif
+if HAVE_OCAML_PKG_OUNIT
+OCAMLPACKAGES_TESTS += -package oUnit
+endif
 
 OCAMLCLIBS = \
 	-pthread -lpthread \
@@ -156,6 +165,7 @@ OCAMLCLIBS = \
 	$(LIBCRYPT_LIBS) \
 	$(LIBLZMA_LIBS) \
 	$(LIBXML2_LIBS) \
+	$(YAJL_LIBS) \
 	$(LIBINTL) \
 	-lgnu
 
@@ -232,13 +242,40 @@ fedora.qcow2.xz: fedora.qcow2
 	xz --best -c $< > $@-t
 	mv $@-t $@
 
+yajl_tests_SOURCES = yajl-c.c
+yajl_tests_CPPFLAGS = $(virt_builder_CPPFLAGS)
+yajl_tests_BOBJECTS = \
+	yajl.cmo \
+	yajl_tests.cmo
+yajl_tests_XOBJECTS = $(yajl_tests_BOBJECTS:.cmo=.cmx)
+
+# Can't call the following as <test>_OBJECTS because automake gets confused.
+if HAVE_OCAMLOPT
+yajl_tests_THEOBJECTS = $(yajl_tests_XOBJECTS)
+yajl_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+else
+yajl_tests_THEOBJECTS = $(yajl_tests_BOBJECTS)
+yajl_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+endif
+
+yajl_tests_DEPENDENCIES = $(yajl_tests_THEOBJECTS) $(top_srcdir)/ocaml-link.sh
+yajl_tests_LINK = \
+	$(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) $(OCAMLLINKFLAGS) \
+	  $(yajl_tests_THEOBJECTS) -o $@
+
 TESTS = \
 	test-virt-builder-list.sh \
 	test-virt-index-validate.sh
+check_PROGRAMS =
 
 if ENABLE_APPLIANCE
 TESTS += test-virt-builder.sh
 endif ENABLE_APPLIANCE
+if HAVE_OCAML_PKG_OUNIT
+check_PROGRAMS += yajl_tests
+TESTS += yajl_tests
+endif
 
 check-valgrind:
 	$(MAKE) VG="$(top_builddir)/run @VG@" check
diff --git a/builder/yajl-c.c b/builder/yajl-c.c
new file mode 100644
index 0000000..6a96d59
--- /dev/null
+++ b/builder/yajl-c.c
@@ -0,0 +1,143 @@
+/* virt-builder
+ * Copyright (C) 2015 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 <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#if HAVE_YAJL
+#include <yajl/yajl_tree.h>
+#endif
+
+#include <stdio.h>
+#include <string.h>
+
+#define Val_none (Val_int (0))
+
+extern value virt_builder_yajl_is_available (value unit);
+extern value virt_builder_yajl_tree_parse (value stringv);
+
+#if HAVE_YAJL
+static value
+convert_yajl_value (yajl_val val, int level)
+{
+  CAMLparam0 ();
+  CAMLlocal4 (rv, lv, v, sv);
+
+  if (level > 20)
+    caml_invalid_argument ("too many levels of object/array nesting");
+
+  if (YAJL_IS_OBJECT (val)) {
+    size_t len = YAJL_GET_OBJECT(val)->len;
+    size_t i;
+    rv = caml_alloc (1, 3);
+    lv = caml_alloc_tuple (len);
+    for (i = 0; i < len; ++i) {
+      v = caml_alloc_tuple (2);
+      sv = caml_copy_string (YAJL_GET_OBJECT(val)->keys[i]);
+      Store_field (v, 0, sv);
+      sv = convert_yajl_value (YAJL_GET_OBJECT(val)->values[i], level + 1);
+      Store_field (v, 1, sv);
+      Store_field (lv, i, v);
+    }
+    Store_field (rv, 0, lv);
+  } else if (YAJL_IS_ARRAY (val)) {
+    size_t len = YAJL_GET_ARRAY(val)->len;
+    size_t i;
+    rv = caml_alloc (1, 4);
+    lv = caml_alloc_tuple (len);
+    for (i = 0; i < len; ++i) {
+      v = convert_yajl_value (YAJL_GET_ARRAY(val)->values[i], level + 1);
+      Store_field (lv, i, v);
+    }
+    Store_field (rv, 0, lv);
+  } else if (YAJL_IS_STRING (val)) {
+    rv = caml_alloc (1, 0);
+    v = caml_copy_string (YAJL_GET_STRING(val));
+    Store_field (rv, 0, v);
+  } else if (YAJL_IS_DOUBLE (val)) {
+    rv = caml_alloc (1, 2);
+    lv = caml_alloc_tuple (1);
+    Store_double_field (lv, 0, YAJL_GET_DOUBLE(val));
+    Store_field (rv, 0, lv);
+  } else if (YAJL_IS_INTEGER (val)) {
+    rv = caml_alloc (1, 1);
+    v = caml_copy_int64 (YAJL_GET_INTEGER(val));
+    Store_field (rv, 0, v);
+  } else if (YAJL_IS_TRUE (val)) {
+    rv = caml_alloc (1, 5);
+    Store_field (rv, 0, Val_true);
+  } else if (YAJL_IS_FALSE (val)) {
+    rv = caml_alloc (1, 5);
+    Store_field (rv, 0, Val_false);
+  } else
+    rv = Val_none;
+
+  CAMLreturn (rv);
+}
+
+value
+virt_builder_yajl_is_available (value unit)
+{
+  /* NB: noalloc */
+  return Val_true;
+}
+
+value
+virt_builder_yajl_tree_parse (value stringv)
+{
+  CAMLparam1 (stringv);
+  CAMLlocal1 (rv);
+  yajl_val tree;
+  char error_buf[256];
+
+  tree = yajl_tree_parse (String_val (stringv), error_buf, sizeof error_buf);
+  if (tree == NULL) {
+    char buf[256 + sizeof error_buf];
+    if (strlen (error_buf) > 0)
+      snprintf (buf, sizeof buf, "JSON parse error: %s", error_buf);
+    else
+      snprintf (buf, sizeof buf, "unknown JSON parse error");
+    caml_invalid_argument (buf);
+  }
+
+  rv = convert_yajl_value (tree, 1);
+  yajl_tree_free (tree);
+
+  CAMLreturn (rv);
+}
+
+#else
+
+value
+virt_builder_yajl_is_available (value unit)
+{
+  /* NB: noalloc */
+  return Val_false;
+}
+
+value
+virt_builder_yajl_tree_parse (value stringv)
+{
+  caml_invalid_argument ("virt-builder was compiled without yajl support");
+}
+
+#endif
diff --git a/builder/yajl.ml b/builder/yajl.ml
new file mode 100644
index 0000000..f2d5c2b
--- /dev/null
+++ b/builder/yajl.ml
@@ -0,0 +1,30 @@
+(* virt-builder
+ * Copyright (C) 2015 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.
+ *)
+
+type yajl_val =
+| Yajl_null
+| Yajl_string of string
+| Yajl_number of int64
+| Yajl_double of float
+| Yajl_object of (string * yajl_val) array
+| Yajl_array of yajl_val array
+| Yajl_bool of bool
+
+external yajl_is_available : unit -> bool = "virt_builder_yajl_is_available" "noalloc"
+
+external yajl_tree_parse : string -> yajl_val = "virt_builder_yajl_tree_parse"
diff --git a/builder/yajl.mli b/builder/yajl.mli
new file mode 100644
index 0000000..aaa9389
--- /dev/null
+++ b/builder/yajl.mli
@@ -0,0 +1,33 @@
+(* virt-builder
+ * Copyright (C) 2015 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.
+ *)
+
+type yajl_val =
+| Yajl_null
+| Yajl_string of string
+| Yajl_number of int64
+| Yajl_double of float
+| Yajl_object of (string * yajl_val) array
+| Yajl_array of yajl_val array
+| Yajl_bool of bool
+
+val yajl_is_available : unit -> bool
+(** Is YAJL built in? If not, calling any of the other yajl_*
+    functions will result in an error. *)
+
+val yajl_tree_parse : string -> yajl_val
+(** Parse the JSON string. *)
diff --git a/builder/yajl_tests.ml b/builder/yajl_tests.ml
new file mode 100644
index 0000000..344a8db
--- /dev/null
+++ b/builder/yajl_tests.ml
@@ -0,0 +1,139 @@
+(* virt-builder
+ * Copyright (C) 2015 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.
+ *)
+
+(* This file tests the Yajl module. *)
+
+open OUnit2
+open Yajl
+
+(* Utils. *)
+let assert_equal_string = assert_equal ~printer:(fun x -> x)
+let assert_equal_int = assert_equal ~printer:(fun x -> string_of_int x)
+let assert_equal_int64 = assert_equal ~printer:(fun x -> Int64.to_string x)
+let assert_equal_bool = assert_equal ~printer:(fun x -> string_of_bool x)
+
+let string_of_yajl_val_type = function
+  | Yajl_null -> "null"
+  | Yajl_string _ -> "string"
+  | Yajl_number _ -> "number"
+  | Yajl_double _ -> "float"
+  | Yajl_object _ -> "object"
+  | Yajl_array _ -> "array"
+  | Yajl_bool _ -> "bool"
+let type_mismatch_string exp value =
+  Printf.sprintf "value is not %s but %s" exp (string_of_yajl_val_type value)
+
+let assert_raises_invalid_argument str =
+  (* Replace the Invalid_argument string with a fixed one, just to check
+   * whether the exception has been raised.
+   *)
+  let mock = "parse_error" in
+  let wrapped_tree_parse str =
+    try yajl_tree_parse str
+    with Invalid_argument _ -> raise (Invalid_argument mock) in
+  assert_raises (Invalid_argument mock) (fun () -> wrapped_tree_parse str)
+let assert_raises_nested str =
+  let err = "too many levels of object/array nesting" in
+  assert_raises (Invalid_argument err) (fun () -> yajl_tree_parse str)
+
+let assert_is_object value =
+  assert_bool
+    (type_mismatch_string "object" value)
+    (match value with | Yajl_object _ -> true | _ -> false)
+let assert_is_string exp = function
+  | Yajl_string s -> assert_equal_string exp s
+  | _ as v -> assert_failure (type_mismatch_string "string" v)
+let assert_is_number exp = function
+  | Yajl_number n -> assert_equal_int64 exp n
+  | Yajl_double d -> assert_equal_int64 exp (Int64.of_float d)
+  | _ as v -> assert_failure (type_mismatch_string "number/double" v)
+let assert_is_array value =
+  assert_bool
+    (type_mismatch_string "array" value)
+    (match value with | Yajl_array _ -> true | _ -> false)
+let assert_is_bool exp = function
+  | Yajl_bool b -> assert_equal_bool exp b
+  | _ as v -> assert_failure (type_mismatch_string "bool" v)
+
+let get_object_list = function
+  | Yajl_object x -> x
+  | _ as v -> assert_failure (type_mismatch_string "object" v)
+let get_array = function
+  | Yajl_array x -> x
+  | _ as v -> assert_failure (type_mismatch_string "array" v)
+
+
+let test_tree_parse_invalid ctx =
+  assert_raises_invalid_argument "";
+  assert_raises_invalid_argument "invalid";
+  assert_raises_invalid_argument ":5";
+
+  (* Nested objects/arrays. *)
+  let str = "[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]" in
+  assert_raises_nested str;
+  let str = "{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":{\"a\":5}}}}}}}}}}}}}}}}}}}}}" in
+  assert_raises_nested str
+
+let test_tree_parse_basic ctx =
+  let value = yajl_tree_parse "{}" in
+  assert_is_object value;
+
+  let value = yajl_tree_parse "\"foo\"" in
+  assert_is_string "foo" value;
+
+  let value = yajl_tree_parse "[]" in
+  assert_is_array value
+
+let test_tree_parse_inspect ctx =
+  let value = yajl_tree_parse "{\"foo\":5}" in
+  let l = get_object_list value in
+  assert_equal_int 1 (Array.length l);
+  assert_equal_string "foo" (fst (l.(0)));
+  assert_is_number 5_L (snd (l.(0)));
+
+  let value = yajl_tree_parse "[\"foo\", true]" in
+  let a = get_array value in
+  assert_equal_int 2 (Array.length a);
+  assert_is_string "foo" (a.(0));
+  assert_is_bool true (a.(1));
+
+  let value = yajl_tree_parse "{\"foo\":[false, {}, 10], \"second\":2}" in
+  let l = get_object_list value in
+  assert_equal_int 2 (Array.length l);
+  assert_equal_string "foo" (fst (l.(0)));
+  let a = get_array (snd (l.(0))) in
+  assert_equal_int 3 (Array.length a);
+  assert_is_bool false (a.(0));
+  assert_is_object (a.(1));
+  assert_is_number 10_L (a.(2));
+  assert_equal_string "second" (fst (l.(1)));
+  assert_is_number 2_L (snd (l.(1)))
+
+(* Suites declaration. *)
+let suite =
+  "builder Yajl" >:::
+    [
+      "tree_parse.invalid" >:: test_tree_parse_invalid;
+      "tree_parse.basic" >:: test_tree_parse_basic;
+      "tree_parse.inspect" >:: test_tree_parse_inspect;
+    ]
+
+let () =
+  if not (yajl_is_available ()) then
+    exit 77;
+  run_test_tt_main suite
diff --git a/po/POTFILES b/po/POTFILES
index 6a0a3fc..bb68183 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -6,6 +6,7 @@ builder/index-struct.c
 builder/index-validate.c
 builder/pxzcat-c.c
 builder/setlocale-c.c
+builder/yajl-c.c
 cat/cat.c
 cat/filesystems.c
 cat/log.c
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index 7933c8e..ff08a53 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -14,6 +14,8 @@ builder/setlocale.ml
 builder/sigchecker.ml
 builder/sources.ml
 builder/utils.ml
+builder/yajl.ml
+builder/yajl_tests.ml
 customize/crypt.ml
 customize/customize_cmdline.ml
 customize/customize_main.ml
-- 
2.1.0




More information about the Libguestfs mailing list