9:10 a.m.
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 *)
---
builder/builder.ml | 6 +++---
builder/cache.ml | 6 ++++--
builder/cache.mli | 6 +++---
builder/downloader.mli | 2 +-
builder/index.ml | 9 +++++++--
builder/index.mli | 8 +++++++-
builder/index_parser.ml | 4 ++--
builder/list_entries.ml | 6 +++---
builder/simplestreams_parser.ml | 2 +-
9 files changed, 31 insertions(+), 18 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 3f7c79bc9..41c0a4ccc 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -94,7 +94,7 @@ let selected_cli_item cmdline index =
let item =
try List.find (
fun (name, { Index.arch = a }) ->
- name = arg && cmdline.arch = normalize_arch a
+ name = arg && cmdline.arch = normalize_arch (Index.string_of_arch a)
) index
with Not_found ->
error (f_"cannot find os-version ‘%s’ with architecture ‘%s’.\nUse --list to
list available guest types.")
@@ -252,7 +252,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
message (f_"Downloading: %s") file_uri;
let progress_bar = not (quiet ()) in
ignore (Downloader.download downloader ~template ~progress_bar
@@ -300,7 +300,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
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..d2693b943 100644
--- a/builder/cache.ml
+++ b/builder/cache.ml
@@ -41,7 +41,9 @@ let create ~directory =
}
let cache_of_name t name arch revision =
- t.directory // sprintf "%s.%s.%s" name arch (string_of_revision revision)
+ t.directory // sprintf "%s.%s.%s" name
+ (Index.string_of_arch arch)
+ (string_of_revision revision)
let is_cached t name arch revision =
let filename = cache_of_name t name arch revision in
@@ -54,6 +56,6 @@ let print_item_status t ~header l =
List.iter (
fun (name, arch, revision) ->
let cached = is_cached t name arch revision in
- printf "%-24s %-10s %s\n" name arch
+ printf "%-24s %-10s %s\n" name (Index.string_of_arch 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..a199440cb 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..65d97ea7e 100644
--- a/builder/index.ml
+++ b/builder/index.ml
@@ -30,7 +30,7 @@ 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;
@@ -46,6 +46,11 @@ and entry = {
sigchecker : Sigchecker.t;
proxy : Curl.proxy;
}
+and arch =
+ | Arch of string
+ | GuessedArch of string
+
+let string_of_arch = function Arch a | GuessedArch a -> a
let print_entry chan (name, { printable_name; file_uri; arch; osinfo;
signature_uri; checksums; revision; format;
@@ -56,7 +61,7 @@ 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;
+ fp "arch=%s\n" (string_of_arch arch);
Option.may (fp "sig=%s\n") signature_uri;
Option.may (
List.iter (
diff --git a/builder/index.mli b/builder/index.mli
index 6202d636e..df921981f 100644
--- a/builder/index.mli
+++ b/builder/index.mli
@@ -21,7 +21,7 @@ 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;
@@ -37,6 +37,12 @@ and entry = {
sigchecker : Sigchecker.t;
proxy : Curl.proxy;
}
+and arch =
+ | Arch of string
+ | GuessedArch of string
+
+val string_of_arch : arch -> string
+(** [string_of_arch a]Get the string value of [a]. *)
val print_entry : out_channel -> (string * entry) -> unit
(** Debugging helper function dumping an index entry to a stream.
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index f76aed65d..d79c807e4 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,7 @@ 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;
+ fp "arch=%s\n" (Index.string_of_arch 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..c64d554a2 100644
--- a/builder/list_entries.ml
+++ b/builder/list_entries.ml
@@ -46,7 +46,7 @@ and list_entries_short index =
fun (name, { Index.printable_name; arch; hidden }) ->
if not hidden then (
printf "%-24s" name;
- printf " %-10s" arch;
+ printf " %-10s" (Index.string_of_arch arch);
Option.may (printf " %s") printable_name;
printf "\n"
)
@@ -74,7 +74,7 @@ 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;
+ printf "%-24s %s\n" (s_"Architecture:") (Index.string_of_arch
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 +116,7 @@ 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 = ("arch", JSON.String (Index.string_of_arch arch)) :: 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..996c334f5 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 = Index.Arch (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.15.0