diff --git a/mirage/opam_file.ml b/mirage/opam_file.ml index e08f252..1489523 100644 --- a/mirage/opam_file.ml +++ b/mirage/opam_file.ml @@ -13,17 +13,22 @@ let hex_of_string s = let decode_digest filename str = let hex h s = match hex_of_string s with - | Ok d -> Some (h, d) - | Error `Msg msg -> - Log.warn (fun m -> m "%s invalid hex (%s) %s" filename msg s); None + | Ok d -> Ok (h, d) + | Error `Msg msg as e -> + Log.warn (fun m -> m "%s invalid hex (%s) %s" filename msg s); + e in match String.split_on_char '=' str with | [ data ] -> hex `MD5 data | [ "md5" ; data ] -> hex `MD5 data | [ "sha256" ; data ] -> hex `SHA256 data | [ "sha512" ; data ] -> hex `SHA512 data - | [ hash ; _ ] -> Log.warn (fun m -> m "%s unknown hash %s" filename hash); None - | _ -> Log.warn (fun m -> m "%s unexpected hash format %S" filename str); None + | [ hash ; _ ] -> + Log.warn (fun m -> m "%s unknown hash %s" filename hash); + Error (`Msg ("unknown hash " ^ hash)) + | _ -> + Log.warn (fun m -> m "%s unexpected hash format %S" filename str); + Error (`Msg ("unexpected hash format " ^ str)) let extract_url_checksum filename items = let open OpamParserTypes.FullPos in @@ -42,64 +47,73 @@ let extract_url_checksum filename items = in let url = match url, archive with - | Some { pelem = Variable (_, { pelem = String url ; _ }) ; _ }, None -> Some url - | None, Some { pelem = Variable (_, { pelem = String url ; _ }); _ } -> Some url + | Some { pelem = Variable (_, { pelem = String url ; _ }) ; _ }, None -> Ok url + | None, Some { pelem = Variable (_, { pelem = String url ; _ }); _ } -> Ok url | _ -> - Log.warn (fun m -> m "%s neither src nor archive present" filename); None + Log.warn (fun m -> m "%s neither src nor archive present" filename); + Error (`Msg "neither 'src' nor 'archive' present") in - let csum = + let csum, csum_errs = match checksum with | Some { pelem = Variable (_, { pelem = List { pelem = csums ; _ } ; _ }); _ } -> - let csums = - List.fold_left (fun acc -> + let csums, errs = + List.fold_left (fun (csums, errs) -> function | { pelem = String csum ; _ } -> begin match decode_digest filename csum with - | None -> acc - | Some (h, v) -> + | Error e -> csums, e :: errs + | Ok (h, v) -> HM.update h (function | None -> Some v | Some v' when String.equal v v' -> None | Some v' -> Log.warn (fun m -> m "for %s, hash %s, multiple keys are present: %s %s" - (Option.value ~default:"NONE" url) (hash_to_string h) (Ohex.encode v) (Ohex.encode v')); + (Result.value ~default:"NONE" url) (hash_to_string h) (Ohex.encode v) (Ohex.encode v')); None) - acc + csums, errs end - | _ -> acc) HM.empty csums + | v -> + csums, `Msg (Fmt.str "bad checksum data: %s" (OpamPrinter.FullPos.value v)) :: errs) + (HM.empty, []) csums in - Some csums + if HM.is_empty csums then + match errs with + | hd :: tl -> Error hd, tl + | [] -> Error (`Msg "empty checksums"), [] + else + Ok csums, errs | Some { pelem = Variable (_, { pelem = String csum ; _ }) ; _ } -> begin match decode_digest filename csum with - | None -> None - | Some (h, v) -> Some (HM.singleton h v) + | Error _ as e -> e, [] + | Ok (h, v) -> Ok (HM.singleton h v), [] end | _ -> Log.warn (fun m -> m "couldn't decode checksum in %s" filename); - None + Error (`Msg "couldn't find or decode 'checksum'"), [] in - match url, csum with - | Some url, Some cs -> Some (url, cs) - | _ -> None + (match url, csum with + | Ok url, Ok csum -> Ok (url, csum) + | Error _ as e, _ + | _, (Error _ as e) -> e), csum_errs let extract_checksums_and_urls filename opam = let open OpamParserTypes.FullPos in - List.fold_left (fun acc -> + List.fold_left (fun (csum_urls, errs) -> function | { pelem = Section ({ section_kind = { pelem = "url" ; _ } ; section_items = { pelem = items ; _ } ; _ }) ; _} -> begin match extract_url_checksum filename items with - | None -> acc - | Some url -> url :: acc + | Error `Msg msg, errs' -> csum_urls, `Msg ("url: " ^ msg) :: errs' @ errs + | Ok url, errs' -> url :: csum_urls, errs' @ errs end | { pelem = Section ({ section_kind = { pelem = "extra-source" ; _ } ; section_name = Some { pelem ; _ } ; section_items = { pelem = items ; _ }; _ }) ; _} -> begin Log.debug (fun m -> m "extracting for extra-source %s in %s" filename pelem); match extract_url_checksum filename items with - | None -> acc - | Some url -> url :: acc + | Error `Msg msg, errs' -> csum_urls, `Msg ("extra-source " ^ pelem ^ " " ^ msg) :: errs' @ errs + | Ok url, errs' -> url :: csum_urls, errs' @ errs end - | _ -> acc) - [] opam.file_contents + | _ -> csum_urls, errs) + ([], []) opam.file_contents let extract_urls filename str = (* in an opam file, there may be: @@ -121,6 +135,6 @@ let extract_urls filename str = in if unavailable then (Log.debug (fun m -> m "%s is marked unavailable, skipping" filename); - []) + [], []) else extract_checksums_and_urls filename opamfile diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml index 4fac591..fe86de3 100644 --- a/mirage/unikernel.ml +++ b/mirage/unikernel.ml @@ -101,6 +101,11 @@ module Make hash_to_string h ^ "=" ^ Ohex.encode v ^ "\n" ^ acc) hm "" + let parse_errors = ref SM.empty + + let add_parse_error filename error = + parse_errors := SM.add filename error !parse_errors + module Git = struct let contents store = let explore = ref [ Mirage_kv.Key.empty ] in @@ -135,31 +140,32 @@ module Make let find_urls acc path data = if Mirage_kv.Key.basename path = "opam" then - (* TODO: parser errors are logged (should be reported to status page) *) - (try - let url_csums = Opam_file.extract_urls (Mirage_kv.Key.to_string path) data in - List.fold_left (fun acc (url, csums) -> - if HM.cardinal csums = 0 then - (Logs.warn (fun m -> m "no checksums for %s, ignoring" url); acc) - else - SM.update url (function - | None -> Some csums - | Some csums' -> - if HM.for_all (fun h v -> - match HM.find_opt h csums with - | None -> true | Some v' -> String.equal v v') - csums' - then - Some (HM.union (fun _h v _v' -> Some v) csums csums') - else begin - Logs.warn (fun m -> m "mismatching hashes for %s: %s vs %s" - url (hm_to_s csums') (hm_to_s csums)); - None - end) acc) acc url_csums - with exn -> - Logs.warn (fun m -> m "some error in %a, ignoring %s" - Mirage_kv.Key.pp path (Printexc.to_string exn)); - acc) + let path = Mirage_kv.Key.to_string path in + let url_csums, errs = Opam_file.extract_urls path data in + List.iter (fun (`Msg msg) -> add_parse_error path msg) errs; + List.fold_left (fun acc (url, csums) -> + if HM.cardinal csums = 0 then + (Logs.warn (fun m -> m "no checksums for %s, ignoring" url); + add_parse_error path ("no checksums for " ^ url); + acc) + else + SM.update url (function + | None -> Some csums + | Some csums' -> + if HM.for_all (fun h v -> + match HM.find_opt h csums with + | None -> true | Some v' -> String.equal v v') + csums' + then + Some (HM.union (fun _h v _v' -> Some v) csums csums') + else begin + Logs.warn (fun m -> m "mismatching hashes for %s: %s vs %s" + url (hm_to_s csums') (hm_to_s csums)); + add_parse_error path (Fmt.str + "mismatching hashes for %s: %s vs %s" + url (hm_to_s csums') (hm_to_s csums)); + None + end) acc) acc url_csums else acc @@ -654,27 +660,37 @@ stamp: %S (SM.cardinal disk.Disk.md5s) (KV.free disk.Disk.dev) in + let sort_by_ts a b = Ptime.compare a b in let active_downloads = let header = "

Active downloads

" + header ^ String.concat "" content ^ "" and failed_downloads = let header = "

Failed downloads

" + header ^ String.concat "" content ^ "" + and parse_errors = + let header = "

Parse errors

" in "Opam-mirror status page

Opam mirror status

" - ^ String.concat "
" [ archive_stats ; active_downloads ; failed_downloads ] + ^ String.concat "
" [ archive_stats ; active_downloads ; failed_downloads ; parse_errors ] ^ "
" let not_modified request (modified, etag) =