[Libguestfs] [PATCH v12 1/3] builder: change arch type to distinguish guesses
Richard W.M. Jones
rjones at redhat.com
Tue Nov 14 10:42:23 UTC 2017
On Mon, Nov 13, 2017 at 02:56:10PM +0100, Cédric Bosdonnat wrote:
> Change Index.arch to the type (Arch of string | GuessedArch of string).
>
> In a future commit, the index parser will allow arch not to be set
> for some cases. Thus arch value will be guessed by inspecting the
> image. However we need to distinguish between a set value and a guessed
> one. Using this new type will help it:
>
> match arch with
> | Arch s -> (* This is a set value *)
> | GuessedArch s -> (* This is a guessed value *)
This commit would be a lot simpler if you defined a ‘string_of_arch’
function in index.ml like this:
let string_of_arch = function Arch a | GuessedArch a -> a
More comments inline below.
> --- a/builder/builder.ml
> +++ b/builder/builder.ml
> @@ -94,7 +94,9 @@ let selected_cli_item cmdline index =
> let item =
> try List.find (
> fun (name, { Index.arch = a }) ->
> - name = arg && cmdline.arch = normalize_arch a
> + match a with
> + | Index.Arch a
> + | Index.GuessedArch a -> name = arg && cmdline.arch = normalize_arch a
With string_of_arch this becomes:
- name = arg && cmdline.arch = normalize_arch a
+ name = arg && cmdline.arch = normalize_arch (Index.string_of_arch a)
> @@ -252,7 +254,7 @@ let main () =
> List.iter (
> fun (name,
> { Index.revision; file_uri; proxy }) ->
> - let template = name, cmdline.arch, revision in
> + let template = name, (Index.Arch cmdline.arch), revision in
You don't need parentheses here.
Constructors like Arch behave in the same way as function application
(in SML they are actually functions, but not in OCaml), so they bind
tighter than any other operator.
> @@ -300,7 +302,7 @@ let main () =
> let template =
> let template, delete_on_exit =
> let { Index.revision; file_uri; proxy } = entry in
> - let template = arg, cmdline.arch, revision in
> + let template = arg, (Index.Arch cmdline.arch), revision in
Similarly, no parens.
> message (f_"Downloading: %s") file_uri;
> let progress_bar = not (quiet ()) in
> Downloader.download downloader ~template ~progress_bar ~proxy
> diff --git a/builder/cache.ml b/builder/cache.ml
> index dbd222fda..e313a8bcf 100644
> --- a/builder/cache.ml
> +++ b/builder/cache.ml
> @@ -41,6 +41,10 @@ let create ~directory =
> }
>
> let cache_of_name t name arch revision =
> + let arch =
> + match arch with
> + | Index.Arch arch
> + | Index.GuessedArch arch -> arch in
This can be replaced by Index.string_of_arch.
> t.directory // sprintf "%s.%s.%s" name arch (string_of_revision revision)
>
> let is_cached t name arch revision =
> @@ -54,6 +58,10 @@ let print_item_status t ~header l =
> List.iter (
> fun (name, arch, revision) ->
> let cached = is_cached t name arch revision in
> + let arch =
> + match arch with
> + | Index.Arch arch
> + | Index.GuessedArch arch -> arch in
string_of_arch
> --- a/builder/downloader.mli
> +++ b/builder/downloader.mli
> @@ -27,7 +27,7 @@ type t
> val create : curl:string -> tmpdir:string -> cache:Cache.t option -> t
> (** Create the abstract type. *)
>
> -val download : t -> ?template:(string*string*Utils.revision) -> ?progress_bar:bool -> ?proxy:Curl.proxy -> uri -> (filename * bool)
> +val download : t -> ?template:(string*Index.arch*Utils.revision) ->
More spaces needed, and I think you don't need the parens either.
> ?progress_bar:bool -> ?proxy:Curl.proxy -> uri -> (filename * bool)
You don't need parens around ‘filename * bool’.
> (** Download the URI, returning the downloaded filename and a
> temporary file flag. The temporary file flag is [true] iff
> the downloaded file is temporary and should be deleted by the
> diff --git a/builder/index.ml b/builder/index.ml
> index 84f66c265..5bc11b6f7 100644
> --- a/builder/index.ml
> +++ b/builder/index.ml
> @@ -25,12 +25,13 @@ open Utils
> open Printf
> open Unix
>
> +
> type index = (string * entry) list (* string = "os-version" *)
You've added an extra blank line.
> @@ -56,7 +60,9 @@ let print_entry chan (name, { printable_name; file_uri; arch; osinfo;
> Option.may (fp "name=%s\n") printable_name;
> Option.may (fp "osinfo=%s\n") osinfo;
> fp "file=%s\n" file_uri;
> - fp "arch=%s\n" arch;
> + match arch with
> + | Arch arch
> + | GuessedArch arch -> fp "arch=%s\n" arch;
string_of_arch could be used here.
> diff --git a/builder/index_parser.ml b/builder/index_parser.ml
> index f76aed65d..a4d1e466e 100644
> --- a/builder/index_parser.ml
> +++ b/builder/index_parser.ml
> @@ -97,7 +97,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy } =
> eprintf (f_"%s: no ‘file’ (URI) entry for ‘%s’\n") prog n;
> corrupt_file () in
> let arch =
> - try List.assoc ("arch", None) fields
> + try Index.Arch (List.assoc ("arch", None) fields)
> with Not_found ->
> eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog n;
> corrupt_file () in
> @@ -236,7 +236,9 @@ let write_entry chan (name, { Index.printable_name; file_uri; arch; osinfo;
> Option.may (fp "name=%s\n") printable_name;
> Option.may (fp "osinfo=%s\n") osinfo;
> fp "file=%s\n" file_uri;
> - fp "arch=%s\n" arch;
> + match arch with
> + | Index.Arch arch
> + | Index.GuessedArch arch -> fp "arch=%s\n" arch;
string_of_arch
> Option.may (fp "sig=%s\n") signature_uri;
> (match checksums with
> | None -> ()
> diff --git a/builder/list_entries.ml b/builder/list_entries.ml
> index af1d2419b..c0b7e48dd 100644
> --- a/builder/list_entries.ml
> +++ b/builder/list_entries.ml
> @@ -46,7 +46,9 @@ and list_entries_short index =
> fun (name, { Index.printable_name; arch; hidden }) ->
> if not hidden then (
> printf "%-24s" name;
> - printf " %-10s" arch;
> + match arch with
> + | Index.Arch arch
> + | Index.GuessedArch arch -> printf " %-10s" arch;
string_of_arch
> Option.may (printf " %s") printable_name;
> printf "\n"
> )
> @@ -74,7 +76,9 @@ and list_entries_long ~sources index =
> if not hidden then (
> printf "%-24s %s\n" "os-version:" name;
> Option.may (printf "%-24s %s\n" (s_"Full name:")) printable_name;
> - printf "%-24s %s\n" (s_"Architecture:") arch;
> + match arch with
> + | Index.Arch arch
> + | Index.GuessedArch arch -> printf "%-24s %s\n" (s_"Architecture:") arch;
string_of_arch
> printf "%-24s %s\n" (s_"Minimum/default size:") (human_size size);
> Option.may (fun size ->
> printf "%-24s %s\n" (s_"Download size:") (human_size size)
> @@ -116,7 +120,10 @@ and list_entries_json ~sources index =
> match printable_name with
> | None -> item
> | Some str -> ("full-name", JSON.String str) :: item in
> - let item = ("arch", JSON.String arch) :: item in
> + let item =
> + match arch with
> + | Index.Arch arch
> + | Index.GuessedArch arch -> ("arch", JSON.String arch) :: item in
string_of_arch
- - -
Basically the patch is fine with the changes as noted.
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
More information about the Libguestfs
mailing list