Libguestfs - Jul 2015 - [PATCH 03/10] builder: add SHA256 support in Checksums

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

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

---
 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

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

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

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

---
 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

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

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: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

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

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

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

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

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

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

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

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