From f4d9f8e6186a39469e7857973b268ad25b67270d Mon Sep 17 00:00:00 2001 From: swrup Date: Thu, 30 Oct 2025 15:51:03 +0100 Subject: [PATCH] fmt --- .ocamlformat | 15 +++++++++++ .ocamlformat-ignore | 1 + Makefile | 64 +++++++++++++++++++++++++++++++++++++++++++++ config.ml | 9 +++---- connect.ml | 52 ++++++++++++++++++------------------ dune | 3 +++ server.ml | 31 ++++++++-------------- unikernel.ml | 4 +-- 8 files changed, 124 insertions(+), 55 deletions(-) create mode 100644 .ocamlformat create mode 100644 .ocamlformat-ignore create mode 100644 Makefile create mode 100644 dune diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 00000000..4d907d30 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,15 @@ +version=0.28.1 +exp-grouping=preserve +type-decl=sparse +break-infix=fit-or-vertical +break-collection-expressions=wrap +break-sequences=false +break-infix-before-func=false +dock-collection-brackets=true +break-separators=after +field-space=tight +if-then-else=compact +break-sequences=false +sequence-blank-line=compact +exp-grouping=preserve +sequence-blank-line=preserve-one diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore new file mode 100644 index 00000000..adfe12f6 --- /dev/null +++ b/.ocamlformat-ignore @@ -0,0 +1 @@ +dist/dune diff --git a/Makefile b/Makefile new file mode 100644 index 00000000..ae409341 --- /dev/null +++ b/Makefile @@ -0,0 +1,64 @@ +# Generated by mirage.v4.10.3 + +-include Makefile.user +BUILD_DIR = ./ +MIRAGE_DIR = ./mirage +UNIKERNEL_NAME = minipaf-unix +OPAM = opam + +all:: + @$(MAKE) --no-print-directory depends + @$(MAKE) --no-print-directory build + +.PHONY: all lock install-switch pull clean depend depends build repo-add repo-rm depext-lockfile + +repo-add: + @printf "\033[2musing overlay repository mirage: [opam-overlays, mirage-overlays] \033[0m\n" + $(OPAM) repo add opam-overlays https://github.com/dune-universe/opam-overlays.git || $(OPAM) repo set-url opam-overlays https://github.com/dune-universe/opam-overlays.git + $(OPAM) repo add mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git || $(OPAM) repo set-url mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git + + +repo-rm: + @printf "\033[2mremoving overlay repository [opam-overlays, mirage-overlays]\033[0m\n" + $(OPAM) repo remove opam-overlays https://github.com/dune-universe/opam-overlays.git + $(OPAM) repo remove mirage-overlays https://github.com/dune-universe/mirage-opam-overlays.git + + + +depext-lockfile: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked + echo " ↳ install external dependencies for monorepo" + env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo depext -y -l $< + + +$(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam + @$(MAKE) -s repo-add + @echo " ↳ generate lockfile for monorepo dependencies" + @env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo lock --require-cross-compile --build-only $(UNIKERNEL_NAME) -l $@ --ocaml-version $(shell ocamlc --version); (ret=$$?; $(MAKE) -s repo-rm && exit $$ret) + +lock:: + @$(MAKE) -B $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked + @echo "The lock file has been generated. Run 'make pull' to retrieve the sources, or 'make install-switch' to install the host dependencies." + +pull:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam.locked + @echo " ↳ fetch monorepo dependencies in the duniverse folder" + @env OPAMVAR_monorepo="opam-monorepo" $(OPAM) monorepo pull -l $< -r $(abspath $(BUILD_DIR)) + @echo "The sources have been pulled to the duniverse folder. Run 'make build' to build the unikernel." + +install-switch:: $(MIRAGE_DIR)/$(UNIKERNEL_NAME).opam + @echo " ↳ opam install switch dependencies" + @$(OPAM) install $< --deps-only --yes + @$(MAKE) -s depext-lockfile + @echo "The dependencies have been installed. Run 'make build' to build the unikernel." + +depends depend:: + @$(MAKE) --no-print-directory lock + @$(MAKE) --no-print-directory install-switch + @$(MAKE) --no-print-directory pull + +build:: + dune build --profile release --root . $(BUILD_DIR)dist + @echo "Your unikernel binary is now ready in $(BUILD_DIR)dist/minipaf" + @echo "Execute the binary using solo5-hvt, solo5-spt, xl, ..." + +clean:: + mirage clean diff --git a/config.ml b/config.ml index f14405ff..a7da04ce 100644 --- a/config.ml +++ b/config.ml @@ -9,12 +9,9 @@ let minipaf = main "Unikernel.Make" ~packages: [ - package "digestif"; - package ~min:"0.0.9" "mimic-happy-eyeballs"; - package "hxd" ~sublibs:[ "core"; "string" ]; - package "rresult"; - package "h2" ~min:"0.13.0"; - package "base64" ~sublibs:[ "rfc2045" ]; + package "digestif"; package ~min:"0.0.9" "mimic-happy-eyeballs"; + package "hxd" ~sublibs:[ "core"; "string" ]; package "rresult"; + package "h2" ~min:"0.13.0"; package "base64" ~sublibs:[ "rfc2045" ]; ] (kv_ro @-> kv_ro @-> tcpv4v6 @-> conn @-> http_server @-> job) diff --git a/connect.ml b/connect.ml index b36472fd..3060fe1b 100644 --- a/connect.ml +++ b/connect.ml @@ -20,7 +20,10 @@ struct type endpoint = Happy_eyeballs.t * string * int type nonrec write_error = - [ `Write of write_error | `Connect of string | `Closed ] + [ `Write of write_error + | `Connect of string + | `Closed + ] let pp_write_error ppf = function | `Connect err -> Fmt.string ppf err @@ -82,10 +85,8 @@ struct Mimic.fold tcp_edn Mimic.Fun. [ - req Happy_eyeballs.happy_eyeballs; - req connect_scheme; - req connect_hostname; - dft connect_port 80; + req Happy_eyeballs.happy_eyeballs; req connect_scheme; + req connect_hostname; dft connect_port 80; ] ~k:k0 ctx in @@ -93,11 +94,8 @@ struct Mimic.fold tls_edn Mimic.Fun. [ - req Happy_eyeballs.happy_eyeballs; - req connect_scheme; - req connect_hostname; - dft connect_port 443; - req connect_tls_config; + req Happy_eyeballs.happy_eyeballs; req connect_scheme; + req connect_hostname; dft connect_port 443; req connect_tls_config; ] ~k:k1 ctx in @@ -117,25 +115,25 @@ let decode_uri ~ctx uri = else Error (`Msg "Couldn't decode user and password")) >>= fun (_scheme, ctx) -> (match String.split_on_char '@' user_pass_host_port with - | [ host_port ] -> Ok (None, host_port) - | [ _user_pass; host_port ] -> Ok (None, host_port) - | _ -> Error (`Msg "Couldn't decode URI")) + | [ host_port ] -> Ok (None, host_port) + | [ _user_pass; host_port ] -> Ok (None, host_port) + | _ -> Error (`Msg "Couldn't decode URI")) >>= fun (_user_pass, host_port) -> (match String.split_on_char ':' host_port with - | [] -> Error (`Msg "Empty host & port") - | [ hostname ] -> Ok (hostname, Mimic.add connect_hostname hostname ctx) - | hd :: tl -> ( - let port, hostname = - match List.rev (hd :: tl) with - | hd :: tl -> (hd, String.concat ":" (List.rev tl)) - | _ -> assert false - in - try - Ok - ( hostname, - Mimic.add connect_hostname hostname - (Mimic.add connect_port (int_of_string port) ctx) ) - with Failure _ -> Error (`Msg "Couldn't decode port"))) + | [] -> Error (`Msg "Empty host & port") + | [ hostname ] -> Ok (hostname, Mimic.add connect_hostname hostname ctx) + | hd :: tl -> ( + let port, hostname = + match List.rev (hd :: tl) with + | hd :: tl -> (hd, String.concat ":" (List.rev tl)) + | _ -> assert false + in + try + Ok + ( hostname, + Mimic.add connect_hostname hostname + (Mimic.add connect_port (int_of_string port) ctx) ) + with Failure _ -> Error (`Msg "Couldn't decode port"))) >>= fun (hostname, ctx) -> Ok (ctx, hostname) | _ -> Error (`Msg "Couldn't decode URI on top") diff --git a/dune b/dune new file mode 100644 index 00000000..d336b137 --- /dev/null +++ b/dune @@ -0,0 +1,3 @@ +;; Generated by mirage.v4.10.3 + +(include dune.build) diff --git a/server.ml b/server.ml index 700c6bc4..c91f0c8f 100644 --- a/server.ml +++ b/server.ml @@ -66,7 +66,7 @@ let transmit_random ~write_string ~flush ~close_writer | 0L -> finalize ctx (Base64_rfc2045.encode encoder `End) | length -> let len = min (Int64.of_int (Cstruct.length rnd)) length in - let ({ Cstruct.buffer; off; len = buffer_len } as rnd) = + let ({ Cstruct.buffer; off; len= buffer_len } as rnd) = random_cstruct ~g rnd (Int64.to_int len) in Log.debug (fun m -> @@ -115,7 +115,7 @@ let hash ~version ~create ?seed length = (response, Digestif.SHA256.(to_hex (get ctx))) | length -> let len = min (Int64.of_int (Cstruct.length rnd)) length in - let { Cstruct.buffer; off; len = buffer_len } = + let { Cstruct.buffer; off; len= buffer_len } = random_cstruct ~g rnd (Int64.to_int len) in Log.debug (fun m -> @@ -257,7 +257,7 @@ module S_HTTP_1_1 = struct let with_etag etag response = let headers = response.H1.Response.headers in - { response with H1.Response.headers = H1.Headers.add headers "etag" etag } + { response with H1.Response.headers= H1.Headers.add headers "etag" etag } let with_status (status : H2.Status.t) response = match status with @@ -266,9 +266,7 @@ module S_HTTP_1_1 = struct end let transmit src dst = - let rec on_eof () = - H1.Body.Reader.close src; - H1.Body.Writer.close dst + let rec on_eof () = H1.Body.Reader.close src; H1.Body.Writer.close dst and on_read buf ~off ~len = H1.Body.Writer.write_bigstring dst ~off ~len buf; H1.Body.Reader.schedule_read src ~on_eof ~on_read @@ -300,8 +298,7 @@ let connect_http_1_1 ~ctx ~authenticator ~to_close flow reqd = H1.Headers.of_list [ ("content-length", string_of_int (String.length contents)); - ("connection", "close"); - ("content-type", "text/plain"); + ("connection", "close"); ("content-type", "text/plain"); ] in let response = @@ -315,8 +312,7 @@ let connect_http_1_1 ~ctx ~authenticator ~to_close flow reqd = H1.Headers.of_list [ ("content-length", string_of_int (String.length contents)); - ("connection", "close"); - ("content-type", "text/plain"); + ("connection", "close"); ("content-type", "text/plain"); ] in let response = @@ -341,8 +337,7 @@ let http_1_1_request_handler ~ctx ~authenticator ~to_close = H1.Headers.of_list [ ("content-length", string_of_int (String.length root)); - ("connection", "close"); - ("content-type", "text/plain"); + ("connection", "close"); ("content-type", "text/plain"); ] in let response = H1.Response.create ~reason:"root" ~headers `OK in @@ -401,8 +396,7 @@ let http_1_1_request_handler ~ctx ~authenticator ~to_close = H1.Headers.of_list [ ("content-length", string_of_int (String.length contents)); - ("connection", "close"); - ("content-type", "text/plain"); + ("connection", "close"); ("content-type", "text/plain"); ] in let response = @@ -414,8 +408,7 @@ let http_1_1_request_handler ~ctx ~authenticator ~to_close = let headers = H1.Headers.of_list [ - ("content-type", "text/plain"); - ("connection", "close"); + ("content-type", "text/plain"); ("connection", "close"); ("content-length", string_of_int (String.length contents)); ] in @@ -438,15 +431,13 @@ module S_HTTP_2_0 = struct let with_etag etag response = let headers = response.H2.Response.headers in - { response with H2.Response.headers = H2.Headers.add headers "etag" etag } + { response with H2.Response.headers= H2.Headers.add headers "etag" etag } let with_status status response = { response with H2.Response.status } end let transmit src dst = - let rec on_eof () = - H2.Body.Reader.close src; - H2.Body.Writer.close dst + let rec on_eof () = H2.Body.Reader.close src; H2.Body.Writer.close dst and on_read buf ~off ~len = H2.Body.Writer.write_bigstring dst ~off ~len buf; H2.Body.Reader.schedule_read src ~on_eof ~on_read diff --git a/unikernel.ml b/unikernel.ml index a936a947..2dd96b02 100644 --- a/unikernel.ml +++ b/unikernel.ml @@ -111,8 +111,8 @@ struct | _ -> () in { - Alpn.error = Server.alpn_error_handler; - Alpn.request = + Alpn.error= Server.alpn_error_handler; + Alpn.request= (fun flow edn reqd protocol -> Server.alpn_request_handler ~ctx ~authenticator ~to_close (R.T flow) edn reqd protocol);