From 831c86be5ebc906259d824983bb3eb97b4a6cbf3 Mon Sep 17 00:00:00 2001 From: swrup Date: Tue, 4 Nov 2025 19:28:34 +0100 Subject: [PATCH] --- unikernel/unikernel.ml | 48 ++++++++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 16 deletions(-) diff --git a/unikernel/unikernel.ml b/unikernel/unikernel.ml index e7729709..52e61ec0 100644 --- a/unikernel/unikernel.ml +++ b/unikernel/unikernel.ml @@ -123,26 +123,49 @@ struct (Fmt.list Fmt.string) l in let* ext_l = - let ll = + let* hd, tl = l |> List.map (fun (_, _, v) -> v) |> List.map (List.sort String.compare) + |> function + | [] -> + Fmt.error_msg "directory `%s` is empty" + (Mirage_kv.Key.to_string dir) + | hd :: tl -> Ok (hd, tl) in - match List.sort_uniq Stdlib.compare ll with - | [ l ] -> Ok l - | [] -> assert false - | _ll -> + match List.for_all (( = ) hd) tl with + | false -> Fmt.error_msg "directory `%s` does not has the same set of file extensions for \ each language" (Mirage_kv.Key.to_string dir) + | true -> Ok hd in Ok (etag, lang_l, ext_l) let assets ro = - let*? terms_assoc = get ro "terms" in - let*? privacy_assoc = get ro "privacy" in - Lwt_result.return (terms_assoc, privacy_assoc) + let*? terms_etag, terms_lang_l, terms_ext_l = get ro "terms" in + let*? privacy_etag, privacy_lang_l, privacy_ext_l = get ro "privacy" in + Lwt.return + @@ + let open Result.Syntax in + let* lang_l = + match terms_lang_l = privacy_lang_l with + | false -> + Fmt.error_msg + "terms and privacy directories does not support the same set of \ + languages" + | true -> Ok terms_lang_l + in + let ext_l = + match terms_ext_l = privacy_ext_l with + | false -> + Fmt.error_msg + "terms and privacy directories does not support the same set of \ + mimetype" + | true -> Ok terms_ext_l + in + Ok (terms_etag, privacy_etag, lang_l, ext_l) end let tls certificate_ro key_ro = @@ -255,14 +278,7 @@ struct let* assets_res = Assets.assets assets_ro in match assets_res with | Error (`Msg m) -> Fmt.failwith "Assets configuration error: %s." m - | Ok (_terms, _privacy) -> ( - (* - let etag, lang_l, ext_l = terms in - Fmt.pr "ETAG: %s@\nlanguages: %a@\nextensions: %a@." etag - (Fmt.list ~sep:(Fmt.any ", ") Fmt.string) - lang_l - (Fmt.list ~sep:(Fmt.any ", ") Fmt.string) - ext_l; *) + | Ok (_terms_etag, _privacy_etag, _lang_l, _ext_l) -> ( let* tls_res = tls certificate_ro key_ro in match use_tls () with | false -> run ~ctx ~authenticator http_server