From 3dbf6d4434d7b50e01d50890b3cd917c892a9744 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Thu, 4 May 2023 15:39:34 +0200 Subject: [PATCH] Drop old command, share history --- unikernel.ml | 68 +++++++++++----------------------------------------- window.ml | 4 +++- 2 files changed, 17 insertions(+), 55 deletions(-) diff --git a/unikernel.ml b/unikernel.ml index 4a2fff0..e3bc93e 100644 --- a/unikernel.ml +++ b/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 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 = diff --git a/window.ml b/window.ml index 9a8ae07..978f642 100644 --- a/window.ml +++ b/window.ml @@ -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 ->