[Libguestfs] [PATCH v2 1/9] mltools: Checksums.verify_checksum{, s} returns an error type instead of throwing exception.

[Richard W.M. Jones]

Simple code refactoring, making it both more difficult to ignore the
error case and easier to add other error cases in future.
---
 builder/builder.ml           |  9 +++++----
 common/mltools/checksums.ml  | 17 +++++++++++++----
 common/mltools/checksums.mli | 16 +++++++++++-----
 v2v/input_ova.ml             | 10 ++++++----
 4 files changed, 35 insertions(+), 17 deletions(-)

diff --git a/builder/builder.ml b/builder/builder.ml
index 478b41bba..83c7aefed 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -313,10 +313,11 @@ let main () =
     match entry with
     (* New-style: Using a checksum. *)
     | { Index.checksums = Some csums } ->
-      (try Checksums.verify_checksums csums template
-      with Checksums.Mismatched_checksum (csum, csum_actual) ->
-        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!")
-          (Checksums.string_of_csum_t csum) csum_actual (Checksums.string_of_csum csum)
+      (match Checksums.verify_checksums csums template with
+       | Checksums.Good_checksum -> ()
+       | Checksums.Mismatched_checksum (csum, csum_actual) ->
+          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!")
+                (Checksums.string_of_csum_t csum) csum_actual (Checksums.string_of_csum csum)
       )
 
     | { Index.checksums = None } ->
diff --git a/common/mltools/checksums.ml b/common/mltools/checksums.ml
index a40edca76..4dd69e734 100644
--- a/common/mltools/checksums.ml
+++ b/common/mltools/checksums.ml
@@ -27,7 +27,9 @@ type csum_t =
 | SHA256 of string
 | SHA512 of string
 
-exception Mismatched_checksum of (csum_t * string)
+type csum_result =
+  | Good_checksum
+  | Mismatched_checksum of csum_t * string
 
 let string_of_csum_t = function
   | SHA1 _ -> "sha1"
@@ -73,8 +75,15 @@ let compute_checksum csum_type ?tar filename =
 let verify_checksum csum ?tar filename =
   let csum_type = string_of_csum_t csum in
   let csum_actual = compute_checksum csum_type ?tar filename in
-  if csum <> csum_actual then
-    raise (Mismatched_checksum (csum, (string_of_csum csum_actual)))
+  if csum = csum_actual then
+    Good_checksum
+  else
+    Mismatched_checksum (csum, string_of_csum csum_actual)
 
 let verify_checksums checksums filename =
-  List.iter (fun c -> verify_checksum c filename) checksums
+  List.fold_left (
+    fun acc c ->
+      match acc with
+      | Good_checksum -> verify_checksum c filename
+      | Mismatched_checksum _ as acc -> acc
+  ) Good_checksum checksums
diff --git a/common/mltools/checksums.mli b/common/mltools/checksums.mli
index 92336a18b..d45b29dfd 100644
--- a/common/mltools/checksums.mli
+++ b/common/mltools/checksums.mli
@@ -21,7 +21,10 @@ type csum_t =
 | SHA256 of string
 | SHA512 of string
 
-exception Mismatched_checksum of (csum_t * string) (* expected checksum, got *)
+type csum_result =
+  | Good_checksum
+  (* expected checksum, actual checksum. *)
+  | Mismatched_checksum of csum_t * string
 
 val of_string : string -> string -> csum_t
 (** [of_string type value] returns the [csum_t] for the specified
@@ -29,14 +32,17 @@ val of_string : string -> string -> csum_t
 
     Raise [Invalid_argument] if the checksum type is not known. *)
 
-val verify_checksum : csum_t -> ?tar:string -> string -> unit
-(** [verify_checksum type filename] Verify the checksum of the file.
+val verify_checksum : csum_t -> ?tar:string -> string -> csum_result
+(** [verify_checksum type filename] verifies the checksum of the file.
 
     When optional [tar] is used it is path to uncompressed tar archive
     and the [filename] is a path in the tar archive. *)
 
-val verify_checksums : csum_t list -> string -> unit
-(** Verify all the checksums of the file. *)
+val verify_checksums : csum_t list -> string -> csum_result
+(** Verify all the checksums of the file.
+
+    If any checksum fails, the first failure (only) is returned in
+    {!csum_result}. *)
 
 val string_of_csum_t : csum_t -> string
 (** Return a string representation of the checksum type. *)
diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml
index a909b92ed..59dbe6f5f 100644
--- a/v2v/input_ova.ml
+++ b/v2v/input_ova.ml
@@ -224,15 +224,17 @@ object
                 and disk = PCRE.sub 2
                 and expected = PCRE.sub 3 in
                 let csum = Checksums.of_string mode expected in
-                try
+                match
                   if partial then
                     Checksums.verify_checksum csum
                                               ~tar:ova (mf_subfolder // disk)
                   else
                     Checksums.verify_checksum csum (mf_folder // disk)
-                with Checksums.Mismatched_checksum (_, actual) ->
-                  error (f_"checksum of disk %s does not match manifest %s (actual %s(%s) = %s, expected %s(%s) = %s)")
-                        disk mf mode disk actual mode disk expected;
+                with
+                | Checksums.Good_checksum -> ()
+                | Checksums.Mismatched_checksum (_, actual) ->
+                   error (f_"checksum of disk %s does not match manifest %s (actual %s(%s) = %s, expected %s(%s) = %s)")
+                         disk mf mode disk actual mode disk expected;
               )
               else
                 warning (f_"unable to parse line from manifest file: %S") line;
-- 
2.16.2