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