swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-04 18:50:58 +01:00
parent c9ca55bf5a
commit f12d678968
1 changed files with 10 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

12
unikernel/unikernel.ml
View file

@ -25,22 +25,20 @@ let alpn =
Mirage_runtime.register_arg Mirage_runtime.register_arg
Arg.(value & opt_all (enum (List.map (fun v -> (v, v)) alpns)) alpns doc) Arg.(value & opt_all (enum (List.map (fun v -> (v, v)) alpns)) alpns doc)
let ( <.> ) f g x = f (g x)
let always x _ = x
let map_err_to_string pp_err res = let map_err_to_string pp_err res =
Lwt.map (R.reword_error (R.msgf "%a" pp_err)) res Lwt.map (R.reword_error (R.msgf "%a" pp_err)) res
let list_get_ok l = let list_get_ok l =
let err = ref None in let err = ref None in
try try
l Ok
|> List.map (function (List.map
(function
| Error _e as e -> | Error _e as e ->
err := Some e; err := Some e;
raise Exit raise Exit
| Ok v -> v) | Ok v -> v)
|> Result.ok l)
with Exit -> ( match !err with None -> assert false | Some v -> v) with Exit -> ( match !err with None -> assert false | Some v -> v)
let lwt_list_get_ok l = let lwt_list_get_ok l =
@ -197,6 +195,8 @@ struct
| [ certchain ] -> `Single certchain | [ certchain ] -> `Single certchain
| certchains -> `Multiple certchains | certchains -> `Multiple certchains
let always x _ = x
let http_1_1_request_handler ~ctx ~authenticator flow _edn = let http_1_1_request_handler ~ctx ~authenticator flow _edn =
let module R = (val Mimic.repr HTTP_server.tcp_protocol) in let module R = (val Mimic.repr HTTP_server.tcp_protocol) in
fun reqd -> fun reqd ->