reynir/banawa-chat
1
0
Fork 0
mirror of https://github.com/reynir/banawa-chat.git synced 2024-11-22 04:47:53 +00:00
Code Issues 1 Packages Projects Releases Wiki Activity

Update to mirage 4.7, banawa-mirage changes

Browse source
This commit is contained in:
Reynir Björnsson 2024-09-19 15:44:07 +02:00
parent 3f43398866
commit 2db6ae5378
2 changed files with 23 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
config.ml
View file

@ -1,17 +1,14 @@
(* mirage >= 4.7.0 *)
open Mirage open Mirage
let port =
let doc = Key.Arg.info ~doc:"The TCP port for listening for SSH connections" ["port"] in
Key.(create "port" Arg.(opt int 22 doc))
let hostkey =
let doc = Key.Arg.info ~doc:"SSH host key" ["hostkey"] in
Key.(create "hostkey" Arg.(required string doc))
let main = let main =
let runtime_args = [
runtime_arg ~pos:__POS__ "Unikernel.K.port";
runtime_arg ~pos:__POS__ "Unikernel.K.hostkey";
] in
let packages = [ let packages = [
package "banawa" ~pin:"git+https://github.com/sorbusursina/banawa-ssh.git"; package "awa" ~pin:"git+https://github.com/reynir/awa-ssh.git#banawa";
package "banawa-mirage" ~pin:"git+https://github.com/sorbusursina/banawa-ssh.git"; package "banawa-mirage" ~pin:"git+https://github.com/sorbusursina/banawa-ssh.git#awa";
package "notty"; package "notty";
package "nottui" package "nottui"
~pin:"git+https://github.com/dinosaure/lwd.git#9e78758d5987597bac65fe73bd30ff80741cfe83"; ~pin:"git+https://github.com/dinosaure/lwd.git#9e78758d5987597bac65fe73bd30ff80741cfe83";
@ -19,8 +16,7 @@ let main =
~pin:"git+https://github.com/dinosaure/lwd.git#9e78758d5987597bac65fe73bd30ff80741cfe83"; ~pin:"git+https://github.com/dinosaure/lwd.git#9e78758d5987597bac65fe73bd30ff80741cfe83";
package "art"; package "art";
] in ] in
let keys = [ Key.v port ; Key.v hostkey ] in main ~runtime_args ~packages "Unikernel.Main" (random @-> time @-> mclock @-> stackv4v6 @-> job)
foreign ~keys ~packages "Unikernel.Main" (random @-> time @-> mclock @-> stackv4v6 @-> job)
let () = let () =
register "banawa-chat" [ register "banawa-chat" [

22
unikernel.ml
View file

@ -6,7 +6,18 @@ type state =
; mutable size : int * int ; mutable size : int * int
} }
module Main (_ : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) (Stack : Tcpip.Stack.V4V6) = struct module K = struct
open Cmdliner
let port =
let doc = Arg.info ~doc:"The TCP port for listening for SSH connections" ["port"] in
Arg.(value & opt int 22 doc)
let hostkey =
let doc = Arg.info ~doc:"SSH host key" ["hostkey"] in
Arg.(required & opt (some string) None doc)
end
module Main (_ : Mirage_crypto_rng_mirage.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) (Stack : Tcpip.Stack.V4V6) = struct
module Ssh = Banawa_mirage.Make(Stack.TCP)(T)(M) module Ssh = Banawa_mirage.Make(Stack.TCP)(T)(M)
module Nottui' = Nottui_mirage.Make(T) module Nottui' = Nottui_mirage.Make(T)
@ -59,17 +70,14 @@ module Main (_ : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK)
Nottui'.run ~cursor (t.size, t.sigwinch) ui ic oc; Nottui'.run ~cursor (t.size, t.sigwinch) ui ic oc;
] ]
let start _random _time _mtime stack = let start _random _time _mtime stack port hostkey =
let port = Key_gen.port () in
let user_db = Banawa.Auth.Db.create 20 in
let hostkey = Key_gen.hostkey () in
let hostkey = let hostkey =
match Banawa.Keys.of_string hostkey with match Awa.Keys.of_string hostkey with
| Ok k -> k | Ok k -> k
| Error `Msg e -> | Error `Msg e ->
Logs.err (fun m -> m "%s" e); exit 1 Logs.err (fun m -> m "%s" e); exit 1
in in
let server, msgs = Banawa.Server.make hostkey user_db in let server, msgs = Awa.Server.make hostkey in
Stack.TCP.listen (Stack.tcp stack) ~port Stack.TCP.listen (Stack.tcp stack) ~port
(fun flow -> (fun flow ->
let stop = Lwt_switch.create () in let stop = Lwt_switch.create () in