reynir/banawa-chat
1
0
Fork 0
mirror of https://github.com/reynir/banawa-chat.git synced 2024-11-21 12:27:54 +00:00
Code Issues 1 Packages Projects Releases Wiki Activity

Drop old command, share history

Browse source
This commit is contained in:
Reynir Björnsson 2023-05-04 15:39:34 +02:00
parent 9a535d897c
commit 3dbf6d4434
2 changed files with 17 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

68
unikernel.ml
View file

@ -10,48 +10,8 @@ module Main (_ : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK)
module Ssh = Banawa_mirage.Make(Stack.TCP)(T)(M)
module Nottui' = Nottui_mirage.Make(T)
let c : Message.t Lwt_condition.t = Lwt_condition.create ()
let read username ic =
let rec loop () =
let* r = ic () in
match r with
| `Data d ->
let message = Cstruct.to_string d in
if String.equal message "" then
loop ()
else
let m = Message.make ~nickname:username (String.trim message) in
Lwt_condition.broadcast c m;
loop ()
| `Eof ->
Lwt_condition.broadcast c (Message.make ~nickname:"<--" username);
Lwt.return_unit
in
loop ()
let rec write me oc =
let* m = Lwt_condition.wait c in
if String.equal (Message.nickname m) me then
write me oc
else
let* () =
oc (Printf.ksprintf Cstruct.of_string "\x07%s: %s\r\n"
(Message.nickname m) (Message.message m))
in
write me oc
let chat flow stop username ic oc =
Lwt_condition.broadcast c (Message.make ~nickname:"-->" username);
let* () = oc (Cstruct.of_string (Printf.sprintf "Hello, %s!\r\n" username)) in
let* () =
Lwt.pick [
read username ic;
write username oc;
]
in
let* () = Lwt_switch.turn_off stop in
Stack.TCP.close flow
let buffer = Rb.make 1024
let buffer_var = Lwd.var buffer
let callback flow stop t ~username r =
match r with
@ -63,8 +23,14 @@ module Main (_ : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK)
(Int32.to_int width, Int32.to_int height);
Lwt.return_unit
| Ssh.Set_env _ -> Lwt.return_unit
| Ssh.Channel { cmd=_; ic; oc; ec=_ } ->
chat flow stop username ic oc
| Ssh.Channel { cmd; ic=_; oc=_; ec } ->
let* () =
ec (Printf.ksprintf Cstruct.of_string
"Thanks for logging in! Currently, %S is unsupported\r\n\
Check back later." cmd)
in
let* () = Lwt_switch.turn_off stop in
Stack.TCP.close flow
| Ssh.Shell { ic; oc; ec=_ } ->
let ic () =
let+ r = ic () in
@ -73,25 +39,19 @@ module Main (_ : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK)
| `Eof -> `Eof
in
let cursor = Lwd.var (0, 0) in
let message m = Lwt_condition.broadcast c (Message.make ~nickname:username m) in
let buffer = Rb.make 100 in
let message m =
let msg = Message.make ~nickname:username m in
Lwd.set buffer_var (Rb.push buffer msg; buffer);
in
Rb.push buffer (Message.msgf "Welcome, %s!" username);
let buffer_var = Lwd.var buffer in
let ui =
let ( let* ) x f = Lwd.bind x ~f in
let* prompt = Prompt.make ~message cursor in
let* window = Window.make buffer_var in
Lwd.return (Nottui.Ui.vcat [window; prompt])
in
let rec handle_receive () =
let* msg = Lwt_condition.wait c in
Lwd.set buffer_var (Rb.push buffer msg; buffer);
handle_receive ()
in
Lwt_condition.broadcast c (Message.make ~nickname:"-->" username);
Lwt.join [
Nottui'.run ~cursor (t.size, t.sigwinch) ui ic oc;
handle_receive ();
]
let start _random _time _mtime stack =

4
window.ml
View file

@ -4,10 +4,12 @@ open Notty
type t = { w : int; h : int; p : int }
let render_message ~width ~width_nicknames msg =
(* (* FIXME: split doesn't work *)
let width_message =
max 1 (width - width_nicknames - 1)
in
let message = Message.split_at ~len:width_message msg in
let message = Message.split_at ~len:width_message msg in *)
let message = [Message.message msg] in
let color = A.white in
let rest =
List.map @@ fun msg ->