Merge pull request #308 from djs55/lwt.3.0.0

Compatibility with lwt >= 2.7.0
mirage · May 14, 2017 · b55d510 · b55d510
2 parents a4f60ae + 13b9908
commit b55d510
Show file tree

Hide file tree

Showing 6 changed files with 59 additions and 53 deletions.
diff --git a/.travis.yml b/.travis.yml
@@ -3,6 +3,7 @@ script: bash -ex .travis-ci.sh
 sudo: required
 env:
   global:
+  - EXTRA_REMOTES="https://github.com/djs55/mirage-dev.git#fix-revdeps"
   matrix:
   - OCAML_VERSION=4.03 PACKAGE=tcpip MIRAGE_MODE=unix
   - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.03 PACKAGE=tcpip MIRAGE_MODE=xen

diff --git a/opam b/opam
@@ -63,7 +63,7 @@ depends: [
   "pcap-format" {test}
   "mirage-clock-unix" {test & >= "1.2.0"}
   "fmt"
-  "lwt" {>= "2.4.7" & < "3.0.0" }
+  "lwt" {>= "2.7.0"}
   "logs" {>= "0.6.0"}
   "duration"
   "randomconv"

diff --git a/unix/icmpv4_socket.ml b/unix/icmpv4_socket.ml
@@ -63,7 +63,7 @@ let input t ~src ~dst:_ buf =
 let listen _t addr fn =
   let fd = Lwt_unix.(socket PF_INET SOCK_DGRAM) ipproto_icmp in
   let sa = Lwt_unix.ADDR_INET (Unix.inet_addr_of_string (Ipaddr.V4.to_string addr), port) in
-  let () = Lwt_unix.bind fd sa in
+  Lwt_unix.Versioned.bind_2 fd sa >>= fun () ->
   Log.debug (fun f -> f "Bound ICMP file descriptor to %a" pp_sockaddr sa);
   let aux fn =
     let receive_buffer = Cstruct.create 4096 in

diff --git a/unix/tcpip_stack_socket.ml b/unix/tcpip_stack_socket.ml
@@ -76,26 +76,29 @@ let listen_udpv4 t ~port callback =
   if port < 0 || port > 65535 then
     raise (Invalid_argument (err_invalid_port port))
   else
-    let fd = Udpv4.get_udpv4_listening_fd t.udpv4 port in
-    let buf = Cstruct.create 4096 in
-    let rec loop () =
-      let continue () =
-        (* TODO cancellation *)
-        if true then loop () else return_unit in
-      Lwt_cstruct.recvfrom fd buf []
-      >>= fun (len, sa) ->
-      let buf = Cstruct.sub buf 0 len in
-      begin match sa with
-            | Lwt_unix.ADDR_INET (addr, src_port) ->
-               let src = Ipaddr_unix.V4.of_inet_addr_exn addr in
-               let dst = Ipaddr.V4.any in (* TODO *)
-               callback ~src ~dst ~src_port buf
-            | _ -> return_unit
-      end >>= fun () ->
-      continue ()
-    in
     (* FIXME: we should not ignore the result *)
-    ignore_result (loop ())
+    ignore_result (
+      Udpv4.get_udpv4_listening_fd t.udpv4 port
+      >>= fun fd ->
+      let buf = Cstruct.create 4096 in
+      let rec loop () =
+        let continue () =
+          (* TODO cancellation *)
+          if true then loop () else return_unit in
+        Lwt_cstruct.recvfrom fd buf []
+        >>= fun (len, sa) ->
+        let buf = Cstruct.sub buf 0 len in
+        begin match sa with
+              | Lwt_unix.ADDR_INET (addr, src_port) ->
+                 let src = Ipaddr_unix.V4.of_inet_addr_exn addr in
+                 let dst = Ipaddr.V4.any in (* TODO *)
+                 callback ~src ~dst ~src_port buf
+              | _ -> return_unit
+        end >>= fun () ->
+        continue ()
+      in
+      loop ()
+    )
 
 let listen_tcpv4 _t ~port callback =
   if port < 0 || port > 65535 then
@@ -105,25 +108,27 @@ let listen_tcpv4 _t ~port callback =
     Lwt_unix.setsockopt fd Lwt_unix.SO_REUSEADDR true;
     (* TODO: as elsewhere in the module, we bind all available addresses; it would be better not to do so if the user has requested it *)
     let interface = Ipaddr_unix.V4.to_inet_addr Ipaddr.V4.any in
-    Lwt_unix.bind fd (Lwt_unix.ADDR_INET (interface, port));
-    Lwt_unix.listen fd 10;
-    let rec loop () =
-      let continue () =
-        (* TODO cancellation *)
-        if true then loop () else return_unit in
-      Lwt_unix.accept fd
-      >>= fun (afd, _) ->
-      Lwt.async (fun () ->
-                 Lwt.catch
-                   (fun () -> callback afd)
-                   (fun _ -> return_unit)
-                );
-      return_unit
-      >>= fun () ->
-      continue ();
-    in
     (* FIXME: we should not ignore the result *)
-    ignore_result (loop ())
+    ignore_result (
+      Lwt_unix.Versioned.bind_2 fd (Lwt_unix.ADDR_INET (interface, port))
+      >>= fun () ->
+      Lwt_unix.listen fd 10;
+      let rec loop () =
+        let continue () =
+          (* TODO cancellation *)
+          if true then loop () else return_unit in
+        Lwt_unix.accept fd
+        >>= fun (afd, _) ->
+        Lwt.async (fun () ->
+                   Lwt.catch
+                     (fun () -> callback afd)
+                     (fun _ -> return_unit)
+                  );
+        return_unit
+        >>= fun () ->
+        continue () in
+      loop ()
+    )
 
 let listen _t =
   let t, _ = Lwt.task () in

diff --git a/unix/udpv4_socket.ml b/unix/udpv4_socket.ml
@@ -32,12 +32,13 @@ type t = {
 
 let get_udpv4_listening_fd {listen_fds;interface} port =
   try
-    Hashtbl.find listen_fds (interface,port)
+    Lwt.return @@ Hashtbl.find listen_fds (interface,port)
   with Not_found ->
     let fd = Lwt_unix.(socket PF_INET SOCK_DGRAM 0) in
-    Lwt_unix.bind fd (Lwt_unix.ADDR_INET (interface, port));
+    Lwt_unix.Versioned.bind_2 fd (Lwt_unix.ADDR_INET (interface, port))
+    >>= fun () ->
     Hashtbl.add listen_fds (interface, port) fd;
-    fd
+    Lwt.return fd
 
 
 type error = [`Sendto_failed]
@@ -76,9 +77,8 @@ let write ?src_port ~dst ~dst_port t buf =
     | 0 -> return @@ Error `Sendto_failed
     | n -> write_to_fd fd (Cstruct.sub buf n (Cstruct.len buf - n)) (* keep trying *)
   in
-  let fd =
-    match src_port with
+  ( match src_port with
     | None -> get_udpv4_listening_fd t 0
-    | Some port -> get_udpv4_listening_fd t port
-  in
+    | Some port -> get_udpv4_listening_fd t port )
+  >>= fun fd ->
   write_to_fd fd buf
diff --git a/unix/udpv6_socket.ml b/unix/udpv6_socket.ml
@@ -32,12 +32,13 @@ type t = {
 
 let get_udpv6_listening_fd {listen_fds;interface} port =
   try
-    Hashtbl.find listen_fds (interface,port)
+    Lwt.return @@ Hashtbl.find listen_fds (interface,port)
   with Not_found ->
     let fd = Lwt_unix.(socket PF_INET6 SOCK_DGRAM 0) in
-    Lwt_unix.bind fd (Lwt_unix.ADDR_INET (interface,port));
+    Lwt_unix.Versioned.bind_2 fd (Lwt_unix.ADDR_INET (interface,port))
+    >>= fun () ->
     Hashtbl.add listen_fds (interface,port) fd;
-    fd
+    Lwt.return fd
 
 (** IO operation errors *)
 type error = [
@@ -68,11 +69,10 @@ let id { interface; _ } =
 
 let write ?source_port ~dest_ip ~dest_port t buf =
   let open Lwt_unix in
-  let fd =
-    match source_port with
+  ( match source_port with
     | None -> get_udpv6_listening_fd t 0
-    | Some port -> get_udpv6_listening_fd t port
-  in
+    | Some port -> get_udpv6_listening_fd t port )
+  >>= fun fd ->
   Lwt_cstruct.sendto fd buf [] (ADDR_INET ((Ipaddr_unix.V6.to_inet_addr dest_ip), dest_port))
   >>= fun _ ->
   return_unit