终止另一个线程的Lwt线程

Question

这里我有一个函数，它接受TCP连接并运行两个Lwt线程handle_connection和send_message。每次连接终止时，我都会在handle_connection线程中收到通知，因此我可以终止它的循环，但随后我想终止整个连接<&>线程，以便在下一个serv递归调用中进一步使用另一个连接。

let create_server sock =
  let rec serve () =
    Lwt_unix.accept sock
    >>= (fun (fd, _) ->
          connection := true;
          let ic = Lwt_io.of_fd ~mode:Lwt_io.Input fd in
          let oc = Lwt_io.of_fd ~mode:Lwt_io.Output fd in
          handle_connection ic oc <&> send_message oc)
    >>= serve
  in
  serve ()

问题是，如何在每次handle_connection终止时强制send_message线程终止?

let handle_connection ic oc =
  Lwt.on_failure (handle_message ic oc "client") (fun e ->
      Logs.err (fun m -> m "%s" (Printexc.to_string e)));
  Logs_lwt.info (fun m -> m "New connection")

let rec send_message oc =
  let* s = read_console () in
  Lwt_io.write_line oc s >>= fun _ -> send_message oc)

我已经尝试使用Lwt.choose而不是Lwt.join，当客户端断开连接时，它会传递到下一个连接，但send_message线程仍然在终止的连接上运行。

Answer 1

我犹豫对此发表评论，因为我怀疑您已经知道这一点，但是作为一般原则的问题，您有条件地等待Lwt中的承诺的最基本方式是使用Lwt.wait构建承诺，然后使用操作符let*或操作符>>=绑定承诺，直到承诺的解析器通过Lwt.wakeup_later或(在您的特殊情况下)使用Lwt.wakeup_later_exn拒绝它。或者，在后一种情况下，您可以使用Lwt.task构建承诺，并通过Lwt.cancel取消直接拒绝承诺，但我认为取消现在不赞成或至少不鼓励。

有一个Lwt.pick函数，在一个承诺被履行时，将取消任何其他受pick约束的承诺，但这与你想要的相反。这意味着我认为你将不得不重构你的代码来公开条件承诺。