[PATCH 00/10] RFC: builder: first support for Simple Streams metadata
Hi, this series adds a basic support for Simple Streams v1.0 metadata files. This makes it possible to create a repository .conf files with [cirros] uri=http://download.cirros-cloud.net format=simplestreams to read the latest version of each CirrOS image. TODO items: - a bit more testing: listing and creating images works, so the current metadata is correct - handle revisions, so newer revisions in images are seen; might imply switch the internal revision handling from int to string Except from the actual patch #10, the rest of the work should be fine for eventual inclusion. Thanks, Pino Toscano (10): builder: add format=FMT in repository .conf files builder: create and use a new Checksums module builder: add SHA256 support in Checksums builder: internally use a list of checksums for indexes builder: allow signatures from subkeys builder: split Index_parser.index in an own module fix -- add Index builder: expose Sigchecker.verifying_signatures builder: add Sigchecker.verify_and_remove_signature builder: support Simple Streams v1.0 as index metadata builder/Makefile.am | 17 +++- builder/builder.ml | 45 +++++---- builder/checksums.ml | 58 +++++++++++ builder/checksums.mli | 33 +++++++ builder/index.ml | 117 ++++++++++++++++++++++ builder/index.mli | 41 ++++++++ builder/index_parser.ml | 98 ++---------------- builder/index_parser.mli | 24 +---- builder/list_entries.ml | 6 +- builder/list_entries.mli | 2 +- builder/sigchecker.ml | 91 ++++++++++------- builder/sigchecker.mli | 12 ++- builder/simplestreams_parser.ml | 207 +++++++++++++++++++++++++++++++++++++++ builder/simplestreams_parser.mli | 19 ++++ builder/sources.ml | 25 +++++ builder/sources.mli | 4 + builder/virt-builder.pod | 23 +++++ builder/yajl-c.c | 141 ++++++++++++++++++++++++++ builder/yajl.ml | 30 ++++++ builder/yajl.mli | 33 +++++++ po/POTFILES | 1 + po/POTFILES-ml | 4 + 22 files changed, 853 insertions(+), 178 deletions(-) create mode 100644 builder/checksums.ml create mode 100644 builder/checksums.mli create mode 100644 builder/index.ml create mode 100644 builder/index.mli create mode 100644 builder/simplestreams_parser.ml create mode 100644 builder/simplestreams_parser.mli create mode 100644 builder/yajl-c.c create mode 100644 builder/yajl.ml create mode 100644 builder/yajl.mli -- 2.1.0
First step in allow different formats for indexes of images, aside the current one. The only accepted value is "native". --- builder/builder.ml | 5 ++++- builder/sources.ml | 16 ++++++++++++++++ builder/sources.mli | 3 +++ builder/virt-builder.pod | 16 ++++++++++++++++ 4 files changed, 39 insertions(+), 1 deletion(-) diff --git a/builder/builder.ml b/builder/builder.ml index 1f618ad..d40ad8f 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -161,6 +161,7 @@ let main () = Sources.name = source; uri = source; gpgkey = Utils.Fingerprint fingerprint; proxy = Downloader.SystemProxy; + format = Sources.FormatNative; } ) sources in let sources = List.append sources repos in @@ -171,7 +172,9 @@ let main () = let sigchecker = Sigchecker.create ~gpg ~check_signature ~gpgkey:source.Sources.gpgkey in - Index_parser.get_index ~downloader ~sigchecker source + match source.Sources.format with + | Sources.FormatNative -> + Index_parser.get_index ~downloader ~sigchecker source ) sources ) in let index = remove_duplicates index in diff --git a/builder/sources.ml b/builder/sources.ml index b774762..b21e8fc 100644 --- a/builder/sources.ml +++ b/builder/sources.ml @@ -27,7 +27,10 @@ type source = { uri : string; gpgkey : Utils.gpgkey_type; proxy : Downloader.proxy_mode; + format : source_format; } +and source_format = +| FormatNative module StringSet = Set.Make (String) @@ -75,8 +78,21 @@ let parse_conf file = ) with Not_found -> Downloader.SystemProxy in + let format = + try + (match (List.assoc ("format", None) fields) with + | "native" | "" -> FormatNative + | fmt -> + if verbose () then ( + eprintf (f_"%s: unknown repository type '%s' in %s, skipping it\n") prog fmt file; + ); + invalid_arg fmt + ) + with + Not_found -> FormatNative in { name = n; uri = uri; gpgkey = gpgkey; proxy = proxy; + format = format; } in try (give_source n fields) :: acc diff --git a/builder/sources.mli b/builder/sources.mli index 2a94c54..e861310 100644 --- a/builder/sources.mli +++ b/builder/sources.mli @@ -21,6 +21,9 @@ type source = { uri : string; gpgkey : Utils.gpgkey_type; proxy : Downloader.proxy_mode; + format : source_format; } +and source_format = +| FormatNative val read_sources : unit -> source list diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod index b4a341f..fc49d4d 100644 --- a/builder/virt-builder.pod +++ b/builder/virt-builder.pod @@ -1169,6 +1169,22 @@ configuration. If not present, the assumed value is to respect the proxy settings of the system (i.e. as if B<system> would be specified). +=item C<format=FORMAT> + +This optional field specifies the format of the repository. +The possible values are: + +=over 4 + +=item B<native> + +The native format of the C<virt-builder> repository. See also +L</Creating and signing the index file> below. + +=back + +If not present, the assumed value is C<native>. + =back For serious virt-builder use, you may want to create your own -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:41AM +0200, Pino Toscano wrote:
First step in allow different formats for indexes of images, aside the current one.
The only accepted value is "native". --- builder/builder.ml | 5 ++++- builder/sources.ml | 16 ++++++++++++++++ builder/sources.mli | 3 +++ builder/virt-builder.pod | 16 ++++++++++++++++ 4 files changed, 39 insertions(+), 1 deletion(-)
diff --git a/builder/builder.ml b/builder/builder.ml index 1f618ad..d40ad8f 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -161,6 +161,7 @@ let main () = Sources.name = source; uri = source; gpgkey = Utils.Fingerprint fingerprint; proxy = Downloader.SystemProxy; + format = Sources.FormatNative; } ) sources in let sources = List.append sources repos in @@ -171,7 +172,9 @@ let main () = let sigchecker = Sigchecker.create ~gpg ~check_signature ~gpgkey:source.Sources.gpgkey in - Index_parser.get_index ~downloader ~sigchecker source + match source.Sources.format with + | Sources.FormatNative -> + Index_parser.get_index ~downloader ~sigchecker source ) sources ) in let index = remove_duplicates index in diff --git a/builder/sources.ml b/builder/sources.ml index b774762..b21e8fc 100644 --- a/builder/sources.ml +++ b/builder/sources.ml @@ -27,7 +27,10 @@ type source = { uri : string; gpgkey : Utils.gpgkey_type; proxy : Downloader.proxy_mode; + format : source_format; } +and source_format = +| FormatNative
module StringSet = Set.Make (String)
@@ -75,8 +78,21 @@ let parse_conf file = ) with Not_found -> Downloader.SystemProxy in + let format = + try + (match (List.assoc ("format", None) fields) with + | "native" | "" -> FormatNative + | fmt -> + if verbose () then ( + eprintf (f_"%s: unknown repository type '%s' in %s, skipping it\n") prog fmt file; + ); + invalid_arg fmt + ) + with + Not_found -> FormatNative in { name = n; uri = uri; gpgkey = gpgkey; proxy = proxy; + format = format; } in try (give_source n fields) :: acc diff --git a/builder/sources.mli b/builder/sources.mli index 2a94c54..e861310 100644 --- a/builder/sources.mli +++ b/builder/sources.mli @@ -21,6 +21,9 @@ type source = { uri : string; gpgkey : Utils.gpgkey_type; proxy : Downloader.proxy_mode; + format : source_format; } +and source_format = +| FormatNative
val read_sources : unit -> source list diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod index b4a341f..fc49d4d 100644 --- a/builder/virt-builder.pod +++ b/builder/virt-builder.pod @@ -1169,6 +1169,22 @@ configuration. If not present, the assumed value is to respect the proxy settings of the system (i.e. as if B<system> would be specified).
+=item C<format=FORMAT> + +This optional field specifies the format of the repository. +The possible values are: + +=over 4 + +=item B<native> + +The native format of the C<virt-builder> repository. See also +L</Creating and signing the index file> below. + +=back + +If not present, the assumed value is C<native>. + =back
For serious virt-builder use, you may want to create your own -- 2.1.0
ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html
Introduce a new Checksums module to handle the check of checksums, moving part of the Sigchecker code to it. Adapt the rest of virt-builder to this new module. --- builder/Makefile.am | 2 ++ builder/builder.ml | 2 +- builder/checksums.ml | 51 +++++++++++++++++++++++++++++++++++++++++++++++++ builder/checksums.mli | 29 ++++++++++++++++++++++++++++ builder/index_parser.ml | 4 +++- builder/sigchecker.ml | 25 ------------------------ builder/sigchecker.mli | 6 ------ po/POTFILES-ml | 1 + 8 files changed, 87 insertions(+), 33 deletions(-) create mode 100644 builder/checksums.ml create mode 100644 builder/checksums.mli diff --git a/builder/Makefile.am b/builder/Makefile.am index 2413217..28afeee 100644 --- a/builder/Makefile.am +++ b/builder/Makefile.am @@ -39,6 +39,7 @@ CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o virt-builder SOURCES_MLI = \ cache.mli \ downloader.mli \ + checksums.mli \ index_parser.mli \ ini_reader.mli \ languages.mli \ @@ -52,6 +53,7 @@ SOURCES_ML = \ utils.ml \ pxzcat.ml \ setlocale.ml \ + checksums.ml \ ini_reader.ml \ paths.ml \ languages.ml \ diff --git a/builder/builder.ml b/builder/builder.ml index d40ad8f..e4f40ef 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -282,7 +282,7 @@ let main () = match entry with (* New-style: Using a checksum. *) | { Index_parser.checksum_sha512 = Some csum } -> - Sigchecker.verify_checksum sigchecker (Sigchecker.SHA512 csum) template + Checksums.verify_checksum (Checksums.SHA512 csum) template | { Index_parser.checksum_sha512 = None } -> (* Old-style: detached signature. *) diff --git a/builder/checksums.ml b/builder/checksums.ml new file mode 100644 index 0000000..73d541f --- /dev/null +++ b/builder/checksums.ml @@ -0,0 +1,51 @@ +(* 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. + *) + +open Common_gettext.Gettext +open Common_utils + +open Utils + +open Printf + +type csum_t = +| SHA512 of string + +let string_of_csum_t = function + | SHA512 _ -> "sha512" + +let string_of_csum = function + | SHA512 c -> c + +let verify_checksum csum filename = + let prog, csum_ref = + match csum with + | SHA512 c -> "sha512sum", c + in + + let cmd = sprintf "%s %s" prog (quote filename) in + if verbose () then printf "%s\n%!" cmd; + let lines = external_command cmd in + match lines with + | [] -> + error (f_"%s did not return any output") prog + | line :: _ -> + let csum_actual = fst (string_split " " line) in + if csum_ref <> csum_actual then + error (f_"%s checksum of template did not match the expected checksum!\n found checksum: %s\n expected checksum: %s\nTry:\n - Use the '-v' option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!") + (string_of_csum_t csum) csum_actual csum_ref diff --git a/builder/checksums.mli b/builder/checksums.mli new file mode 100644 index 0000000..6833879 --- /dev/null +++ b/builder/checksums.mli @@ -0,0 +1,29 @@ +(* 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 csum_t = +| SHA512 of string + +val verify_checksum : csum_t -> string -> unit +(** Verify the checksum of the file. *) + +val string_of_csum_t : csum_t -> string +(** Return a string representation of the checksum type. *) + +val string_of_csum : csum_t -> string +(** Return a string representation of the checksum value. *) diff --git a/builder/index_parser.ml b/builder/index_parser.ml index aff0b00..abd685c 100644 --- a/builder/index_parser.ml +++ b/builder/index_parser.ml @@ -79,7 +79,9 @@ let print_entry chan (name, { printable_name = printable_name; ); (match checksum_sha512 with | None -> () - | Some uri -> fp "checksum[sha512]=%s\n" uri + | Some uri -> + fp "checksum[%s]=%s\n" + (Checksums.string_of_csum_t (Checksums.SHA512 uri)) uri ); fp "revision=%d\n" revision; (match format with diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 55db7af..cb9144f 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -180,28 +180,3 @@ and do_verify t args = if not (equal_fingerprints !fingerprint t.fingerprint) then error (f_"fingerprint of signature does not match the expected fingerprint!\n found fingerprint: %s\n expected fingerprint: %s") !fingerprint t.fingerprint - -type csum_t = SHA512 of string - -let verify_checksum t (SHA512 csum) filename = - let csum_file = Filename.temp_file "vbcsum" ".txt" in - unlink_on_exit csum_file; - let cmd = sprintf "sha512sum %s | awk '{print $1}' > %s" - (quote filename) (quote csum_file) in - if verbose () then printf "%s\n%!" cmd; - let r = Sys.command cmd in - if r <> 0 then - error (f_"could not run sha512sum command to verify checksum"); - - let csum_actual = read_whole_file csum_file in - - let csum_actual = - let len = String.length csum_actual in - if len > 0 && csum_actual.[len-1] = '\n' then - String.sub csum_actual 0 (len-1) - else - csum_actual in - - if csum <> csum_actual then - error (f_"checksum of template did not match the expected checksum!\n found checksum: %s\n expected checksum: %s\nTry:\n - Use the '-v' option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!") - csum_actual csum diff --git a/builder/sigchecker.mli b/builder/sigchecker.mli index b670957..47bf2a3 100644 --- a/builder/sigchecker.mli +++ b/builder/sigchecker.mli @@ -26,9 +26,3 @@ val verify : t -> string -> unit val verify_detached : t -> string -> string option -> unit (** Verify the file is signed against the detached signature (if check_signature is true). *) - -type csum_t = SHA512 of string - -val verify_checksum : t -> csum_t -> string -> unit -(** Verify the checksum of the file. This is always verified even if - check_signature if false. *) diff --git a/po/POTFILES-ml b/po/POTFILES-ml index bfed0cf..ad52110 100644 --- a/po/POTFILES-ml +++ b/po/POTFILES-ml @@ -1,5 +1,6 @@ builder/builder.ml builder/cache.ml +builder/checksums.ml builder/cmdline.ml builder/downloader.ml builder/index_parser.ml -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:42AM +0200, Pino Toscano wrote:
Introduce a new Checksums module to handle the check of checksums, moving part of the Sigchecker code to it.
Adapt the rest of virt-builder to this new module. --- builder/Makefile.am | 2 ++ builder/builder.ml | 2 +- builder/checksums.ml | 51 +++++++++++++++++++++++++++++++++++++++++++++++++ builder/checksums.mli | 29 ++++++++++++++++++++++++++++ builder/index_parser.ml | 4 +++- builder/sigchecker.ml | 25 ------------------------ builder/sigchecker.mli | 6 ------ po/POTFILES-ml | 1 + 8 files changed, 87 insertions(+), 33 deletions(-) create mode 100644 builder/checksums.ml create mode 100644 builder/checksums.mli
diff --git a/builder/Makefile.am b/builder/Makefile.am index 2413217..28afeee 100644 --- a/builder/Makefile.am +++ b/builder/Makefile.am @@ -39,6 +39,7 @@ CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o virt-builder SOURCES_MLI = \ cache.mli \ downloader.mli \ + checksums.mli \ index_parser.mli \ ini_reader.mli \ languages.mli \ @@ -52,6 +53,7 @@ SOURCES_ML = \ utils.ml \ pxzcat.ml \ setlocale.ml \ + checksums.ml \ ini_reader.ml \ paths.ml \ languages.ml \ diff --git a/builder/builder.ml b/builder/builder.ml index d40ad8f..e4f40ef 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -282,7 +282,7 @@ let main () = match entry with (* New-style: Using a checksum. *) | { Index_parser.checksum_sha512 = Some csum } -> - Sigchecker.verify_checksum sigchecker (Sigchecker.SHA512 csum) template + Checksums.verify_checksum (Checksums.SHA512 csum) template
| { Index_parser.checksum_sha512 = None } -> (* Old-style: detached signature. *) diff --git a/builder/checksums.ml b/builder/checksums.ml new file mode 100644 index 0000000..73d541f --- /dev/null +++ b/builder/checksums.ml @@ -0,0 +1,51 @@ +(* 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. + *) + +open Common_gettext.Gettext +open Common_utils + +open Utils + +open Printf + +type csum_t = +| SHA512 of string + +let string_of_csum_t = function + | SHA512 _ -> "sha512" + +let string_of_csum = function + | SHA512 c -> c + +let verify_checksum csum filename = + let prog, csum_ref = + match csum with + | SHA512 c -> "sha512sum", c + in + + let cmd = sprintf "%s %s" prog (quote filename) in + if verbose () then printf "%s\n%!" cmd; + let lines = external_command cmd in + match lines with + | [] -> + error (f_"%s did not return any output") prog + | line :: _ -> + let csum_actual = fst (string_split " " line) in + if csum_ref <> csum_actual then + error (f_"%s checksum of template did not match the expected checksum!\n found checksum: %s\n expected checksum: %s\nTry:\n - Use the '-v' option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!") + (string_of_csum_t csum) csum_actual csum_ref diff --git a/builder/checksums.mli b/builder/checksums.mli new file mode 100644 index 0000000..6833879 --- /dev/null +++ b/builder/checksums.mli @@ -0,0 +1,29 @@ +(* 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 csum_t = +| SHA512 of string + +val verify_checksum : csum_t -> string -> unit +(** Verify the checksum of the file. *) + +val string_of_csum_t : csum_t -> string +(** Return a string representation of the checksum type. *) + +val string_of_csum : csum_t -> string +(** Return a string representation of the checksum value. *) diff --git a/builder/index_parser.ml b/builder/index_parser.ml index aff0b00..abd685c 100644 --- a/builder/index_parser.ml +++ b/builder/index_parser.ml @@ -79,7 +79,9 @@ let print_entry chan (name, { printable_name = printable_name; ); (match checksum_sha512 with | None -> () - | Some uri -> fp "checksum[sha512]=%s\n" uri + | Some uri -> + fp "checksum[%s]=%s\n" + (Checksums.string_of_csum_t (Checksums.SHA512 uri)) uri ); fp "revision=%d\n" revision; (match format with diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 55db7af..cb9144f 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -180,28 +180,3 @@ and do_verify t args = if not (equal_fingerprints !fingerprint t.fingerprint) then error (f_"fingerprint of signature does not match the expected fingerprint!\n found fingerprint: %s\n expected fingerprint: %s") !fingerprint t.fingerprint - -type csum_t = SHA512 of string - -let verify_checksum t (SHA512 csum) filename = - let csum_file = Filename.temp_file "vbcsum" ".txt" in - unlink_on_exit csum_file; - let cmd = sprintf "sha512sum %s | awk '{print $1}' > %s" - (quote filename) (quote csum_file) in - if verbose () then printf "%s\n%!" cmd; - let r = Sys.command cmd in - if r <> 0 then - error (f_"could not run sha512sum command to verify checksum"); - - let csum_actual = read_whole_file csum_file in - - let csum_actual = - let len = String.length csum_actual in - if len > 0 && csum_actual.[len-1] = '\n' then - String.sub csum_actual 0 (len-1) - else - csum_actual in - - if csum <> csum_actual then - error (f_"checksum of template did not match the expected checksum!\n found checksum: %s\n expected checksum: %s\nTry:\n - Use the '-v' option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!") - csum_actual csum diff --git a/builder/sigchecker.mli b/builder/sigchecker.mli index b670957..47bf2a3 100644 --- a/builder/sigchecker.mli +++ b/builder/sigchecker.mli @@ -26,9 +26,3 @@ val verify : t -> string -> unit val verify_detached : t -> string -> string option -> unit (** Verify the file is signed against the detached signature (if check_signature is true). *) - -type csum_t = SHA512 of string - -val verify_checksum : t -> csum_t -> string -> unit -(** Verify the checksum of the file. This is always verified even if - check_signature if false. *) diff --git a/po/POTFILES-ml b/po/POTFILES-ml index bfed0cf..ad52110 100644 --- a/po/POTFILES-ml +++ b/po/POTFILES-ml @@ -1,5 +1,6 @@ builder/builder.ml builder/cache.ml +builder/checksums.ml builder/cmdline.ml builder/downloader.ml builder/index_parser.ml -- 2.1.0
Code motion - ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html
--- builder/checksums.ml | 4 ++++ builder/checksums.mli | 1 + 2 files changed, 5 insertions(+) diff --git a/builder/checksums.ml b/builder/checksums.ml index 73d541f..25b3328 100644 --- a/builder/checksums.ml +++ b/builder/checksums.ml @@ -24,17 +24,21 @@ open Utils open Printf type csum_t = +| SHA256 of string | SHA512 of string let string_of_csum_t = function + | SHA256 _ -> "sha256" | SHA512 _ -> "sha512" let string_of_csum = function + | SHA256 c -> c | SHA512 c -> c let verify_checksum csum filename = let prog, csum_ref = match csum with + | SHA256 c -> "sha256sum", c | SHA512 c -> "sha512sum", c in diff --git a/builder/checksums.mli b/builder/checksums.mli index 6833879..4dc9dc0 100644 --- a/builder/checksums.mli +++ b/builder/checksums.mli @@ -17,6 +17,7 @@ *) type csum_t = +| SHA256 of string | SHA512 of string val verify_checksum : csum_t -> string -> unit -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:43AM +0200, Pino Toscano wrote:
--- builder/checksums.ml | 4 ++++ builder/checksums.mli | 1 + 2 files changed, 5 insertions(+)
diff --git a/builder/checksums.ml b/builder/checksums.ml index 73d541f..25b3328 100644 --- a/builder/checksums.ml +++ b/builder/checksums.ml @@ -24,17 +24,21 @@ open Utils open Printf
type csum_t = +| SHA256 of string | SHA512 of string
let string_of_csum_t = function + | SHA256 _ -> "sha256" | SHA512 _ -> "sha512"
let string_of_csum = function + | SHA256 c -> c | SHA512 c -> c
let verify_checksum csum filename = let prog, csum_ref = match csum with + | SHA256 c -> "sha256sum", c | SHA512 c -> "sha512sum", c in
diff --git a/builder/checksums.mli b/builder/checksums.mli index 6833879..4dc9dc0 100644 --- a/builder/checksums.mli +++ b/builder/checksums.mli @@ -17,6 +17,7 @@ *)
type csum_t = +| SHA256 of string | SHA512 of string
val verify_checksum : csum_t -> string -> unit --
ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-top is 'top' for virtual machines. Tiny program with many powerful monitoring features, net stats, disk stats, logging, etc. http://people.redhat.com/~rjones/virt-top
Extend Index_parser.entry to hold a list of checksums to validate, and validate all of them. This does change nothing currently, as only sha512 is read, while still allowing us to fetch more checksums if needed. --- builder/builder.ml | 6 +++--- builder/checksums.ml | 3 +++ builder/checksums.mli | 3 +++ builder/index_parser.ml | 22 +++++++++++++++------- builder/index_parser.mli | 2 +- 5 files changed, 25 insertions(+), 11 deletions(-) diff --git a/builder/builder.ml b/builder/builder.ml index e4f40ef..6f2b4bd 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -281,10 +281,10 @@ let main () = let () = match entry with (* New-style: Using a checksum. *) - | { Index_parser.checksum_sha512 = Some csum } -> - Checksums.verify_checksum (Checksums.SHA512 csum) template + | { Index_parser.checksums = Some csums } -> + Checksums.verify_checksums csums template - | { Index_parser.checksum_sha512 = None } -> + | { Index_parser.checksums = None } -> (* Old-style: detached signature. *) let sigfile = match entry with diff --git a/builder/checksums.ml b/builder/checksums.ml index 25b3328..5663832 100644 --- a/builder/checksums.ml +++ b/builder/checksums.ml @@ -53,3 +53,6 @@ let verify_checksum csum filename = if csum_ref <> csum_actual then error (f_"%s checksum of template did not match the expected checksum!\n found checksum: %s\n expected checksum: %s\nTry:\n - Use the '-v' option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!") (string_of_csum_t csum) csum_actual csum_ref + +let verify_checksums checksums filename = + List.iter (fun c -> verify_checksum c filename) checksums diff --git a/builder/checksums.mli b/builder/checksums.mli index 4dc9dc0..ef26634 100644 --- a/builder/checksums.mli +++ b/builder/checksums.mli @@ -23,6 +23,9 @@ type csum_t = val verify_checksum : csum_t -> string -> unit (** Verify the checksum of the file. *) +val verify_checksums : csum_t list -> string -> unit +(** Verify all the checksums of the file. *) + val string_of_csum_t : csum_t -> string (** Return a string representation of the checksum type. *) diff --git a/builder/index_parser.ml b/builder/index_parser.ml index abd685c..1164ab5 100644 --- a/builder/index_parser.ml +++ b/builder/index_parser.ml @@ -31,7 +31,7 @@ and entry = { file_uri : string; arch : string; signature_uri : string option; (* deprecated, will be removed in 1.26 *) - checksum_sha512 : string option; + checksums : Checksums.csum_t list option; revision : int; format : string option; size : int64; @@ -51,7 +51,7 @@ let print_entry chan (name, { printable_name = printable_name; arch = arch; osinfo = osinfo; signature_uri = signature_uri; - checksum_sha512 = checksum_sha512; + checksums = checksums; revision = revision; format = format; size = size; @@ -77,11 +77,14 @@ let print_entry chan (name, { printable_name = printable_name; | None -> () | Some uri -> fp "sig=%s\n" uri ); - (match checksum_sha512 with + (match checksums with | None -> () - | Some uri -> - fp "checksum[%s]=%s\n" - (Checksums.string_of_csum_t (Checksums.SHA512 uri)) uri + | Some checksums -> + List.iter ( + fun c -> + fp "checksum[%s]=%s\n" + (Checksums.string_of_csum_t c) (Checksums.string_of_csum c) + ) checksums ); fp "revision=%d\n" revision; (match format with @@ -260,12 +263,17 @@ let get_index ~downloader ~sigchecker | [] -> None | l -> Some l in + let checksums = + match checksum_sha512 with + | Some c -> Some [Checksums.SHA512 c] + | None -> None in + let entry = { printable_name = printable_name; osinfo = osinfo; file_uri = file_uri; arch = arch; signature_uri = signature_uri; - checksum_sha512 = checksum_sha512; + checksums = checksums; revision = revision; format = format; size = size; diff --git a/builder/index_parser.mli b/builder/index_parser.mli index 2e6ba77..f5b98b7 100644 --- a/builder/index_parser.mli +++ b/builder/index_parser.mli @@ -23,7 +23,7 @@ and entry = { file_uri : string; arch : string; signature_uri : string option; (* deprecated, will be removed in 1.26 *) - checksum_sha512 : string option; + checksums : Checksums.csum_t list option; revision : int; format : string option; size : int64; -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:44AM +0200, Pino Toscano wrote:
Extend Index_parser.entry to hold a list of checksums to validate, and validate all of them.
This does change nothing currently, as only sha512 is read, while still allowing us to fetch more checksums if needed. --- builder/builder.ml | 6 +++--- builder/checksums.ml | 3 +++ builder/checksums.mli | 3 +++ builder/index_parser.ml | 22 +++++++++++++++------- builder/index_parser.mli | 2 +- 5 files changed, 25 insertions(+), 11 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml index e4f40ef..6f2b4bd 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -281,10 +281,10 @@ let main () = let () = match entry with (* New-style: Using a checksum. *) - | { Index_parser.checksum_sha512 = Some csum } -> - Checksums.verify_checksum (Checksums.SHA512 csum) template + | { Index_parser.checksums = Some csums } -> + Checksums.verify_checksums csums template
- | { Index_parser.checksum_sha512 = None } -> + | { Index_parser.checksums = None } -> (* Old-style: detached signature. *) let sigfile = match entry with diff --git a/builder/checksums.ml b/builder/checksums.ml index 25b3328..5663832 100644 --- a/builder/checksums.ml +++ b/builder/checksums.ml @@ -53,3 +53,6 @@ let verify_checksum csum filename = if csum_ref <> csum_actual then error (f_"%s checksum of template did not match the expected checksum!\n found checksum: %s\n expected checksum: %s\nTry:\n - Use the '-v' option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!") (string_of_csum_t csum) csum_actual csum_ref + +let verify_checksums checksums filename = + List.iter (fun c -> verify_checksum c filename) checksums diff --git a/builder/checksums.mli b/builder/checksums.mli index 4dc9dc0..ef26634 100644 --- a/builder/checksums.mli +++ b/builder/checksums.mli @@ -23,6 +23,9 @@ type csum_t = val verify_checksum : csum_t -> string -> unit (** Verify the checksum of the file. *)
+val verify_checksums : csum_t list -> string -> unit +(** Verify all the checksums of the file. *) + val string_of_csum_t : csum_t -> string (** Return a string representation of the checksum type. *)
diff --git a/builder/index_parser.ml b/builder/index_parser.ml index abd685c..1164ab5 100644 --- a/builder/index_parser.ml +++ b/builder/index_parser.ml @@ -31,7 +31,7 @@ and entry = { file_uri : string; arch : string; signature_uri : string option; (* deprecated, will be removed in 1.26 *) - checksum_sha512 : string option; + checksums : Checksums.csum_t list option; revision : int; format : string option; size : int64; @@ -51,7 +51,7 @@ let print_entry chan (name, { printable_name = printable_name; arch = arch; osinfo = osinfo; signature_uri = signature_uri; - checksum_sha512 = checksum_sha512; + checksums = checksums; revision = revision; format = format; size = size; @@ -77,11 +77,14 @@ let print_entry chan (name, { printable_name = printable_name; | None -> () | Some uri -> fp "sig=%s\n" uri ); - (match checksum_sha512 with + (match checksums with | None -> () - | Some uri -> - fp "checksum[%s]=%s\n" - (Checksums.string_of_csum_t (Checksums.SHA512 uri)) uri + | Some checksums -> + List.iter ( + fun c -> + fp "checksum[%s]=%s\n" + (Checksums.string_of_csum_t c) (Checksums.string_of_csum c) + ) checksums ); fp "revision=%d\n" revision; (match format with @@ -260,12 +263,17 @@ let get_index ~downloader ~sigchecker | [] -> None | l -> Some l in
+ let checksums = + match checksum_sha512 with + | Some c -> Some [Checksums.SHA512 c] + | None -> None in + let entry = { printable_name = printable_name; osinfo = osinfo; file_uri = file_uri; arch = arch; signature_uri = signature_uri; - checksum_sha512 = checksum_sha512; + checksums = checksums; revision = revision; format = format; size = size; diff --git a/builder/index_parser.mli b/builder/index_parser.mli index 2e6ba77..f5b98b7 100644 --- a/builder/index_parser.mli +++ b/builder/index_parser.mli @@ -23,7 +23,7 @@ and entry = { file_uri : string; arch : string; signature_uri : string option; (* deprecated, will be removed in 1.26 *) - checksum_sha512 : string option; + checksums : Checksums.csum_t list option; revision : int; format : string option; size : int64;
Straightforward refactoring, ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html
When importing a key, read the list of the valid subkeys of it, and use it to check whether a signature was done by one of them. This allows index provides to sign them using a subkey instead of the main key. --- builder/sigchecker.ml | 41 +++++++++++++++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 6 deletions(-) diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index cb9144f..06c60ae 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -27,6 +27,7 @@ open Unix type t = { gpg : string; fingerprint : string; + subkeys_fingerprints : string list; check_signature : bool; gpghome : string; } @@ -63,7 +64,34 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile = if r <> 0 then error (f_"GPG failure: could not trust the imported key\nUse the '-v' option and look for earlier error messages."); ); - !fingerprint + let subkeys = + (* --with-fingerprint is specified twice so gpg outputs the full + * fingerprint of the subkeys. *) + let cmd = sprintf "%s --homedir %s --with-colons --with-fingerprint --with-fingerprint --list-keys %s" + gpg gpghome !fingerprint in + if verbose () then printf "%s\n%!" cmd; + let lines = external_command cmd in + let current = ref None in + let subkeys = ref [] in + List.iter ( + fun line -> + let line = string_nsplit ":" line in + match line with + | "sub" :: ("u"|"-") :: _ :: _ :: id :: _ -> + current := Some id + | "fpr" :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: id :: _ -> + (match !current with + | None -> () + | Some k -> + if string_suffix id k then ( + subkeys := id :: !subkeys; + ); + current := None + ) + | _ -> () + ) lines; + !subkeys in + !fingerprint, subkeys let rec create ~gpg ~gpgkey ~check_signature = (* Create a temporary directory for gnupg. *) @@ -74,7 +102,7 @@ let rec create ~gpg ~gpgkey ~check_signature = match check_signature, gpgkey with | true, No_Key -> false, No_Key | x, y -> x, y in - let fingerprint = + let fingerprint, subkeys = if check_signature then ( (* Run gpg so it can setup its own home directory, failing if it * cannot. @@ -100,13 +128,13 @@ let rec create ~gpg ~gpgkey ~check_signature = let r = Sys.command cmd in if r <> 0 then error (f_"could not export public key\nUse the '-v' option and look for earlier error messages."); - ignore (import_keyfile gpg tmpdir filename); - fp + import_keyfile gpg tmpdir filename ) else - "" in + "", [] in { gpg = gpg; fingerprint = fingerprint; + subkeys_fingerprints = subkeys; check_signature = check_signature; gpghome = tmpdir; } @@ -177,6 +205,7 @@ and do_verify t args = | _ -> () ) status; - if not (equal_fingerprints !fingerprint t.fingerprint) then + if not (equal_fingerprints !fingerprint t.fingerprint) && + not (List.exists (equal_fingerprints !fingerprint) t.subkeys_fingerprints) then error (f_"fingerprint of signature does not match the expected fingerprint!\n found fingerprint: %s\n expected fingerprint: %s") !fingerprint t.fingerprint -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:45AM +0200, Pino Toscano wrote:
When importing a key, read the list of the valid subkeys of it, and use it to check whether a signature was done by one of them. This allows index provides to sign them using a subkey instead of the main key. --- builder/sigchecker.ml | 41 +++++++++++++++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 6 deletions(-)
diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index cb9144f..06c60ae 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -27,6 +27,7 @@ open Unix type t = { gpg : string; fingerprint : string; + subkeys_fingerprints : string list; check_signature : bool; gpghome : string; } @@ -63,7 +64,34 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile = if r <> 0 then error (f_"GPG failure: could not trust the imported key\nUse the '-v' option and look for earlier error messages."); ); - !fingerprint + let subkeys = + (* --with-fingerprint is specified twice so gpg outputs the full + * fingerprint of the subkeys. *) + let cmd = sprintf "%s --homedir %s --with-colons --with-fingerprint --with-fingerprint --list-keys %s" + gpg gpghome !fingerprint in + if verbose () then printf "%s\n%!" cmd; + let lines = external_command cmd in + let current = ref None in + let subkeys = ref [] in + List.iter ( + fun line -> + let line = string_nsplit ":" line in + match line with + | "sub" :: ("u"|"-") :: _ :: _ :: id :: _ -> + current := Some id + | "fpr" :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: id :: _ -> + (match !current with + | None -> () + | Some k -> + if string_suffix id k then ( + subkeys := id :: !subkeys; + ); + current := None + ) + | _ -> () + ) lines; + !subkeys in + !fingerprint, subkeys
let rec create ~gpg ~gpgkey ~check_signature = (* Create a temporary directory for gnupg. *) @@ -74,7 +102,7 @@ let rec create ~gpg ~gpgkey ~check_signature = match check_signature, gpgkey with | true, No_Key -> false, No_Key | x, y -> x, y in - let fingerprint = + let fingerprint, subkeys = if check_signature then ( (* Run gpg so it can setup its own home directory, failing if it * cannot. @@ -100,13 +128,13 @@ let rec create ~gpg ~gpgkey ~check_signature = let r = Sys.command cmd in if r <> 0 then error (f_"could not export public key\nUse the '-v' option and look for earlier error messages."); - ignore (import_keyfile gpg tmpdir filename); - fp + import_keyfile gpg tmpdir filename ) else - "" in + "", [] in { gpg = gpg; fingerprint = fingerprint; + subkeys_fingerprints = subkeys; check_signature = check_signature; gpghome = tmpdir; } @@ -177,6 +205,7 @@ and do_verify t args = | _ -> () ) status;
- if not (equal_fingerprints !fingerprint t.fingerprint) then + if not (equal_fingerprints !fingerprint t.fingerprint) && + not (List.exists (equal_fingerprints !fingerprint) t.subkeys_fingerprints) then error (f_"fingerprint of signature does not match the expected fingerprint!\n found fingerprint: %s\n expected fingerprint: %s") !fingerprint t.fingerprint --
Looks reasonable, ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html
Move the index and entry definitions in an own Index module, together with the (previously internal to Index_parser) print_entry debugging function. --- builder/Makefile.am | 2 + builder/builder.ml | 36 +++++++-------- builder/index.ml | 117 +++++++++++++++++++++++++++++++++++++++++++++++ builder/index.mli | 41 +++++++++++++++++ builder/index_parser.ml | 96 +------------------------------------- builder/index_parser.mli | 24 +--------- builder/list_entries.ml | 6 +-- builder/list_entries.mli | 2 +- 8 files changed, 185 insertions(+), 139 deletions(-) create mode 100644 builder/index.ml create mode 100644 builder/index.mli diff --git a/builder/Makefile.am b/builder/Makefile.am index 28afeee..597b943 100644 --- a/builder/Makefile.am +++ b/builder/Makefile.am @@ -40,6 +40,7 @@ SOURCES_MLI = \ cache.mli \ downloader.mli \ checksums.mli \ + index.mli \ index_parser.mli \ ini_reader.mli \ languages.mli \ @@ -54,6 +55,7 @@ SOURCES_ML = \ pxzcat.ml \ setlocale.ml \ checksums.ml \ + index.ml \ ini_reader.ml \ paths.ml \ languages.ml \ diff --git a/builder/builder.ml b/builder/builder.ml index 6f2b4bd..a30dbd1 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -40,7 +40,7 @@ let remove_duplicates index = *) let nseen = Hashtbl.create 13 in List.iter ( - fun (name, { Index_parser.arch = arch; revision = revision }) -> + fun (name, { Index.arch = arch; revision = revision }) -> let id = name, arch in try let rev = Hashtbl.find nseen id in @@ -50,7 +50,7 @@ let remove_duplicates index = Hashtbl.add nseen id revision ) index; List.filter ( - fun (name, { Index_parser.arch = arch; revision = revision }) -> + fun (name, { Index.arch = arch; revision = revision }) -> let id = name, arch in try let rev = Hashtbl.find nseen (name, arch) in @@ -165,7 +165,7 @@ let main () = } ) sources in let sources = List.append sources repos in - let index : Index_parser.index = + let index : Index.index = List.concat ( List.map ( fun source -> @@ -190,11 +190,11 @@ let main () = (match cache with | Some cache -> let l = List.filter ( - fun (_, { Index_parser.hidden = hidden }) -> + fun (_, { Index.hidden = hidden }) -> hidden <> true ) index in let l = List.map ( - fun (name, { Index_parser.revision = revision; arch = arch }) -> + fun (name, { Index.revision = revision; arch = arch }) -> (name, arch, revision) ) l in Cache.print_item_status cache ~header:true l @@ -209,7 +209,7 @@ let main () = | Some _ -> List.iter ( fun (name, - { Index_parser.revision = revision; file_uri = file_uri; + { Index.revision = revision; file_uri = file_uri; proxy = proxy }) -> let template = name, arch, revision in message (f_"Downloading: %s") file_uri; @@ -228,7 +228,7 @@ let main () = try let item = List.find ( - fun (name, { Index_parser.aliases = aliases }) -> + fun (name, { Index.aliases = aliases }) -> match aliases with | None -> false | Some l -> List.mem arg l @@ -237,19 +237,19 @@ let main () = with Not_found -> arg in let item = try List.find ( - fun (name, { Index_parser.arch = a }) -> + fun (name, { Index.arch = a }) -> name = arg && arch = a ) index with Not_found -> error (f_"cannot find os-version '%s' with architecture '%s'.\nUse --list to list available guest types.") arg arch in let entry = snd item in - let sigchecker = entry.Index_parser.sigchecker in + let sigchecker = entry.Index.sigchecker in (match mode with | `Notes -> (* --notes *) let notes = - Languages.find_notes (Languages.languages ()) entry.Index_parser.notes in + Languages.find_notes (Languages.languages ()) entry.Index.notes in (match notes with | notes :: _ -> print_endline notes @@ -267,7 +267,7 @@ let main () = (* Download the template, or it may be in the cache. *) let template = let template, delete_on_exit = - let { Index_parser.revision = revision; file_uri = file_uri; + let { Index.revision = revision; file_uri = file_uri; proxy = proxy } = entry in let template = arg, arch, revision in message (f_"Downloading: %s") file_uri; @@ -281,15 +281,15 @@ let main () = let () = match entry with (* New-style: Using a checksum. *) - | { Index_parser.checksums = Some csums } -> + | { Index.checksums = Some csums } -> Checksums.verify_checksums csums template - | { Index_parser.checksums = None } -> + | { Index.checksums = None } -> (* Old-style: detached signature. *) let sigfile = match entry with - | { Index_parser.signature_uri = None } -> None - | { Index_parser.signature_uri = Some signature_uri } -> + | { Index.signature_uri = None } -> None + | { Index.signature_uri = Some signature_uri } -> let sigfile, delete_on_exit = Downloader.download downloader signature_uri in if delete_on_exit then unlink_on_exit sigfile; @@ -303,7 +303,7 @@ let main () = (* Planner: Input tags. *) let itags = - let { Index_parser.size = size; format = format } = entry in + let { Index.size = size; format = format } = entry in let format_tag = match format with | None -> [] @@ -341,7 +341,7 @@ let main () = b, sz in let output_size = - let { Index_parser.size = original_image_size } = entry in + let { Index.size = original_image_size } = entry in let size = match size with @@ -557,7 +557,7 @@ let main () = let osize = Int64.of_string (List.assoc `Size otags) in let osize = roundup64 osize 512L in let oformat = List.assoc `Format otags in - let { Index_parser.expand = expand; lvexpand = lvexpand } = entry in + let { Index.expand = expand; lvexpand = lvexpand } = entry in message (f_"Resizing (using virt-resize) to expand the disk to %s") (human_size osize); let preallocation = if oformat = "qcow2" then Some "metadata" else None in diff --git a/builder/index.ml b/builder/index.ml new file mode 100644 index 0000000..3e8cb85 --- /dev/null +++ b/builder/index.ml @@ -0,0 +1,117 @@ +(* virt-builder + * Copyright (C) 2013-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. + *) + +open Common_gettext.Gettext +open Common_utils + +open Utils + +open Printf +open Unix + +type index = (string * entry) list (* string = "os-version" *) +and entry = { + printable_name : string option; (* the name= field *) + osinfo : string option; + file_uri : string; + arch : string; + signature_uri : string option; (* deprecated, will be removed in 1.26 *) + checksums : Checksums.csum_t list option; + revision : int; + format : string option; + size : int64; + compressed_size : int64 option; + expand : string option; + lvexpand : string option; + notes : (string * string) list; + hidden : bool; + aliases : string list option; + + sigchecker : Sigchecker.t; + proxy : Downloader.proxy_mode; +} + +let print_entry chan (name, { printable_name = printable_name; + file_uri = file_uri; + arch = arch; + osinfo = osinfo; + signature_uri = signature_uri; + checksums = checksums; + revision = revision; + format = format; + size = size; + compressed_size = compressed_size; + expand = expand; + lvexpand = lvexpand; + notes = notes; + aliases = aliases; + hidden = hidden }) = + let fp fs = fprintf chan fs in + fp "[%s]\n" name; + (match printable_name with + | None -> () + | Some name -> fp "name=%s\n" name + ); + (match osinfo with + | None -> () + | Some id -> fp "osinfo=%s\n" id + ); + fp "file=%s\n" file_uri; + fp "arch=%s\n" arch; + (match signature_uri with + | None -> () + | Some uri -> fp "sig=%s\n" uri + ); + (match checksums with + | None -> () + | Some checksums -> + List.iter ( + fun c -> + fp "checksum[%s]=%s\n" + (Checksums.string_of_csum_t c) (Checksums.string_of_csum c) + ) checksums + ); + fp "revision=%d\n" revision; + (match format with + | None -> () + | Some format -> fp "format=%s\n" format + ); + fp "size=%Ld\n" size; + (match compressed_size with + | None -> () + | Some size -> fp "compressed_size=%Ld\n" size + ); + (match expand with + | None -> () + | Some expand -> fp "expand=%s\n" expand + ); + (match lvexpand with + | None -> () + | Some lvexpand -> fp "lvexpand=%s\n" lvexpand + ); + List.iter ( + fun (lang, notes) -> + match lang with + | "" -> fp "notes=%s\n" notes + | lang -> fp "notes[%s]=%s\n" lang notes + ) notes; + (match aliases with + | None -> () + | Some l -> fp "aliases=%s\n" (String.concat " " l) + ); + if hidden then fp "hidden=true\n" diff --git a/builder/index.mli b/builder/index.mli new file mode 100644 index 0000000..10ed15a --- /dev/null +++ b/builder/index.mli @@ -0,0 +1,41 @@ +(* virt-builder + * Copyright (C) 2013-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 index = (string * entry) list (* string = "os-version" *) +and entry = { + printable_name : string option; (* the name= field *) + osinfo : string option; + file_uri : string; + arch : string; + signature_uri : string option; (* deprecated, will be removed in 1.26 *) + checksums : Checksums.csum_t list option; + revision : int; + format : string option; + size : int64; + compressed_size : int64 option; + expand : string option; + lvexpand : string option; + notes : (string * string) list; + hidden : bool; + aliases : string list option; + + sigchecker : Sigchecker.t; + proxy : Downloader.proxy_mode; +} + +val print_entry : out_channel -> (string * entry) -> unit diff --git a/builder/index_parser.ml b/builder/index_parser.ml index 1164ab5..845d0e9 100644 --- a/builder/index_parser.ml +++ b/builder/index_parser.ml @@ -24,98 +24,6 @@ open Utils open Printf open Unix -type index = (string * entry) list (* string = "os-version" *) -and entry = { - printable_name : string option; (* the name= field *) - osinfo : string option; - file_uri : string; - arch : string; - signature_uri : string option; (* deprecated, will be removed in 1.26 *) - checksums : Checksums.csum_t list option; - revision : int; - format : string option; - size : int64; - compressed_size : int64 option; - expand : string option; - lvexpand : string option; - notes : (string * string) list; - hidden : bool; - aliases : string list option; - - sigchecker : Sigchecker.t; - proxy : Downloader.proxy_mode; -} - -let print_entry chan (name, { printable_name = printable_name; - file_uri = file_uri; - arch = arch; - osinfo = osinfo; - signature_uri = signature_uri; - checksums = checksums; - revision = revision; - format = format; - size = size; - compressed_size = compressed_size; - expand = expand; - lvexpand = lvexpand; - notes = notes; - aliases = aliases; - hidden = hidden }) = - let fp fs = fprintf chan fs in - fp "[%s]\n" name; - (match printable_name with - | None -> () - | Some name -> fp "name=%s\n" name - ); - (match osinfo with - | None -> () - | Some id -> fp "osinfo=%s\n" id - ); - fp "file=%s\n" file_uri; - fp "arch=%s\n" arch; - (match signature_uri with - | None -> () - | Some uri -> fp "sig=%s\n" uri - ); - (match checksums with - | None -> () - | Some checksums -> - List.iter ( - fun c -> - fp "checksum[%s]=%s\n" - (Checksums.string_of_csum_t c) (Checksums.string_of_csum c) - ) checksums - ); - fp "revision=%d\n" revision; - (match format with - | None -> () - | Some format -> fp "format=%s\n" format - ); - fp "size=%Ld\n" size; - (match compressed_size with - | None -> () - | Some size -> fp "compressed_size=%Ld\n" size - ); - (match expand with - | None -> () - | Some expand -> fp "expand=%s\n" expand - ); - (match lvexpand with - | None -> () - | Some lvexpand -> fp "lvexpand=%s\n" lvexpand - ); - List.iter ( - fun (lang, notes) -> - match lang with - | "" -> fp "notes=%s\n" notes - | lang -> fp "notes[%s]=%s\n" lang notes - ) notes; - (match aliases with - | None -> () - | Some l -> fp "aliases=%s\n" (String.concat " " l) - ); - if hidden then fp "hidden=true\n" - let get_index ~downloader ~sigchecker { Sources.uri = uri; proxy = proxy } = let corrupt_file () = @@ -268,7 +176,7 @@ let get_index ~downloader ~sigchecker | Some c -> Some [Checksums.SHA512 c] | None -> None in - let entry = { printable_name = printable_name; + let entry = { Index.printable_name = printable_name; osinfo = osinfo; file_uri = file_uri; arch = arch; @@ -290,7 +198,7 @@ let get_index ~downloader ~sigchecker if verbose () then ( printf "index file (%s) after parsing (C parser):\n" uri; - List.iter (print_entry Pervasives.stdout) entries + List.iter (Index.print_entry Pervasives.stdout) entries ); entries diff --git a/builder/index_parser.mli b/builder/index_parser.mli index f5b98b7..b8d8ddf 100644 --- a/builder/index_parser.mli +++ b/builder/index_parser.mli @@ -16,26 +16,4 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -type index = (string * entry) list (* string = "os-version" *) -and entry = { - printable_name : string option; (* the name= field *) - osinfo : string option; - file_uri : string; - arch : string; - signature_uri : string option; (* deprecated, will be removed in 1.26 *) - checksums : Checksums.csum_t list option; - revision : int; - format : string option; - size : int64; - compressed_size : int64 option; - expand : string option; - lvexpand : string option; - notes : (string * string) list; - hidden : bool; - aliases : string list option; - - sigchecker : Sigchecker.t; - proxy : Downloader.proxy_mode; -} - -val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> index +val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> Index.index diff --git a/builder/list_entries.ml b/builder/list_entries.ml index 45c7e8b..4bb899c 100644 --- a/builder/list_entries.ml +++ b/builder/list_entries.ml @@ -29,7 +29,7 @@ let rec list_entries ~list_format ~sources index = and list_entries_short index = List.iter ( - fun (name, { Index_parser.printable_name = printable_name; + fun (name, { Index.printable_name = printable_name; arch = arch; hidden = hidden }) -> if not hidden then ( @@ -60,7 +60,7 @@ and list_entries_long ~sources index = ) sources; List.iter ( - fun (name, { Index_parser.printable_name = printable_name; + fun (name, { Index.printable_name = printable_name; arch = arch; size = size; compressed_size = compressed_size; @@ -112,7 +112,7 @@ and list_entries_json ~sources index = ) sources in let json_templates = List.map ( - fun (name, { Index_parser.printable_name = printable_name; + fun (name, { Index.printable_name = printable_name; arch = arch; size = size; compressed_size = compressed_size; diff --git a/builder/list_entries.mli b/builder/list_entries.mli index 4765f67..a3f35d3 100644 --- a/builder/list_entries.mli +++ b/builder/list_entries.mli @@ -16,4 +16,4 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -val list_entries : list_format:([ `Short | `Long | `Json ]) -> sources:Sources.source list -> Index_parser.index -> unit +val list_entries : list_format:([ `Short | `Long | `Json ]) -> sources:Sources.source list -> Index.index -> unit -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:46AM +0200, Pino Toscano wrote:
Move the index and entry definitions in an own Index module, together with the (previously internal to Index_parser) print_entry debugging function. --- builder/Makefile.am | 2 + builder/builder.ml | 36 +++++++-------- builder/index.ml | 117 +++++++++++++++++++++++++++++++++++++++++++++++ builder/index.mli | 41 +++++++++++++++++ builder/index_parser.ml | 96 +------------------------------------- builder/index_parser.mli | 24 +--------- builder/list_entries.ml | 6 +-- builder/list_entries.mli | 2 +- 8 files changed, 185 insertions(+), 139 deletions(-) create mode 100644 builder/index.ml create mode 100644 builder/index.mli
diff --git a/builder/Makefile.am b/builder/Makefile.am index 28afeee..597b943 100644 --- a/builder/Makefile.am +++ b/builder/Makefile.am @@ -40,6 +40,7 @@ SOURCES_MLI = \ cache.mli \ downloader.mli \ checksums.mli \ + index.mli \ index_parser.mli \ ini_reader.mli \ languages.mli \ @@ -54,6 +55,7 @@ SOURCES_ML = \ pxzcat.ml \ setlocale.ml \ checksums.ml \ + index.ml \ ini_reader.ml \ paths.ml \ languages.ml \ diff --git a/builder/builder.ml b/builder/builder.ml index 6f2b4bd..a30dbd1 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -40,7 +40,7 @@ let remove_duplicates index = *) let nseen = Hashtbl.create 13 in List.iter ( - fun (name, { Index_parser.arch = arch; revision = revision }) -> + fun (name, { Index.arch = arch; revision = revision }) -> let id = name, arch in try let rev = Hashtbl.find nseen id in @@ -50,7 +50,7 @@ let remove_duplicates index = Hashtbl.add nseen id revision ) index; List.filter ( - fun (name, { Index_parser.arch = arch; revision = revision }) -> + fun (name, { Index.arch = arch; revision = revision }) -> let id = name, arch in try let rev = Hashtbl.find nseen (name, arch) in @@ -165,7 +165,7 @@ let main () = } ) sources in let sources = List.append sources repos in - let index : Index_parser.index = + let index : Index.index = List.concat ( List.map ( fun source -> @@ -190,11 +190,11 @@ let main () = (match cache with | Some cache -> let l = List.filter ( - fun (_, { Index_parser.hidden = hidden }) -> + fun (_, { Index.hidden = hidden }) -> hidden <> true ) index in let l = List.map ( - fun (name, { Index_parser.revision = revision; arch = arch }) -> + fun (name, { Index.revision = revision; arch = arch }) -> (name, arch, revision) ) l in Cache.print_item_status cache ~header:true l @@ -209,7 +209,7 @@ let main () = | Some _ -> List.iter ( fun (name, - { Index_parser.revision = revision; file_uri = file_uri; + { Index.revision = revision; file_uri = file_uri; proxy = proxy }) -> let template = name, arch, revision in message (f_"Downloading: %s") file_uri; @@ -228,7 +228,7 @@ let main () = try let item = List.find ( - fun (name, { Index_parser.aliases = aliases }) -> + fun (name, { Index.aliases = aliases }) -> match aliases with | None -> false | Some l -> List.mem arg l @@ -237,19 +237,19 @@ let main () = with Not_found -> arg in let item = try List.find ( - fun (name, { Index_parser.arch = a }) -> + fun (name, { Index.arch = a }) -> name = arg && arch = a ) index with Not_found -> error (f_"cannot find os-version '%s' with architecture '%s'.\nUse --list to list available guest types.") arg arch in let entry = snd item in - let sigchecker = entry.Index_parser.sigchecker in + let sigchecker = entry.Index.sigchecker in
(match mode with | `Notes -> (* --notes *) let notes = - Languages.find_notes (Languages.languages ()) entry.Index_parser.notes in + Languages.find_notes (Languages.languages ()) entry.Index.notes in (match notes with | notes :: _ -> print_endline notes @@ -267,7 +267,7 @@ let main () = (* Download the template, or it may be in the cache. *) let template = let template, delete_on_exit = - let { Index_parser.revision = revision; file_uri = file_uri; + let { Index.revision = revision; file_uri = file_uri; proxy = proxy } = entry in let template = arg, arch, revision in message (f_"Downloading: %s") file_uri; @@ -281,15 +281,15 @@ let main () = let () = match entry with (* New-style: Using a checksum. *) - | { Index_parser.checksums = Some csums } -> + | { Index.checksums = Some csums } -> Checksums.verify_checksums csums template
- | { Index_parser.checksums = None } -> + | { Index.checksums = None } -> (* Old-style: detached signature. *) let sigfile = match entry with - | { Index_parser.signature_uri = None } -> None - | { Index_parser.signature_uri = Some signature_uri } -> + | { Index.signature_uri = None } -> None + | { Index.signature_uri = Some signature_uri } -> let sigfile, delete_on_exit = Downloader.download downloader signature_uri in if delete_on_exit then unlink_on_exit sigfile; @@ -303,7 +303,7 @@ let main () =
(* Planner: Input tags. *) let itags = - let { Index_parser.size = size; format = format } = entry in + let { Index.size = size; format = format } = entry in let format_tag = match format with | None -> [] @@ -341,7 +341,7 @@ let main () = b, sz in
let output_size = - let { Index_parser.size = original_image_size } = entry in + let { Index.size = original_image_size } = entry in
let size = match size with @@ -557,7 +557,7 @@ let main () = let osize = Int64.of_string (List.assoc `Size otags) in let osize = roundup64 osize 512L in let oformat = List.assoc `Format otags in - let { Index_parser.expand = expand; lvexpand = lvexpand } = entry in + let { Index.expand = expand; lvexpand = lvexpand } = entry in message (f_"Resizing (using virt-resize) to expand the disk to %s") (human_size osize); let preallocation = if oformat = "qcow2" then Some "metadata" else None in diff --git a/builder/index.ml b/builder/index.ml new file mode 100644 index 0000000..3e8cb85 --- /dev/null +++ b/builder/index.ml @@ -0,0 +1,117 @@ +(* virt-builder + * Copyright (C) 2013-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. + *) + +open Common_gettext.Gettext +open Common_utils + +open Utils + +open Printf +open Unix + +type index = (string * entry) list (* string = "os-version" *) +and entry = { + printable_name : string option; (* the name= field *) + osinfo : string option; + file_uri : string; + arch : string; + signature_uri : string option; (* deprecated, will be removed in 1.26 *) + checksums : Checksums.csum_t list option; + revision : int; + format : string option; + size : int64; + compressed_size : int64 option; + expand : string option; + lvexpand : string option; + notes : (string * string) list; + hidden : bool; + aliases : string list option; + + sigchecker : Sigchecker.t; + proxy : Downloader.proxy_mode; +} + +let print_entry chan (name, { printable_name = printable_name; + file_uri = file_uri; + arch = arch; + osinfo = osinfo; + signature_uri = signature_uri; + checksums = checksums; + revision = revision; + format = format; + size = size; + compressed_size = compressed_size; + expand = expand; + lvexpand = lvexpand; + notes = notes; + aliases = aliases; + hidden = hidden }) = + let fp fs = fprintf chan fs in + fp "[%s]\n" name; + (match printable_name with + | None -> () + | Some name -> fp "name=%s\n" name + ); + (match osinfo with + | None -> () + | Some id -> fp "osinfo=%s\n" id + ); + fp "file=%s\n" file_uri; + fp "arch=%s\n" arch; + (match signature_uri with + | None -> () + | Some uri -> fp "sig=%s\n" uri + ); + (match checksums with + | None -> () + | Some checksums -> + List.iter ( + fun c -> + fp "checksum[%s]=%s\n" + (Checksums.string_of_csum_t c) (Checksums.string_of_csum c) + ) checksums + ); + fp "revision=%d\n" revision; + (match format with + | None -> () + | Some format -> fp "format=%s\n" format + ); + fp "size=%Ld\n" size; + (match compressed_size with + | None -> () + | Some size -> fp "compressed_size=%Ld\n" size + ); + (match expand with + | None -> () + | Some expand -> fp "expand=%s\n" expand + ); + (match lvexpand with + | None -> () + | Some lvexpand -> fp "lvexpand=%s\n" lvexpand + ); + List.iter ( + fun (lang, notes) -> + match lang with + | "" -> fp "notes=%s\n" notes + | lang -> fp "notes[%s]=%s\n" lang notes + ) notes; + (match aliases with + | None -> () + | Some l -> fp "aliases=%s\n" (String.concat " " l) + ); + if hidden then fp "hidden=true\n" diff --git a/builder/index.mli b/builder/index.mli new file mode 100644 index 0000000..10ed15a --- /dev/null +++ b/builder/index.mli @@ -0,0 +1,41 @@ +(* virt-builder + * Copyright (C) 2013-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 index = (string * entry) list (* string = "os-version" *) +and entry = { + printable_name : string option; (* the name= field *) + osinfo : string option; + file_uri : string; + arch : string; + signature_uri : string option; (* deprecated, will be removed in 1.26 *) + checksums : Checksums.csum_t list option; + revision : int; + format : string option; + size : int64; + compressed_size : int64 option; + expand : string option; + lvexpand : string option; + notes : (string * string) list; + hidden : bool; + aliases : string list option; + + sigchecker : Sigchecker.t; + proxy : Downloader.proxy_mode; +} + +val print_entry : out_channel -> (string * entry) -> unit diff --git a/builder/index_parser.ml b/builder/index_parser.ml index 1164ab5..845d0e9 100644 --- a/builder/index_parser.ml +++ b/builder/index_parser.ml @@ -24,98 +24,6 @@ open Utils open Printf open Unix
-type index = (string * entry) list (* string = "os-version" *) -and entry = { - printable_name : string option; (* the name= field *) - osinfo : string option; - file_uri : string; - arch : string; - signature_uri : string option; (* deprecated, will be removed in 1.26 *) - checksums : Checksums.csum_t list option; - revision : int; - format : string option; - size : int64; - compressed_size : int64 option; - expand : string option; - lvexpand : string option; - notes : (string * string) list; - hidden : bool; - aliases : string list option; - - sigchecker : Sigchecker.t; - proxy : Downloader.proxy_mode; -} - -let print_entry chan (name, { printable_name = printable_name; - file_uri = file_uri; - arch = arch; - osinfo = osinfo; - signature_uri = signature_uri; - checksums = checksums; - revision = revision; - format = format; - size = size; - compressed_size = compressed_size; - expand = expand; - lvexpand = lvexpand; - notes = notes; - aliases = aliases; - hidden = hidden }) = - let fp fs = fprintf chan fs in - fp "[%s]\n" name; - (match printable_name with - | None -> () - | Some name -> fp "name=%s\n" name - ); - (match osinfo with - | None -> () - | Some id -> fp "osinfo=%s\n" id - ); - fp "file=%s\n" file_uri; - fp "arch=%s\n" arch; - (match signature_uri with - | None -> () - | Some uri -> fp "sig=%s\n" uri - ); - (match checksums with - | None -> () - | Some checksums -> - List.iter ( - fun c -> - fp "checksum[%s]=%s\n" - (Checksums.string_of_csum_t c) (Checksums.string_of_csum c) - ) checksums - ); - fp "revision=%d\n" revision; - (match format with - | None -> () - | Some format -> fp "format=%s\n" format - ); - fp "size=%Ld\n" size; - (match compressed_size with - | None -> () - | Some size -> fp "compressed_size=%Ld\n" size - ); - (match expand with - | None -> () - | Some expand -> fp "expand=%s\n" expand - ); - (match lvexpand with - | None -> () - | Some lvexpand -> fp "lvexpand=%s\n" lvexpand - ); - List.iter ( - fun (lang, notes) -> - match lang with - | "" -> fp "notes=%s\n" notes - | lang -> fp "notes[%s]=%s\n" lang notes - ) notes; - (match aliases with - | None -> () - | Some l -> fp "aliases=%s\n" (String.concat " " l) - ); - if hidden then fp "hidden=true\n" - let get_index ~downloader ~sigchecker { Sources.uri = uri; proxy = proxy } = let corrupt_file () = @@ -268,7 +176,7 @@ let get_index ~downloader ~sigchecker | Some c -> Some [Checksums.SHA512 c] | None -> None in
- let entry = { printable_name = printable_name; + let entry = { Index.printable_name = printable_name; osinfo = osinfo; file_uri = file_uri; arch = arch; @@ -290,7 +198,7 @@ let get_index ~downloader ~sigchecker
if verbose () then ( printf "index file (%s) after parsing (C parser):\n" uri; - List.iter (print_entry Pervasives.stdout) entries + List.iter (Index.print_entry Pervasives.stdout) entries );
entries diff --git a/builder/index_parser.mli b/builder/index_parser.mli index f5b98b7..b8d8ddf 100644 --- a/builder/index_parser.mli +++ b/builder/index_parser.mli @@ -16,26 +16,4 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *)
-type index = (string * entry) list (* string = "os-version" *) -and entry = { - printable_name : string option; (* the name= field *) - osinfo : string option; - file_uri : string; - arch : string; - signature_uri : string option; (* deprecated, will be removed in 1.26 *) - checksums : Checksums.csum_t list option; - revision : int; - format : string option; - size : int64; - compressed_size : int64 option; - expand : string option; - lvexpand : string option; - notes : (string * string) list; - hidden : bool; - aliases : string list option; - - sigchecker : Sigchecker.t; - proxy : Downloader.proxy_mode; -} - -val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> index +val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> Index.index diff --git a/builder/list_entries.ml b/builder/list_entries.ml index 45c7e8b..4bb899c 100644 --- a/builder/list_entries.ml +++ b/builder/list_entries.ml @@ -29,7 +29,7 @@ let rec list_entries ~list_format ~sources index =
and list_entries_short index = List.iter ( - fun (name, { Index_parser.printable_name = printable_name; + fun (name, { Index.printable_name = printable_name; arch = arch; hidden = hidden }) -> if not hidden then ( @@ -60,7 +60,7 @@ and list_entries_long ~sources index = ) sources;
List.iter ( - fun (name, { Index_parser.printable_name = printable_name; + fun (name, { Index.printable_name = printable_name; arch = arch; size = size; compressed_size = compressed_size; @@ -112,7 +112,7 @@ and list_entries_json ~sources index = ) sources in let json_templates = List.map ( - fun (name, { Index_parser.printable_name = printable_name; + fun (name, { Index.printable_name = printable_name; arch = arch; size = size; compressed_size = compressed_size; diff --git a/builder/list_entries.mli b/builder/list_entries.mli index 4765f67..a3f35d3 100644 --- a/builder/list_entries.mli +++ b/builder/list_entries.mli @@ -16,4 +16,4 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *)
-val list_entries : list_format:([ `Short | `Long | `Json ]) -> sources:Sources.source list -> Index_parser.index -> unit +val list_entries : list_format:([ `Short | `Long | `Json ]) -> sources:Sources.source list -> Index.index -> unit
Just code motion, so ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-p2v converts physical machines to virtual machines. Boot with a live CD or over the network (PXE) and turn machines into KVM guests. http://libguestfs.org/virt-v2v
--- po/POTFILES-ml | 1 + 1 file changed, 1 insertion(+) diff --git a/po/POTFILES-ml b/po/POTFILES-ml index ad52110..7933c8e 100644 --- a/po/POTFILES-ml +++ b/po/POTFILES-ml @@ -3,6 +3,7 @@ builder/cache.ml builder/checksums.ml builder/cmdline.ml builder/downloader.ml +builder/index.ml builder/index_parser.ml builder/ini_reader.ml builder/languages.ml -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:47AM +0200, Pino Toscano wrote:
--- po/POTFILES-ml | 1 + 1 file changed, 1 insertion(+)
diff --git a/po/POTFILES-ml b/po/POTFILES-ml index ad52110..7933c8e 100644 --- a/po/POTFILES-ml +++ b/po/POTFILES-ml @@ -3,6 +3,7 @@ builder/cache.ml builder/checksums.ml builder/cmdline.ml builder/downloader.ml +builder/index.ml builder/index_parser.ml builder/ini_reader.ml builder/languages.ml
Fold this into the previous patch before committing. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com libguestfs lets you edit virtual machines. Supports shell scripting, bindings from many languages. http://libguestfs.org
Useful to know whether a Sigchecker instance is verifying signatures, hence it is possible to decide whether download signed content or not. --- builder/sigchecker.ml | 3 +++ builder/sigchecker.mli | 4 ++++ 2 files changed, 7 insertions(+) diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 06c60ae..86e60ac 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -163,6 +163,9 @@ and getxdigit = function | 'A'..'F' as c -> Some (Char.code c - Char.code 'A') | _ -> None +let verifying_signatures t = + t.check_signature + let rec verify t filename = if t.check_signature then ( let args = quote filename in diff --git a/builder/sigchecker.mli b/builder/sigchecker.mli index 47bf2a3..f233514 100644 --- a/builder/sigchecker.mli +++ b/builder/sigchecker.mli @@ -20,6 +20,10 @@ type t val create : gpg:string -> gpgkey:Utils.gpgkey_type -> check_signature:bool -> t +val verifying_signatures : t -> bool +(** Return whether signatures are being verified by this + Sigchecker.t. *) + val verify : t -> string -> unit (** Verify the file is signed (if check_signature is true). *) -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:48AM +0200, Pino Toscano wrote:
Useful to know whether a Sigchecker instance is verifying signatures, hence it is possible to decide whether download signed content or not. --- builder/sigchecker.ml | 3 +++ builder/sigchecker.mli | 4 ++++ 2 files changed, 7 insertions(+)
diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 06c60ae..86e60ac 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -163,6 +163,9 @@ and getxdigit = function | 'A'..'F' as c -> Some (Char.code c - Char.code 'A') | _ -> None
+let verifying_signatures t = + t.check_signature + let rec verify t filename = if t.check_signature then ( let args = quote filename in diff --git a/builder/sigchecker.mli b/builder/sigchecker.mli index 47bf2a3..f233514 100644 --- a/builder/sigchecker.mli +++ b/builder/sigchecker.mli @@ -20,6 +20,10 @@ type t
val create : gpg:string -> gpgkey:Utils.gpgkey_type -> check_signature:bool -> t
+val verifying_signatures : t -> bool +(** Return whether signatures are being verified by this + Sigchecker.t. *) + val verify : t -> string -> unit (** Verify the file is signed (if check_signature is true). *)
Exposes a field from the 't' type, so ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html
New helper to remove the signature from a file, returning a temporary file without the signature. --- builder/sigchecker.ml | 22 ++++++++++++++++++++-- builder/sigchecker.mli | 4 ++++ 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 86e60ac..42d55cd 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -182,12 +182,30 @@ and verify_detached t filename sigfile = do_verify t args ) -and do_verify t args = +and verify_and_remove_signature t filename = + if t.check_signature then ( + (* Copy the input file as temporary file with the .asc extension, + * so gpg recognises that format. *) + let asc_file = Filename.temp_file "vbfile" ".asc" in + unlink_on_exit asc_file; + let cmd = sprintf "cp %s %s" (quote filename) (quote asc_file) in + if verbose () then printf "%s\n%!" cmd; + if Sys.command cmd <> 0 then exit 1; + let out_file = Filename.temp_file "vbfile" "" in + unlink_on_exit out_file; + let args = sprintf "--yes --output %s %s" (quote out_file) (quote filename) in + do_verify ~verify_only:false t args; + Some out_file + ) else + None + +and do_verify ?(verify_only = true) t args = let status_file = Filename.temp_file "vbstat" ".txt" in unlink_on_exit status_file; let cmd = - sprintf "%s --homedir %s --verify%s --status-file %s %s" + sprintf "%s --homedir %s %s%s --status-file %s %s" t.gpg t.gpghome + (if verify_only then "--verify" else "") (if verbose () then "" else " --batch -q --logger-file /dev/null") (quote status_file) args in if verbose () then printf "%s\n%!" cmd; diff --git a/builder/sigchecker.mli b/builder/sigchecker.mli index f233514..ac57072 100644 --- a/builder/sigchecker.mli +++ b/builder/sigchecker.mli @@ -30,3 +30,7 @@ val verify : t -> string -> unit val verify_detached : t -> string -> string option -> unit (** Verify the file is signed against the detached signature (if check_signature is true). *) + +val verify_and_remove_signature : t -> string -> string option +(** If check_signature is true, verify the file is signed and extract + the content of the file (i.e. without the signature). *) -- 2.1.0
On Tue, Jul 28, 2015 at 11:24:49AM +0200, Pino Toscano wrote:
New helper to remove the signature from a file, returning a temporary file without the signature. --- builder/sigchecker.ml | 22 ++++++++++++++++++++-- builder/sigchecker.mli | 4 ++++ 2 files changed, 24 insertions(+), 2 deletions(-)
diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 86e60ac..42d55cd 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -182,12 +182,30 @@ and verify_detached t filename sigfile = do_verify t args )
-and do_verify t args = +and verify_and_remove_signature t filename = + if t.check_signature then ( + (* Copy the input file as temporary file with the .asc extension, + * so gpg recognises that format. *) + let asc_file = Filename.temp_file "vbfile" ".asc" in + unlink_on_exit asc_file; + let cmd = sprintf "cp %s %s" (quote filename) (quote asc_file) in + if verbose () then printf "%s\n%!" cmd; + if Sys.command cmd <> 0 then exit 1; + let out_file = Filename.temp_file "vbfile" "" in + unlink_on_exit out_file; + let args = sprintf "--yes --output %s %s" (quote out_file) (quote filename) in + do_verify ~verify_only:false t args; + Some out_file + ) else + None + +and do_verify ?(verify_only = true) t args = let status_file = Filename.temp_file "vbstat" ".txt" in unlink_on_exit status_file; let cmd = - sprintf "%s --homedir %s --verify%s --status-file %s %s" + sprintf "%s --homedir %s %s%s --status-file %s %s" t.gpg t.gpghome + (if verify_only then "--verify" else "") (if verbose () then "" else " --batch -q --logger-file /dev/null") (quote status_file) args in if verbose () then printf "%s\n%!" cmd; diff --git a/builder/sigchecker.mli b/builder/sigchecker.mli index f233514..ac57072 100644 --- a/builder/sigchecker.mli +++ b/builder/sigchecker.mli @@ -30,3 +30,7 @@ val verify : t -> string -> unit val verify_detached : t -> string -> string option -> unit (** Verify the file is signed against the detached signature (if check_signature is true). *) + +val verify_and_remove_signature : t -> string -> string option +(** If check_signature is true, verify the file is signed and extract + the content of the file (i.e. without the signature). *)
Grubby, but hidden in a module so ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com Fedora Windows cross-compiler. Compile Windows programs, test, and build Windows installers. Over 100 libraries supported. http://fedoraproject.org/wiki/MinGW
Add a simple YAJL<->OCaml bridge to expose the JSON parsing function, and use it to parse the JSON indexes of the Simple Streams format. Read only datatype=image-downloads contents, and only the latest versions of each content available as disk image (disk.img or disk1.img). --- builder/Makefile.am | 13 ++- builder/builder.ml | 2 + builder/simplestreams_parser.ml | 207 +++++++++++++++++++++++++++++++++++++++ builder/simplestreams_parser.mli | 19 ++++ builder/sources.ml | 9 ++ builder/sources.mli | 1 + builder/virt-builder.pod | 7 ++ builder/yajl-c.c | 141 ++++++++++++++++++++++++++ builder/yajl.ml | 30 ++++++ builder/yajl.mli | 33 +++++++ po/POTFILES | 1 + po/POTFILES-ml | 2 + 12 files changed, 462 insertions(+), 3 deletions(-) create mode 100644 builder/simplestreams_parser.ml create mode 100644 builder/simplestreams_parser.mli create mode 100644 builder/yajl-c.c create mode 100644 builder/yajl.ml create mode 100644 builder/yajl.mli diff --git a/builder/Makefile.am b/builder/Makefile.am index 597b943..98a444f 100644 --- a/builder/Makefile.am +++ b/builder/Makefile.am @@ -48,7 +48,9 @@ SOURCES_MLI = \ pxzcat.mli \ setlocale.mli \ sigchecker.mli \ - sources.mli + simplestreams_parser.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 \ @@ -64,6 +67,7 @@ SOURCES_ML = \ downloader.ml \ sigchecker.ml \ index_parser.ml \ + simplestreams_parser.ml \ list_entries.ml \ cmdline.ml \ builder.ml @@ -81,7 +85,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 +111,8 @@ virt_builder_CFLAGS = \ -Wno-unused-macros \ $(LIBLZMA_CFLAGS) \ $(LIBTINFO_CFLAGS) \ - $(LIBXML2_CFLAGS) + $(LIBXML2_CFLAGS) \ + $(YAJL_CFLAGS) BOBJECTS = \ $(top_builddir)/mllib/libdir.cmo \ @@ -156,6 +162,7 @@ OCAMLCLIBS = \ $(LIBCRYPT_LIBS) \ $(LIBLZMA_LIBS) \ $(LIBXML2_LIBS) \ + $(YAJL_LIBS) \ $(LIBINTL) \ -lgnu diff --git a/builder/builder.ml b/builder/builder.ml index a30dbd1..1e6a426 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -175,6 +175,8 @@ let main () = match source.Sources.format with | Sources.FormatNative -> Index_parser.get_index ~downloader ~sigchecker source + | Sources.FormatSimpleStreams -> + Simplestreams_parser.get_index ~downloader ~sigchecker source ) sources ) in let index = remove_duplicates index in diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml new file mode 100644 index 0000000..5f8e725 --- /dev/null +++ b/builder/simplestreams_parser.ml @@ -0,0 +1,207 @@ +(* 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. + *) + +open Common_gettext.Gettext +open Common_utils + +open Yajl + +open Printf + +let ensure_trailing_slash str = + if String.length str > 0 && str.[String.length str - 1] <> '/' then str ^ "/" + else str + +let object_find_optional key = function + | Yajl_object o -> + (match List.filter (fun (k, _) -> k = key) (Array.to_list o) with + | [(k, v)] -> Some v + | [] -> None + | _ -> error "more than one '%s' node" key) + | _ -> error "value for key '%s' is not an object" key + +let object_find key yv = + (match object_find_optional key yv with + | None -> error "missing '%s' node" key + | Some v -> v + ) + +let object_get_string key yv = + (match object_find key yv with + | Yajl_string s -> s + | _ -> error "key '%s' is not a string" key + ) + +let object_get_string_optional key yv = + (match object_find_optional key yv with + | None -> None + | Some (Yajl_string s) -> Some s + | Some _ -> error "key '%s' is not a string" key + ) + +let object_find_object key yv = + (match object_find key yv with + | Yajl_object _ as o -> o + | _ -> error "key '%s' is not an object" key + ) + +let object_find_object_optional key yv = + (match object_find_optional key yv with + | None -> None + | Some (Yajl_object _ as o) -> Some o + | Some _ -> error "key '%s' is not an object" key + ) + +let object_find_objects fn = function + | Yajl_object o -> filter_map fn (Array.to_list o) + | _ -> error "value is not an object" + +let object_get_object key yv = + (match object_find_object key yv with + | Yajl_object o -> o + | _ -> assert false (* object_find_object already errors out. *) + ) + +let object_get_number key yv = + (match object_find key yv with + | Yajl_number n -> n + | Yajl_double d -> Int64.of_float d + | _ -> error "key '%s' is not an integer" key + ) + +let get_index ~downloader ~sigchecker + { Sources.uri = uri; proxy = proxy } = + + let uri = ensure_trailing_slash uri in + + let download_and_parse uri = + let tmpfile, delete_tmpfile = Downloader.download downloader ~proxy uri in + if delete_tmpfile then + unlink_on_exit tmpfile; + let file = + if Sigchecker.verifying_signatures sigchecker then ( + let tmpunsigned = Sigchecker.verify_and_remove_signature sigchecker tmpfile in + match tmpunsigned with + | None -> assert false (* only when not verifying signatures *) + | Some f -> f + ) else + tmpfile in + yajl_tree_parse (read_whole_file file) in + + let downloads = + let uri_index = + if Sigchecker.verifying_signatures sigchecker then + uri ^ "streams/v1/index.sjson" + else + uri ^ "streams/v1/index.json" in + let tree = download_and_parse uri_index in + + let format = object_get_string "format" tree in + if format <> "index:1.0" then + error (f_"%s does not point to a Simple Streams (index) v1.0 JSON file") uri; + + let index = Array.to_list (object_get_object "index" tree) in + filter_map ( + fun (_, desc) -> + let datatype = object_get_string "datatype" desc in + match datatype with + | "image-downloads" -> Some (object_get_string "path" desc) + | _ -> None + ) index in + + let scan_product_list path = + let tree = download_and_parse (uri ^ path) in + + let format = object_get_string "format" tree in + if format <> "products:1.0" then + error (f_"%s does not point to a Simple Streams (products) v1.0 JSON file") uri; + + let products_node = object_get_object "products" tree in + + let products = Array.to_list products_node in + filter_map ( + fun (prod, prod_desc) -> + let arch = + match object_get_string "arch" prod_desc with + | "amd64" -> "x86_64" + | a -> a in + let prods = Array.to_list (object_get_object "versions" prod_desc) in + let prods = filter_map ( + fun (rel, rel_desc) -> + let pubname = + match object_get_string_optional "pubname" rel_desc with + | Some p -> p + | None -> object_get_string "pubname" prod_desc in + let items = object_find_object "items" rel_desc in + let disk_items = object_find_objects ( + function + | (("disk.img"|"disk1.img"), v) -> Some v + | _ -> None + ) items in + (match disk_items with + | [] -> None + | disk_item :: _ -> + let disk_path = object_get_string "path" disk_item in + let disk_size = object_get_number "size" disk_item in + let checksums = object_find_objects ( + function + | ("sha256", Yajl_string c) -> Some (Checksums.SHA256 c) + | ("sha512", Yajl_string c) -> Some (Checksums.SHA512 c) + | _ -> None + ) disk_item in + let checksums = + match checksums with + | [] -> None + | x -> Some x in + let entry = { + Index.printable_name = Some pubname; + osinfo = None; + file_uri = uri ^ disk_path; + arch = arch; + signature_uri = None; + checksums = checksums; + revision = 0; (* XXX handle revisions as strings *) + format = None; + size = disk_size; + compressed_size = None; + expand = None; + lvexpand = None; + notes = []; + hidden = false; + aliases = Some [pubname;]; + sigchecker = sigchecker; + proxy = proxy; + } in + Some (rel, (prod, entry)) + ) + ) prods in + (* Select the disk image with the bigger version (i.e. usually + * the most recent one. *) + let reverse_revision_compare (rev1, _) (rev2, _) = compare rev2 rev1 in + let prods = List.sort reverse_revision_compare prods in + match prods with + | [] -> None + | (_, entry) :: _ -> Some entry + ) products in + + let entries = List.flatten (List.map scan_product_list downloads) in + if verbose () then ( + printf "simplestreams tree (%s) after parsing:\n" uri; + List.iter (Index.print_entry Pervasives.stdout) entries + ); + entries diff --git a/builder/simplestreams_parser.mli b/builder/simplestreams_parser.mli new file mode 100644 index 0000000..a4b91ba --- /dev/null +++ b/builder/simplestreams_parser.mli @@ -0,0 +1,19 @@ +(* 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. + *) + +val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> Index.index diff --git a/builder/sources.ml b/builder/sources.ml index b21e8fc..149db6f 100644 --- a/builder/sources.ml +++ b/builder/sources.ml @@ -31,6 +31,7 @@ type source = { } and source_format = | FormatNative +| FormatSimpleStreams module StringSet = Set.Make (String) @@ -82,6 +83,14 @@ let parse_conf file = try (match (List.assoc ("format", None) fields) with | "native" | "" -> FormatNative + | "simplestreams" as fmt -> + if not (Yajl.yajl_is_available ()) then ( + if verbose () then ( + eprintf (f_"%s: repository type '%s' not supported (missing YAJL support), skipping it\n") prog fmt; + ); + invalid_arg fmt + ) else + FormatSimpleStreams | fmt -> if verbose () then ( eprintf (f_"%s: unknown repository type '%s' in %s, skipping it\n") prog fmt file; diff --git a/builder/sources.mli b/builder/sources.mli index e861310..e621a9f 100644 --- a/builder/sources.mli +++ b/builder/sources.mli @@ -25,5 +25,6 @@ type source = { } and source_format = | FormatNative +| FormatSimpleStreams val read_sources : unit -> source list diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod index fc49d4d..0de643a 100644 --- a/builder/virt-builder.pod +++ b/builder/virt-builder.pod @@ -1181,6 +1181,13 @@ The possible values are: The native format of the C<virt-builder> repository. See also L</Creating and signing the index file> below. +=item B<simplestreams> + +The URI represents the root of a Simple Streams v1.0 tree of metadata. + +For more information about Simple Streams, see also +L<https://launchpad.net/simplestreams>. + =back If not present, the assumed value is C<native>. diff --git a/builder/yajl-c.c b/builder/yajl-c.c new file mode 100644 index 0000000..cb47efa --- /dev/null +++ b/builder/yajl-c.c @@ -0,0 +1,141 @@ +/* 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_tree_parse (value stringv); +extern value virt_builder_yajl_is_available (value unit); + +#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) +{ + 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) +{ + 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/po/POTFILES b/po/POTFILES index 7f1580c..8fb68a4 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..87f10ee 100644 --- a/po/POTFILES-ml +++ b/po/POTFILES-ml @@ -12,8 +12,10 @@ builder/paths.ml builder/pxzcat.ml builder/setlocale.ml builder/sigchecker.ml +builder/simplestreams_parser.ml builder/sources.ml builder/utils.ml +builder/yajl.ml customize/crypt.ml customize/customize_cmdline.ml customize/customize_main.ml -- 2.1.0
participants (2)
-
Pino Toscano -
Richard W.M. Jones