mirrors/libguestfs
1
0
Fork 0
mirror of https://github.com/libguestfs/libguestfs.git synced 2026-03-21 22:53:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

mltools: JSON: unify JSON_parser type with JSON.json_t.

Browse Source
This commit is contained in:
Richard W.M. Jones
2018-08-20 15:45:20 +01:00
parent f9994c7ffb
commit df11067329
7 changed files with 140 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
builder/simplestreams_parser.ml
View File

@@ -59,7 +59,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy } =
error (f_"%s is not a Simple Streams (index) v1.0 JSON file (format: %s)")
uri format;
let index = Array.to_list (object_get_object "index" tree) in
let index = object_get_object "index" tree in
List.filter_map (
fun (_, desc) ->
let format = object_get_string "format" desc in
@@ -78,13 +78,12 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy } =
error (f_"%s is not a Simple Streams (products) v1.0 JSON file (format: %s)")
uri format;
let products_node = object_get_object "products" tree in
let products = object_get_object "products" tree in
let products = Array.to_list products_node in
List.filter_map (
fun (prod, prod_desc) ->
let arch = Index.Arch (object_get_string "arch" prod_desc) in
let prods = Array.to_list (object_get_object "versions" prod_desc) in
let prods = object_get_object "versions" prod_desc in
let prods = List.filter_map (
fun (rel, rel_desc) ->
let pubname = objects_get_string "pubname" [rel_desc; prod_desc] in
@@ -106,7 +105,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy } =
* the ones related to checksums, explicitly filter
* the supported checksums.
*)
| ("sha256"|"sha512" as t, JSON_parser_string c) ->
| ("sha256"|"sha512" as t, JSON.String c) ->
Some (Checksums.of_string t c)
| _ -> None
) disk_item in

44
builder/test-virt-builder-list-simplestreams.sh
View File

