reynir/albatross
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

vm_console: once 'attach' is called, relay that to the fd which called attach (preparing to be able to communicate with several clients)

Browse source
This commit is contained in:
Hannes Mehnert 2018-05-02 19:52:18 +02:00
parent e25d15ee1a
commit 53b49c5856
1 changed files with 16 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
app/vmm_console.ml
View file

@ -25,23 +25,22 @@ let pp_sockaddr ppf = function
let pp_unix_error ppf e = Fmt.string ppf (Unix.error_message e) let pp_unix_error ppf e = Fmt.string ppf (Unix.error_message e)
let active = ref String.Set.empty let active = ref String.Map.empty
let read_console s name ring channel () = let read_console name ring channel () =
Lwt.catch (fun () -> Lwt.catch (fun () ->
let rec loop () = let rec loop () =
Lwt_io.read_line channel >>= fun line -> Lwt_io.read_line channel >>= fun line ->
Logs.debug (fun m -> m "read %s" line) ; Logs.debug (fun m -> m "read %s" line) ;
let t = Ptime_clock.now () in let t = Ptime_clock.now () in
Vmm_ring.write ring (t, line) ; Vmm_ring.write ring (t, line) ;
(if String.Set.mem name !active then (match String.Map.find name !active with
Vmm_lwt.write_raw s (data my_version name t line) | None -> Lwt.return_unit
else | Some fd ->
Lwt.return (Ok ())) >>= function Vmm_lwt.write_raw fd (data my_version name t line) >>= function
| Ok () -> loop () | Error _ -> Lwt.catch (fun () -> Lwt_unix.close fd) (fun _ -> Lwt.return_unit)
| Error _ -> | Ok () -> Lwt.return_unit) >>=
Logs.err (fun m -> m "error reading console") ; loop
Lwt_io.close channel
in in
loop ()) loop ())
(fun e -> (fun e ->
@ -71,28 +70,28 @@ let open_fifo name =
let t = ref String.Map.empty let t = ref String.Map.empty
let add_fifo s name = let add_fifo name =
open_fifo name >|= function open_fifo name >|= function
| Some f -> | Some f ->
let ring = Vmm_ring.create () in let ring = Vmm_ring.create () in
Logs.debug (fun m -> m "inserting %s" name) ; Logs.debug (fun m -> m "inserting %s" name) ;
let map = String.Map.add name ring !t in let map = String.Map.add name ring !t in
t := map ; t := map ;
Lwt.async (read_console s name ring f) ; Lwt.async (read_console name ring f) ;
Ok "reading" Ok "reading"
| None -> | None ->
Error (`Msg "opening") Error (`Msg "opening")
let attach name = let attach s name =
Logs.debug (fun m -> m "attempting to attach %s" name) ; Logs.debug (fun m -> m "attempting to attach %s" name) ;
match String.Map.find name !t with match String.Map.find name !t with
| None -> Lwt.return (Error (`Msg "not found")) | None -> Lwt.return (Error (`Msg "not found"))
| Some _ -> | Some _ ->
active := String.Set.add name !active ; active := String.Map.add name s !active ;
Lwt.return (Ok "attached") Lwt.return (Ok "attached")
let detach name = let detach name =
active := String.Set.remove name !active ; active := String.Map.remove name !active ;
Lwt.return (Ok "removed") Lwt.return (Ok "removed")
let history s name since = let history s name since =
@ -127,8 +126,8 @@ let handle s addr () =
| Error e -> Lwt.return (Error e) | Error e -> Lwt.return (Error e)
| Ok (name, off) -> | Ok (name, off) ->
match Console.int_to_op hdr.tag with match Console.int_to_op hdr.tag with
| Some Add_console -> add_fifo s name | Some Add_console -> add_fifo name
| Some Attach_console -> attach name | Some Attach_console -> attach s name
| Some Detach_console -> detach name | Some Detach_console -> detach name
| Some History -> | Some History ->
(match decode_ts ~off data with (match decode_ts ~off data with