[Libguestfs] [PATCH v11 3/8] builder: change arch type to (string, string option) maybe.

In a future commit, the index parser will allow arch not to be set for some cases. In such cases, it will be guessed by inspecting the image, but we need to distinguish between a set value and a guessed one. Using the '(string, string option) maybe' type will help it: match arch with | Either s -> (* This is a set value *) | Or Some s -> (* This is a guessed value *) | Or None -> (* No value and no guess *) --- builder/builder.ml | 9 ++++++--- builder/cache.ml | 10 ++++++++++ builder/cache.mli | 6 +++--- builder/downloader.mli | 2 +- builder/index.ml | 13 +++++++++++-- builder/index.mli | 7 ++++++- builder/index_parser.ml | 2 +- builder/list_entries.ml | 16 +++++++++++++--- builder/simplestreams_parser.ml | 2 +- 9 files changed, 52 insertions(+), 15 deletions(-) diff --git a/builder/builder.ml b/builder/builder.ml index 3f7c79bc9..519cdbc79 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -94,7 +94,10 @@ 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 + | Either a + | Or Some a -> name = arg && cmdline.arch = normalize_arch a + | Or None -> false ) index with Not_found -> error (f_"cannot find os-version ‘%s’ with architecture ‘%s’.\nUse --list to list available guest types.") @@ -252,7 +255,7 @@ let main () = List.iter ( fun (name, { Index.revision; file_uri; proxy }) -> - let template = name, cmdline.arch, revision in + let template = name, (Either cmdline.arch), revision in message (f_"Downloading: %s") file_uri; let progress_bar = not (quiet ()) in ignore (Downloader.download downloader ~template ~progress_bar @@ -300,7 +303,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, (Either cmdline.arch), revision in 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..c4a6b0578 100644 --- a/builder/cache.ml +++ b/builder/cache.ml @@ -41,6 +41,11 @@ let create ~directory = } let cache_of_name t name arch revision = + let arch = + match arch with + | Either arch + | Or Some arch -> arch + | Or None -> "" in t.directory // sprintf "%s.%s.%s" name arch (string_of_revision revision) let is_cached t name arch revision = @@ -54,6 +59,11 @@ 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 + | Either arch + | Or Some arch -> arch + | Or None -> "" in printf "%-24s %-10s %s\n" name arch (if cached then s_"cached" else (*s_*)"no") ) l diff --git a/builder/cache.mli b/builder/cache.mli index f27fc235b..f88cbdf2f 100644 --- a/builder/cache.mli +++ b/builder/cache.mli @@ -27,16 +27,16 @@ type t val create : directory:string -> t (** Create the abstract type. *) -val cache_of_name : t -> string -> string -> Utils.revision -> string +val cache_of_name : t -> string -> Index.arch -> Utils.revision -> string (** [cache_of_name t name arch revision] return the filename of the cached file. (Note: It doesn't check if the filename exists, this is just a simple string transformation). *) -val is_cached : t -> string -> string -> Utils.revision -> bool +val is_cached : t -> string -> Index.arch -> Utils.revision -> bool (** [is_cached t name arch revision] return whether the file with specified name, architecture and revision is cached. *) -val print_item_status : t -> header:bool -> (string * string * Utils.revision) list -> unit +val print_item_status : t -> header:bool -> (string * Index.arch * Utils.revision) list -> unit (** [print_item_status t header items] print the status in the cache of the specified items (which are tuples of name, architecture, and revision). diff --git a/builder/downloader.mli b/builder/downloader.mli index 7f39f7e36..e2dd49f27 100644 --- 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) -> ?progress_bar:bool -> ?proxy:Curl.proxy -> uri -> (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..18e653534 100644 --- a/builder/index.ml +++ b/builder/index.ml @@ -25,12 +25,18 @@ open Utils open Printf open Unix + +(* Either string -> value set + Or Some string -> value guessed + Or None -> value neither set nor guessed + *) +type arch = (string, string option) Std_utils.maybe 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; + arch : arch; signature_uri : string option; (* deprecated, will be removed in 1.26 *) checksums : Checksums.csum_t list option; revision : Utils.revision; @@ -56,7 +62,10 @@ 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 + | Either arch + | Or Some arch -> fp "arch=%s\n" arch; + | Or None -> (); Option.may (fp "sig=%s\n") signature_uri; Option.may ( List.iter ( diff --git a/builder/index.mli b/builder/index.mli index ff5ec4a35..43d5485fb 100644 --- a/builder/index.mli +++ b/builder/index.mli @@ -16,12 +16,17 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +(* Either string -> value set + Or Some string -> value guessed + Or None -> value neither set nor guessed + *) +type arch = (string, string option) Std_utils.maybe 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; + arch : arch; signature_uri : string option; (* deprecated, will be removed in 1.26 *) checksums : Checksums.csum_t list option; revision : Utils.revision; diff --git a/builder/index_parser.ml b/builder/index_parser.ml index d6a4e2e86..c715ccac7 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 Either (List.assoc ("arch", None) fields) with Not_found -> eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog n; corrupt_file () in diff --git a/builder/list_entries.ml b/builder/list_entries.ml index af1d2419b..54983df8d 100644 --- a/builder/list_entries.ml +++ b/builder/list_entries.ml @@ -46,7 +46,10 @@ 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 + | Either arch + | Or Some arch -> printf " %-10s" arch + | Or None -> (); Option.may (printf " %s") printable_name; printf "\n" ) @@ -74,7 +77,10 @@ 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 + | Either arch + | Or Some arch -> printf "%-24s %s\n" (s_"Architecture:") arch + | Or None -> (); 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 +122,11 @@ 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 + | Either arch + | Or Some arch -> ("arch", JSON.String arch) :: item + | Or None -> item in let item = ("size", JSON.Int64 size) :: item in let item = match compressed_size with diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml index 75592e377..10721e49c 100644 --- a/builder/simplestreams_parser.ml +++ b/builder/simplestreams_parser.ml @@ -83,7 +83,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy } = let products = Array.to_list products_node in filter_map ( fun (prod, prod_desc) -> - let arch = object_get_string "arch" prod_desc in + let arch = Either (object_get_string "arch" prod_desc) in let prods = Array.to_list (object_get_object "versions" prod_desc) in let prods = filter_map ( fun (rel, rel_desc) -> -- 2.13.2