@@ -26,9 +26,9 @@ export XDG_CONFIG_DIRS="$abs_builddir/test-simplestreams"
short_list=$($VG virt-builder --no-check-signature --no-cache --list)
if [ "$short_list" != "net.cirros-cloud:standard:0.3:i386 i386 cirros-0.3.4-i386
if [ "$short_list" != "net.cirros-cloud:standard:0.3:powerpc powerpc cirros-0.3.4-powerpc
net.cirros-cloud:standard:0.3:x86_64 x86_64 cirros-0.3.4-x86_64
net.cirros-cloud:standard:0.3:powerpc powerpc cirros-0.3.4-powerpc" ]; then
net.cirros-cloud:standard:0.3:i386 i386 cirros-0.3.4-i386" ]; then
echo "$0: unexpected --list output:"
echo "$short_list"
exit 1
@@ -38,11 +38,11 @@ long_list=$(virt-builder --no-check-signature --no-cache --list --long)
if [ "$long_list" != "Source URI: file://$abs_builddir/test-simplestreams
os-version: net.cirros-cloud:standard:0.3:i386
Full name: cirros-0.3.4-i386
Architecture: i386
Minimum/default size: 11.9M
Aliases: cirros-0.3.4-i386
os-version: net.cirros-cloud:standard:0.3:powerpc
Full name: cirros-0.3.4-powerpc
Architecture: powerpc
Minimum/default size: 16.4M
Aliases: cirros-0.3.4-powerpc
os-version: net.cirros-cloud:standard:0.3:x86_64
Full name: cirros-0.3.4-x86_64
@@ -50,11 +50,11 @@ Architecture: x86_64
Minimum/default size: 12.7M
Aliases: cirros-0.3.4-x86_64
os-version: net.cirros-cloud:standard:0.3:powerpc
Full name: cirros-0.3.4-powerpc
Architecture: powerpc
Minimum/default size: 16.4M
Aliases: cirros-0.3.4-powerpc" ]; then
os-version: net.cirros-cloud:standard:0.3:i386
Full name: cirros-0.3.4-i386
Architecture: i386
Minimum/default size: 11.9M
Aliases: cirros-0.3.4-i386" ]; then
echo "$0: unexpected --list --long output:"
echo "$long_list"
exit 1
@@ -71,12 +71,12 @@ if [ "$json_list" != "{
],
\"templates\": [
{
\"os-version\": \"net.cirros-cloud:standard:0.3:i386\",
\"full-name\": \"cirros-0.3.4-i386\",
\"arch\": \"i386\",
\"size\": 12506112,
\"os-version\": \"net.cirros-cloud:standard:0.3:powerpc\",
\"full-name\": \"cirros-0.3.4-powerpc\",
\"arch\": \"powerpc\",
\"size\": 17145856,
\"aliases\": [
\"cirros-0.3.4-i386\"
\"cirros-0.3.4-powerpc\"
],
\"hidden\": false
},
@@ -91,12 +91,12 @@ if [ "$json_list" != "{
\"hidden\": false
},
{
\"os-version\": \"net.cirros-cloud:standard:0.3:powerpc\",
\"full-name\": \"cirros-0.3.4-powerpc\",
\"arch\": \"powerpc\",
\"size\": 17145856,
\"os-version\": \"net.cirros-cloud:standard:0.3:i386\",
\"full-name\": \"cirros-0.3.4-i386\",
\"arch\": \"i386\",
\"size\": 12506112,
\"aliases\": [
\"cirros-0.3.4-powerpc\"
\"cirros-0.3.4-i386\"
],
\"hidden\": false
}

2
builder/utils.mli
View File

@@ -29,7 +29,7 @@ and revision =
val string_of_revision : revision -> string
(** Convert a {!revision} into a string. *)
val get_image_infos : string -> JSON_parser.json_parser_val
val get_image_infos : string -> JSON.json_t
(** [get_image_infos path] Run qemu-img info on the image pointed at
path as JSON tree. *)

89
common/mltools/JSON_parser-c.c
View File

@@ -28,7 +28,13 @@
#include <stdio.h>
#include <string.h>
#define Val_none (Val_int (0))
#define JSON_NULL (Val_int (0)) /* Variants without parameters. */
#define JSON_STRING_TAG 0 /* Variants with parameters. */
#define JSON_INT_TAG 1
#define JSON_FLOAT_TAG 2
#define JSON_BOOL_TAG 3
#define JSON_LIST_TAG 4
#define JSON_DICT_TAG 5
value virt_builder_json_parser_tree_parse (value stringv);
@@ -36,60 +42,79 @@ static value
convert_json_t (json_t *val, int level)
{
CAMLparam0 ();
CAMLlocal4 (rv, lv, v, sv);
CAMLlocal5 (rv, v, tv, sv, consv);
if (level > 20)
caml_invalid_argument ("too many levels of object/array nesting");
if (json_is_object (val)) {
const size_t len = json_object_size (val);
size_t i;
const char *key;
json_t *jvalue;
rv = caml_alloc (1, 3);
lv = caml_alloc_tuple (len);
i = 0;
rv = caml_alloc (1, JSON_DICT_TAG);
v = Val_int (0);
/* This will create the OCaml list backwards, but JSON
* dictionaries are supposed to be unordered so that shouldn't
* matter, right? Well except that for some consumers this does
* matter (eg. simplestreams which incorrectly uses a dict when it
* really should use an array).
*/
json_object_foreach (val, key, jvalue) {
v = caml_alloc_tuple (2);
tv = caml_alloc_tuple (2);
sv = caml_copy_string (key);
Store_field (v, 0, sv);
Store_field (tv, 0, sv);
sv = convert_json_t (jvalue, level + 1);
Store_field (v, 1, sv);
Store_field (lv, i, v);
++i;
Store_field (tv, 1, sv);
consv = caml_alloc (2, 0);
Store_field (consv, 1, v);
Store_field (consv, 0, tv);
v = consv;
}
Store_field (rv, 0, lv);
} else if (json_is_array (val)) {
Store_field (rv, 0, v);
}
else if (json_is_array (val)) {
const size_t len = json_array_size (val);
size_t i;
json_t *jvalue;
rv = caml_alloc (1, 4);
lv = caml_alloc_tuple (len);
json_array_foreach (val, i, jvalue) {
v = convert_json_t (jvalue, level + 1);
Store_field (lv, i, v);
rv = caml_alloc (1, JSON_LIST_TAG);
v = Val_int (0);
for (i = 0; i < len; ++i) {
/* Note we have to create the OCaml list backwards. */
jvalue = json_array_get (val, len-i-1);
tv = convert_json_t (jvalue, level + 1);
consv = caml_alloc (2, 0);
Store_field (consv, 1, v);
Store_field (consv, 0, tv);
v = consv;
}
Store_field (rv, 0, lv);
} else if (json_is_string (val)) {
rv = caml_alloc (1, 0);
Store_field (rv, 0, v);
}
else if (json_is_string (val)) {
rv = caml_alloc (1, JSON_STRING_TAG);
v = caml_copy_string (json_string_value (val));
Store_field (rv, 0, v);
} else if (json_is_real (val)) {
rv = caml_alloc (1, 2);
}
else if (json_is_real (val)) {
rv = caml_alloc (1, JSON_FLOAT_TAG);
v = caml_copy_double (json_real_value (val));
Store_field (rv, 0, v);
} else if (json_is_integer (val)) {
rv = caml_alloc (1, 1);
}
else if (json_is_integer (val)) {
rv = caml_alloc (1, JSON_INT_TAG);
v = caml_copy_int64 (json_integer_value (val));
Store_field (rv, 0, v);
} else if (json_is_true (val)) {
rv = caml_alloc (1, 5);
}
else if (json_is_true (val)) {
rv = caml_alloc (1, JSON_BOOL_TAG);
Store_field (rv, 0, Val_true);
} else if (json_is_false (val)) {
rv = caml_alloc (1, 5);
}
else if (json_is_false (val)) {
rv = caml_alloc (1, JSON_BOOL_TAG);
Store_field (rv, 0, Val_false);
} else
rv = Val_none;
}
else
rv = JSON_NULL;
CAMLreturn (rv);
}

29
common/mltools/JSON_parser.ml
View File

@@ -20,20 +20,11 @@ open Std_utils
open Tools_utils
open Common_gettext.Gettext
type json_parser_val =
| JSON_parser_null
| JSON_parser_string of string
| JSON_parser_number of int64
| JSON_parser_double of float
| JSON_parser_object of (string * json_parser_val) array
| JSON_parser_array of json_parser_val array
| JSON_parser_bool of bool
external json_parser_tree_parse : string -> json_parser_val = "virt_builder_json_parser_tree_parse"
external json_parser_tree_parse : string -> JSON.json_t = "virt_builder_json_parser_tree_parse"
let object_find_optional key = function
| JSON_parser_object o ->
(match List.filter (fun (k, _) -> k = key) (Array.to_list o) with
| JSON.Dict fields ->
(match List.filter (fun (k, _) -> k = key) fields with
| [(k, v)] -> Some v
| [] -> None
| _ -> error (f_"more than value for the key ‘%s’") key)
@@ -46,27 +37,27 @@ let object_find key yv =
let object_get_string key yv =
match object_find key yv with
| JSON_parser_string s -> s
| JSON.String s -> s
| _ -> error (f_"the value for the key ‘%s’ is not a string") key
let object_find_object key yv =
match object_find key yv with
| JSON_parser_object _ as o -> o
| JSON.Dict _ as o -> o
| _ -> error (f_"the value for the key ‘%s’ is not an object") key
let object_find_objects fn = function
| JSON_parser_object o -> List.filter_map fn (Array.to_list o)
| JSON.Dict fields -> List.filter_map fn fields
| _ -> error (f_"the value is not an object")
let object_get_object key yv =
match object_find_object key yv with
| JSON_parser_object o -> o
| JSON.Dict fields -> fields
| _ -> assert false (* object_find_object already errors out. *)
let object_get_number key yv =
match object_find key yv with
| JSON_parser_number n -> n
| JSON_parser_double d -> Int64.of_float d
| JSON.Int n -> n
| JSON.Float f -> Int64.of_float f
| _ -> error (f_"the value for the key ‘%s’ is not an integer") key
let objects_get_string key yvs =
@@ -74,7 +65,7 @@ let objects_get_string key yvs =
| [] -> None
| x :: xs ->
(match object_find_optional key x with
| Some (JSON_parser_string s) -> Some s
| Some (JSON.String s) -> Some s
| Some _ -> error (f_"the value for key ‘%s’ is not a string as expected") key
| None -> loop xs
)

25
common/mltools/JSON_parser.mli
View File

@@ -16,43 +16,34 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
type json_parser_val =
| JSON_parser_null
| JSON_parser_string of string
| JSON_parser_number of int64
| JSON_parser_double of float
| JSON_parser_object of (string * json_parser_val) array
| JSON_parser_array of json_parser_val array
| JSON_parser_bool of bool
val json_parser_tree_parse : string -> json_parser_val
val json_parser_tree_parse : string -> JSON.json_t
(** Parse the JSON string. *)
val object_get_string : string -> json_parser_val -> string
val object_get_string : string -> JSON.json_t -> string
(** [object_get_string key yv] gets the value of the [key] field as a string
in the [yv] structure *)
val object_find_object : string -> json_parser_val -> json_parser_val
val object_find_object : string -> JSON.json_t -> JSON.json_t
(** [object_get_object key yv] gets the value of the [key] field as a JSON
value in the [yv] structure.
Mind the returned type is different from [object_get_object] *)
val object_get_object : string -> json_parser_val -> (string * json_parser_val) array
val object_get_object : string -> JSON.json_t -> (string * JSON.json_t) list
(** [object_get_object key yv] gets the value of the [key] field as a JSON
object in the [yv] structure *)
val object_get_number : string -> json_parser_val -> int64
val object_get_number : string -> JSON.json_t -> int64
(** [object_get_number key yv] gets the value of the [key] field as an
integer in the [yv] structure *)
val objects_get_string : string -> json_parser_val list -> string
val objects_get_string : string -> JSON.json_t list -> string
(** [objects_get_string key yvs] gets the value of the [key] field as a string
in an [yvs] list of json_parser_val structure.
in an [yvs] list of JSON.json_t structure.
The key may not be found at all in the list, in which case an error
is raised *)
val object_find_objects : ((string * json_parser_val) -> 'a option) -> json_parser_val -> 'a list
val object_find_objects : ((string * JSON.json_t) -> 'a option) -> JSON.json_t -> 'a list
(** [object_find_objects fn obj] returns all the JSON objects matching the [fn]
function in [obj] list. *)

78
common/mltools/JSON_parser_tests.ml
View File

@@ -27,16 +27,16 @@ 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_json_parser_val_type = function
| JSON_parser_null -> "null"
| JSON_parser_string _ -> "string"
| JSON_parser_number _ -> "number"
| JSON_parser_double _ -> "float"
| JSON_parser_object _ -> "object"
| JSON_parser_array _ -> "array"
| JSON_parser_bool _ -> "bool"
let string_of_json_t = function
| JSON.Null -> "null"
| JSON.String _ -> "string"
| JSON.Int _ -> "int"
| JSON.Float _ -> "float"
| JSON.Dict _ -> "dict"
| JSON.List _ -> "list"
| JSON.Bool _ -> "bool"
let type_mismatch_string exp value =
Printf.sprintf "value is not %s but %s" exp (string_of_json_parser_val_type value)
Printf.sprintf "value is not %s but %s" exp (string_of_json_t value)
let assert_raises_invalid_argument str =
(* Replace the Invalid_argument string with a fixed one, just to check
@@ -54,28 +54,28 @@ let assert_raises_nested str =
let assert_is_object value =
assert_bool
(type_mismatch_string "object" value)
(match value with | JSON_parser_object _ -> true | _ -> false)
(match value with | JSON.Dict _ -> true | _ -> false)
let assert_is_string exp = function
| JSON_parser_string s -> assert_equal_string exp s
| JSON.String s -> assert_equal_string exp s
| _ as v -> assert_failure (type_mismatch_string "string" v)
let assert_is_number exp = function
| JSON_parser_number n -> assert_equal_int64 exp n
| JSON_parser_double d -> assert_equal_int64 exp (Int64.of_float d)
| JSON.Int i -> assert_equal_int64 exp i
| JSON.Float f -> assert_equal_int64 exp (Int64.of_float f)
| _ 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 | JSON_parser_array _ -> true | _ -> false)
(type_mismatch_string "list" value)
(match value with | JSON.List _ -> true | _ -> false)
let assert_is_bool exp = function
| JSON_parser_bool b -> assert_equal_bool exp b
| JSON.Bool b -> assert_equal_bool exp b
| _ as v -> assert_failure (type_mismatch_string "bool" v)
let get_object_list = function
| JSON_parser_object x -> x
| _ as v -> assert_failure (type_mismatch_string "object" v)
let get_array = function
| JSON_parser_array x -> x
| _ as v -> assert_failure (type_mismatch_string "array" v)
let get_dict = function
| JSON.Dict x -> x
| _ as v -> assert_failure (type_mismatch_string "dict" v)
let get_list = function
| JSON.List x -> x
| _ as v -> assert_failure (type_mismatch_string "list" v)
let test_tree_parse_invalid ctx =
@@ -101,28 +101,26 @@ let test_tree_parse_basic ctx =
let test_tree_parse_inspect ctx =
let value = json_parser_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 l = get_dict value in
assert_equal_int 1 (List.length l);
assert_equal_string "foo" (fst (List.hd l));
assert_is_number 5_L (snd (List.hd l));
let value = json_parser_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 a = get_list value in
assert_equal_int 2 (List.length a);
assert_is_string "foo" (List.hd a);
assert_is_bool true (List.nth a 1);
let value = json_parser_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)))
let l = get_dict value in
assert_equal_int 2 (List.length l);
let a = get_list (List.assoc "foo" l) in
assert_equal_int 3 (List.length a);
assert_is_bool false (List.hd a);
assert_is_object (List.nth a 1);
assert_is_number 10_L (List.nth a 2);
assert_is_number 2_L (List.assoc "second" l)
(* Suites declaration. *)
let suite =