mirror of
https://github.com/reynir/banawa-chat.git
synced 2024-11-24 13:57:53 +00:00
Drop old command, share history
This commit is contained in:
parent
9a535d897c
commit
3dbf6d4434
68
unikernel.ml
68
unikernel.ml
|
@ -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 Ssh = Banawa_mirage.Make(Stack.TCP)(T)(M)
|
||||||
module Nottui' = Nottui_mirage.Make(T)
|
module Nottui' = Nottui_mirage.Make(T)
|
||||||
|
|
||||||
let c : Message.t Lwt_condition.t = Lwt_condition.create ()
|
let buffer = Rb.make 1024
|
||||||
|
let buffer_var = Lwd.var buffer
|
||||||
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 callback flow stop t ~username r =
|
let callback flow stop t ~username r =
|
||||||
match r with
|
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);
|
(Int32.to_int width, Int32.to_int height);
|
||||||
Lwt.return_unit
|
Lwt.return_unit
|
||||||
| Ssh.Set_env _ -> Lwt.return_unit
|
| Ssh.Set_env _ -> Lwt.return_unit
|
||||||
| Ssh.Channel { cmd=_; ic; oc; ec=_ } ->
|
| Ssh.Channel { cmd; ic=_; oc=_; ec } ->
|
||||||
chat flow stop username ic oc
|
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=_ } ->
|
| Ssh.Shell { ic; oc; ec=_ } ->
|
||||||
let ic () =
|
let ic () =
|
||||||
let+ r = ic () in
|
let+ r = ic () in
|
||||||
|
@ -73,25 +39,19 @@ module Main (_ : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK)
|
||||||
| `Eof -> `Eof
|
| `Eof -> `Eof
|
||||||
in
|
in
|
||||||
let cursor = Lwd.var (0, 0) in
|
let cursor = Lwd.var (0, 0) in
|
||||||
let message m = Lwt_condition.broadcast c (Message.make ~nickname:username m) in
|
let message m =
|
||||||
let buffer = Rb.make 100 in
|
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);
|
Rb.push buffer (Message.msgf "Welcome, %s!" username);
|
||||||
let buffer_var = Lwd.var buffer in
|
|
||||||
let ui =
|
let ui =
|
||||||
let ( let* ) x f = Lwd.bind x ~f in
|
let ( let* ) x f = Lwd.bind x ~f in
|
||||||
let* prompt = Prompt.make ~message cursor in
|
let* prompt = Prompt.make ~message cursor in
|
||||||
let* window = Window.make buffer_var in
|
let* window = Window.make buffer_var in
|
||||||
Lwd.return (Nottui.Ui.vcat [window; prompt])
|
Lwd.return (Nottui.Ui.vcat [window; prompt])
|
||||||
in
|
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 [
|
Lwt.join [
|
||||||
Nottui'.run ~cursor (t.size, t.sigwinch) ui ic oc;
|
Nottui'.run ~cursor (t.size, t.sigwinch) ui ic oc;
|
||||||
handle_receive ();
|
|
||||||
]
|
]
|
||||||
|
|
||||||
let start _random _time _mtime stack =
|
let start _random _time _mtime stack =
|
||||||
|
|
|
@ -4,10 +4,12 @@ open Notty
|
||||||
type t = { w : int; h : int; p : int }
|
type t = { w : int; h : int; p : int }
|
||||||
|
|
||||||
let render_message ~width ~width_nicknames msg =
|
let render_message ~width ~width_nicknames msg =
|
||||||
|
(* (* FIXME: split doesn't work *)
|
||||||
let width_message =
|
let width_message =
|
||||||
max 1 (width - width_nicknames - 1)
|
max 1 (width - width_nicknames - 1)
|
||||||
in
|
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 color = A.white in
|
||||||
let rest =
|
let rest =
|
||||||
List.map @@ fun msg ->
|
List.map @@ fun msg ->
|
||||||
|
|
Loading…
Reference in a new issue