Merge pull request #333 from djs55/fix-windows

Fix the ICMP socket test on Windows

src/stack-unix/icmpv4_socket.ml

@@ -9,6 +9,13 @@ type t = unit
 type error = [ `Ip of string ]
 let pp_error ppf (`Ip s) = Fmt.string ppf s
 
+let is_win32 = Sys.os_type = "Win32"
+
+let sock_icmp =
+  (* Windows uses SOCK_RAW protocol 1 for ICMP
+     Unix uses SOCK_DGRAM protocol 1 for ICMP *)
+  if is_win32 then Lwt_unix.SOCK_RAW else Lwt_unix.SOCK_DGRAM
+
 let ipproto_icmp = 1 (* according to BSD /etc/protocols *)
 let port = 0 (* port isn't meaningful in this context *)
 
@@ -24,16 +31,34 @@ let pp_sockaddr fmt sa =
 let src = Logs.Src.create "icmpv4_socket" ~doc:"Mirage ICMPv4 (Sockets Edition)"
 module Log = (val Logs.src_log src : Logs.LOG)
 
+let sendto' fd buf flags dst =
+  if is_win32 then begin
+     (* Lwt on Win32 doesn't support Lwt_bytes.sendto *)
+     let bytes = Bytes.make (Cstruct.len buf) '\000' in
+     Cstruct.blit_to_bytes buf 0 bytes 0 (Cstruct.len buf);
+     Lwt_unix.sendto fd bytes 0 (Bytes.length bytes) flags dst
+  end else Lwt_cstruct.sendto fd buf flags dst
+
+let recvfrom' fd buf flags =
+  if is_win32 then begin
+    (* Lwt on Win32 doesn't support Lwt_bytes.recvfrom *)
+    let bytes = Bytes.make (Cstruct.len buf) '\000' in
+    Lwt_unix.recvfrom fd bytes 0 (Bytes.length bytes) flags
+    >>= fun (n, sockaddr) ->
+    Cstruct.blit_from_bytes bytes 0 buf 0 n;
+    Lwt.return (n, sockaddr)
+  end else Lwt_cstruct.recvfrom fd buf flags
+
 let write _t ~dst buf =
   let open Lwt_unix in
   let flags = [] in
   let ipproto_icmp = 1 in (* according to BSD /etc/protocols *)
   let port = 0 in (* port isn't meaningful in this context *)
-  let fd = socket PF_INET SOCK_DGRAM ipproto_icmp in
+  let fd = socket PF_INET sock_icmp ipproto_icmp in
   let in_addr = Unix.inet_addr_of_string (Ipaddr.V4.to_string dst) in
   let sockaddr = ADDR_INET (in_addr, port) in
   Lwt.catch (fun () ->
-    Lwt_cstruct.sendto fd buf flags sockaddr >>= fun sent ->
+    sendto' fd buf flags sockaddr >>= fun sent ->
       if (sent <> (Cstruct.len buf)) then
         Log.debug (fun f -> f "short write: %d received vs %d expected" sent (Cstruct.len buf));
     Lwt_unix.close fd |> Lwt_result.ok
@@ -61,13 +86,13 @@ let input t ~src ~dst:_ buf =
     | _, _ -> Lwt.return_unit
 
 let listen _t addr fn =
-  let fd = Lwt_unix.(socket PF_INET SOCK_DGRAM) ipproto_icmp in
+  let fd = Lwt_unix.socket PF_INET sock_icmp ipproto_icmp in
   let sa = Lwt_unix.ADDR_INET (Unix.inet_addr_of_string (Ipaddr.V4.to_string addr), port) in
   Lwt_unix.bind 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
-    Lwt_cstruct.recvfrom fd receive_buffer [] >>= fun (len, _sockaddr) ->
+    recvfrom' fd receive_buffer [] >>= fun (len, _sockaddr) ->
     (* trim the buffer to the amount of data actually received *)
     let receive_buffer = Cstruct.set_len receive_buffer len in
     fn receive_buffer