Merge pull request #69 from dinosaure/mirage.4.6.0

dinosaure · web-flow · commit eafb94e62729 · 2024-07-17T19:44:03.000+02:00
Upgrade the unikernel to mirasge.4.6.0
diff --git a/mirage/config.ml b/mirage/config.ml
@@ -1,28 +1,17 @@
-open Mirage
+(* mirage >= 4.6.0 & < 4.6.1 *)
 
-let port =
-  let doc =
-    Key.Arg.info ~doc:"Set the port where the relay will listen."
-      [ "p"; "port" ]
-  in
-  Key.(create "port" Arg.(opt int 9000 doc))
+open Mirage
 
-let secure_port =
-  let doc =
-    Key.Arg.info ~doc:"The port of the relay where secured rooms are available."
-      [ "secure-port" ]
-  in
-  Key.(create "secure_port" Arg.(opt int 9001 doc))
+let setup = runtime_arg ~pos:__POS__ "Unikernel.K.setup"
 
 let bob =
-  foreign "Unikernel.Make"
+  main "Unikernel.Make" ~runtime_args:[ setup ]
     ~packages:
       [
         package "bob" ~pin:"git+https://github.com/dinosaure/bob.git";
         package "spoke" ~sublibs:[ "core" ];
         package "psq";
       ]
-    ~keys:[ Key.v port; Key.v secure_port ]
     (time @-> stackv4v6 @-> job)
 
 let time = default_time
diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml
@@ -1,5 +1,28 @@
 open Lwt.Infix
 
+module K = struct
+  open Cmdliner
+
+  let port =
+    let doc =
+      Arg.info ~doc:"Set the port where the relay will listen." [ "p"; "port" ]
+    in
+    Arg.(value & opt int 9000 doc)
+
+  let secure_port =
+    let doc =
+      Arg.info
+        ~doc:"The port of the relay where the secured rooms are available."
+        [ "secure-port" ]
+    in
+    Arg.(value & opt int 9001 doc)
+
+  type t = { port : int; secure_port : int }
+
+  let v port secure_port = { port; secure_port }
+  let setup = Term.(const v $ port $ secure_port)
+end
+
 module Psq =
   Psq.Make
     (String)
@@ -444,14 +467,12 @@ module Make (Time : Mirage_time.S) (Stack : Tcpip.Stack.V4V6) = struct
 
   module Bob_clear = Make (Stack.TCP)
 
-  let start _time stack =
+  let start _time stack { K.port; K.secure_port } =
     let rooms = Bob.Secured.make () in
     let handshake socket = Lwt.return (Ok (socket, Stack.TCP.dst socket)) in
     Lwt.join
       [
-        Bob_clear.relay ~port:(Key_gen.port ()) ~handshake (Stack.tcp stack)
-          rooms;
-        Secured.secure_room ~port:(Key_gen.secure_port ()) (Stack.tcp stack)
-          rooms;
+        Bob_clear.relay ~port ~handshake (Stack.tcp stack) rooms;
+        Secured.secure_room ~port:secure_port (Stack.tcp stack) rooms;
       ]
 end
