Be able to stop the server via a Lwt_switch.t

mirage/awa_mirage.ml

@@ -312,16 +312,22 @@ module Make (F : Mirage_flow.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) =
         let t = { t with channels = c :: t.channels } in
         nexus t fd server input_buffer (List.append pending_promises [ Lwt_mvar.take t.nexus_mbox ])
 
-  let spawn_server server msgs fd exec_callback =
+  let spawn_server ?stop server msgs fd exec_callback =
     let t = { exec_callback;
               channels = [];
               nexus_mbox = Lwt_mvar.create_empty ()
             }
     in
+    let open Lwt.Syntax in
+    let* switched_off =
+      let thread, u = Lwt.wait () in
+      Lwt_switch.add_hook_or_exec stop (fun () ->
+        Lwt.wakeup_later u Net_eof;
+        Lwt_list.iter_p sshin_eof t.channels) >|= fun () -> thread in
     send_msgs fd server msgs >>= fun server ->
     (* the ssh communication will start with 'net_read' and can only add a 'Lwt.take' promise when
      * one Awa.Server.Channel_{exec,subsystem} is received
      *)
-    nexus t fd server (Cstruct.create 0) [ net_read fd ]
+    nexus t fd server (Cstruct.create 0) [ switched_off; net_read fd ]
 
 end

mirage/awa_mirage.mli

@@ -40,8 +40,28 @@ module Make (F : Mirage_flow.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) :
     (Cstruct.t -> unit Lwt.t) ->  (* ssherr *)
     unit Lwt.t
 
-  val spawn_server : Awa.Server.t -> Awa.Ssh.message list -> F.flow ->
+  val spawn_server : ?stop:Lwt_switch.t -> Awa.Server.t -> Awa.Ssh.message list -> F.flow ->
     exec_callback -> t Lwt.t
+  (** [spawn_server ?stop server msgs flow callback] launches an {i internal}
+      SSH channels handler which can be stopped by [stop]. This SSH channels
+      handler will call [callback] for every new channels requested by the
+      client. [msgs] are the SSH {i hello} given by {!val:Awa.Server.make} which
+      returns also a {!type:Awa.Server.t} required here.
+
+      A basic usage of [spawn_server] is:
+      {[
+        let ssh_channel_handler _cmd _ic _oc _ec =
+          Lwt.return_unit
+
+        let tcp_handler flow =
+          let server, msgs = Awa.Server.make private_key db in
+          SSH.spawn_server server msgs flow ssh_handler >>= fun _t ->
+          close flow
+      ]}
+
+      {b NOTE}: Even if the [ssh_channel_handler] is fulfilled, [spawn_server]
+      continues to handle SSH channels. Only [stop] can really stop the internal
+      SSH channels handler. *)
 
 end
   with module FLOW = F