Add ttl parameter to Icmp.write and Udp.write

.travis.yml

@@ -4,6 +4,7 @@ sudo: required
 env:
   global:
   - EXTRA_REMOTES="https://github.com/mirage/mirage-dev.git"
+  - PINS="mirage-protocols:https://github.com/phaer/mirage-protocols.git#master"
   matrix:
   - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.05 PACKAGE=tcpip MIRAGE_MODE=xen
   - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.05 PACKAGE=tcpip MIRAGE_MODE=hvt

src/icmp/icmpv4.ml

@@ -23,14 +23,14 @@ module Make(IP : Mirage_protocols_lwt.IPV4) = struct
 
   let disconnect _ = Lwt.return_unit
 
-  let writev t ~dst bufs =
-    IP.write t.ip dst `ICMP (fun _ -> 0) bufs >|= function
+  let writev t ~dst ?ttl bufs =
+    IP.write t.ip dst ?ttl `ICMP (fun _ -> 0) bufs >|= function
     | Ok () -> Ok ()
     | Error e ->
       Log.warn (fun f -> f "Error sending IP packet: %a" IP.pp_error e);
       Error (`Ip e)
 
-  let write t ~dst buf = writev t ~dst [buf]
+  let write t ~dst ?ttl buf = writev t ~dst ?ttl [buf]
 
   let input t ~src ~dst:_ buf =
     let open Icmpv4_packet in

src/stack-unix/icmpv4_socket.ml

@@ -49,7 +49,7 @@ let recvfrom' fd buf flags =
     Lwt.return (n, sockaddr)
   end else Lwt_cstruct.recvfrom fd buf flags
 
-let write _t ~dst buf =
+let write _t ~dst ?ttl:_ttl buf =
   let open Lwt_unix in
   let flags = [] in
   let ipproto_icmp = 1 in (* according to BSD /etc/protocols *)

src/stack-unix/udpv4_socket.ml

@@ -67,7 +67,7 @@ let id { interface; _ } =
   let t, _ = Lwt.task () in
   t
 
-let write ?src_port ~dst ~dst_port t buf =
+let write ?src_port ?ttl:_ttl ~dst ~dst_port t buf =
   let open Lwt_unix in
   let rec write_to_fd fd buf =
     Lwt_cstruct.sendto fd buf [] (ADDR_INET ((Ipaddr_unix.V4.to_inet_addr dst), dst_port))

src/udp/udp.ml

@@ -51,7 +51,7 @@ module Make(Ip: Mirage_protocols_lwt.IP)(Random:Mirage_random.C) = struct
       | Some fn ->
         fn ~src ~dst ~src_port payload
 
-  let writev ?src_port ~dst ~dst_port t bufs =
+  let writev ?src_port ?ttl ~dst ~dst_port t bufs =
     let src_port = match src_port with
       | None   -> Randomconv.int ~bound:65535 (fun x -> Random.generate x)
       | Some p -> p
@@ -68,16 +68,16 @@ module Make(Ip: Mirage_protocols_lwt.IP)(Random:Mirage_random.C) = struct
         Logs.err (fun m -> m "error while assembling udp header: %s, ignoring" msg);
         8
     in
-    Ip.write t.ip dst `UDP ~size:8 fill_hdr bufs >|= function
+    Ip.write t.ip dst ?ttl `UDP ~size:8 fill_hdr bufs >|= function
     | Ok () -> Ok ()
     | Error e ->
       Log.err (fun f -> f "IP module couldn't send UDP packet to %a: %a"
                   pp_ip dst Ip.pp_error e);
       (* we're supposed to make our best effort, and we did *)
       Ok ()
 
-  let write ?src_port ~dst ~dst_port t buf =
-    writev ?src_port ~dst ~dst_port t [buf]
+  let write ?src_port ?ttl ~dst ~dst_port t buf =
+    writev ?src_port ?ttl ~dst ~dst_port t [buf]
 
   let connect ip =
     Log.info (fun f -> f "UDP interface connected on %a" (Fmt.list Ip.pp_ipaddr) @@ Ip.get_ip ip);