IPv6.connect: only return once any IP address is configured

src/ipv6/dune

@@ -1,8 +1,8 @@
 (library
  (name tcpip_ipv6)
  (public_name tcpip.ipv6)
- (libraries logs mirage-protocols mirage-time macaddr-cstruct
+ (libraries logs mirage-protocols mirage-time mirage-net macaddr-cstruct
    mirage-clock duration ipaddr cstruct rresult mirage-random tcpip
-   randomconv)
+   randomconv ethernet)
  (preprocess (pps ppx_cstruct))
  (wrapped false))

src/ipv6/ipv6.ml

@@ -21,7 +21,8 @@ module I = Ipaddr
 
 open Lwt.Infix
 
-module Make (E : Mirage_protocols.ETHERNET)
+module Make (N : Mirage_net.S)
+            (E : Mirage_protocols.ETHERNET)
             (R : Mirage_random.S)
             (T : Mirage_time.S)
             (C : Mirage_clock.MCLOCK) = struct
@@ -45,15 +46,20 @@ module Make (E : Mirage_protocols.ETHERNET)
 
   let output_ign t a = output t a >|= fun _ -> ()
 
-  let start_ticking t =
-    let rec loop () =
+  let start_ticking t u =
+    let rec loop u =
       let now = C.elapsed_ns () in
       let ctx, outs = Ndpv6.tick ~now t.ctx in
       t.ctx <- ctx;
+      let u = match u, Ndpv6.get_ip t.ctx with
+        | None, _ | _, [] -> u
+        | Some u, _ -> Lwt.wakeup_later u (); None
+      in
       Lwt_list.iter_s (output_ign t) outs (* MCP: replace with propagation *) >>= fun () ->
-      T.sleep_ns (Duration.of_sec 1) >>= loop
+      T.sleep_ns (Duration.of_sec 1) >>= fun () ->
+      loop u
     in
-    loop ()
+    loop (Some u)
 
   let mtu t = E.mtu t.ethif - Ipv6_wire.sizeof_ipv6
 
@@ -143,17 +149,37 @@ module Make (E : Mirage_protocols.ETHERNET)
     | Some x -> f x >>= g
     | None -> g ()
 
-  let connect ?ip ?netmask ?gateways ethif =
+  let connect ?ip ?netmask ?gateways netif ethif =
     Log.info (fun f -> f "IP6: Starting");
     let now = C.elapsed_ns () in
     let ctx, outs = Ndpv6.local ~now ~random:R.generate (E.mac ethif) in
     let t = {ctx; ethif} in
-    (* MCP: replace this error swallowing with proper propagation *)
-    Lwt_list.iter_s (output_ign t) outs >>= fun () ->
-    (ip, Lwt_list.iter_s (set_ip t)) >>=? fun () ->
-    (netmask, Lwt_list.iter_s (set_ip_netmask t)) >>=? fun () ->
-    (gateways, set_ip_gateways t) >>=? fun () ->
-    Lwt.async (fun () -> start_ticking t);
-    Lwt.return t
+    let task, u = Lwt.task () in
+    Lwt.async (fun () -> start_ticking t u);
+    (* call listen until we're good in respect to DAD *)
+    let ethif_listener =
+      let noop ~src:_ ~dst:_ _ = Lwt.return_unit in
+      E.input ethif
+        ~arpv4:(fun _ -> Lwt.return_unit)
+        ~ipv4:(fun _ -> Lwt.return_unit)
+        ~ipv6:(input t ~tcp:noop ~udp:noop ~default:(fun ~proto:_ -> noop))
+    in
+    let timeout = T.sleep_ns (Duration.of_sec 3) in
+    Lwt.pick [
+      (* MCP: replace this error swallowing with proper propagation *)
+      (Lwt_list.iter_s (output_ign t) outs >>= fun () ->
+       (ip, Lwt_list.iter_s (set_ip t)) >>=? fun () ->
+       (netmask, Lwt_list.iter_s (set_ip_netmask t)) >>=? fun () ->
+       (gateways, set_ip_gateways t) >>=? fun () ->
+       task) ;
+      (N.listen netif ~header_size:Ethernet_wire.sizeof_ethernet ethif_listener >|= fun _ -> ()) ;
+      timeout
+    ] >>= fun () ->
+    match get_ip t with
+    | [] -> Lwt.fail_with "IP6 not started, couldn't assign IP"
+    | ips ->
+      Log.info (fun f -> f "IP6: Started with %a"
+                   Fmt.(list ~sep:(unit ",@ ") Ipaddr.V6.pp) ips);
+      Lwt.return t
 
 end

src/ipv6/ipv6.mli

@@ -14,7 +14,8 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module Make (E : Mirage_protocols.ETHERNET)
+module Make (N : Mirage_net.S)
+            (E : Mirage_protocols.ETHERNET)
             (R : Mirage_random.S)
             (T : Mirage_time.S)
             (Clock : Mirage_clock.MCLOCK) : sig
@@ -23,5 +24,5 @@ module Make (E : Mirage_protocols.ETHERNET)
     ?ip:Ipaddr.V6.t list ->
     ?netmask:Ipaddr.V6.Prefix.t list ->
     ?gateways:Ipaddr.V6.t list ->
-    E.t -> t Lwt.t
+    N.t -> E.t -> t Lwt.t
 end

src/ipv6/ndpv6.ml

@@ -169,17 +169,19 @@ module Allocate = struct
     in
     (size', fill)
 
-  let ns ~mac ~src ~dst ~tgt =
-    let size = Ipv6_wire.sizeof_ns + Ipv6_wire.sizeof_llopt in
+  let ns ~specified ~mac ~src ~dst ~tgt =
+    let size = Ipv6_wire.sizeof_ns + if specified then Ipv6_wire.sizeof_llopt else 0 in
     let fillf hdr icmpbuf =
       let optbuf = Cstruct.shift icmpbuf Ipv6_wire.sizeof_ns in
       Ipv6_wire.set_ns_ty icmpbuf 135; (* NS *)
       Ipv6_wire.set_ns_code icmpbuf 0;
       Ipv6_wire.set_ns_reserved icmpbuf 0l;
       ipaddr_to_cstruct_raw tgt (Ipv6_wire.get_ns_target icmpbuf) 0;
-      Ipv6_wire.set_llopt_ty optbuf  1;
-      Ipv6_wire.set_llopt_len optbuf  1;
-      macaddr_to_cstruct_raw mac optbuf 2;
+      if specified then begin
+        Ipv6_wire.set_llopt_ty optbuf  1;
+        Ipv6_wire.set_llopt_len optbuf  1;
+        macaddr_to_cstruct_raw mac optbuf 2;
+      end;
       Ipv6_wire.set_icmpv6_csum icmpbuf 0;
       Ipv6_wire.set_icmpv6_csum icmpbuf @@ checksum hdr [ icmpbuf ];
       size
@@ -993,7 +995,7 @@ module Parser = struct
     loop (poff+2)
 
   let packet is_my_addr buf =
-    if Cstruct.len buf < Ipv6_wire.sizeof_ipv6 then begin
+    if Cstruct.len buf < Ipv6_wire.sizeof_ipv6 || Cstruct.len buf < Ipv6_wire.sizeof_ipv6 + Ipv6_wire.get_ipv6_len buf then begin
       Log.debug (fun m -> m "short IPv6 packet received, dropping");
       Drop
     end else if Int32.logand (Ipv6_wire.get_ipv6_version_flow buf) 0xF0000000l <> 0x60000000l then begin
@@ -1047,13 +1049,13 @@ let next_hop ctx ip =
 let rec process_actions ~now ctx actions =
   let aux ctx = function
     | SendNS (unspec, dst, tgt) ->
-      let src = match unspec with
-        | `Unspecified -> Ipaddr.unspecified
-        | `Specified -> AddressList.select_source ctx.address_list ~dst
+      let src, specified = match unspec with
+        | `Unspecified -> Ipaddr.unspecified, false
+        | `Specified -> AddressList.select_source ctx.address_list ~dst, true
       in
       Log.debug (fun f -> f "ND6: Sending NS src=%a dst=%a tgt=%a"
         Ipaddr.pp src Ipaddr.pp dst Ipaddr.pp tgt);
-      let size, fillf = Allocate.ns ~mac:ctx.mac ~src ~dst ~tgt in
+      let size, fillf = Allocate.ns ~specified ~mac:ctx.mac ~src ~dst ~tgt in
       send' ~now ctx dst size fillf
     | SendNA (src, dst, tgt, sol) ->
       let sol = match sol with `Solicited -> true | `Unsolicited -> false in
@@ -1210,12 +1212,18 @@ let handle_ns ~now:_ ctx ~src ~dst ns =
     | None ->
       ctx, []
   in
-  if AddressList.is_my_addr ctx.address_list ns.ns_target then
-    let src = ns.ns_target and dst = src in
-(*     (\* Log.debug (fun f -> f "Sending NA to %a from %a with target address %a" *\) *)
-(*       (\* Ipaddr.pp dst Ipaddr.pp src Ipaddr.pp target); *\) *)
-    ctx, SendNA (src, dst, ns.ns_target, `Solicited) :: actions
-  else
+  if AddressList.is_my_addr ctx.address_list ns.ns_target then begin
+    let src = ns.ns_target
+    and dst, sol =
+      if Ipaddr.(compare src unspecified = 0) then
+        Ipaddr.link_nodes, `Unsolicited
+      else
+        src, `Solicited
+    in
+    (* Log.debug (fun f -> f "Sending NA to %a from %a with target address %a"
+                  Ipaddr.pp dst Ipaddr.pp src Ipaddr.pp ns.ns_target); *)
+    ctx, SendNA (src, dst, ns.ns_target, sol) :: actions
+  end else
     ctx, actions
 
 let handle_na ~now ctx ~src ~dst na =

tcpip.opam

@@ -50,6 +50,7 @@ depends: [
   "mirage-clock-unix" {with-test & >= "3.0.0"}
   "mirage-random-test" {with-test & >= "0.1.0"}
   "arp-mirage" {with-test & >= "2.0.0"}
+  "ipaddr-cstruct" {with-test}
   "lru" {>= "0.3.0"}
 ]
 synopsis: "OCaml TCP/IP networking stack, used in MirageOS"

test/dune

@@ -5,7 +5,8 @@
    pcap-format duration mirage-random rresult mirage-protocols
    mirage-stack arp arp-mirage ethernet tcpip.ipv4 tcpip.tcp tcpip.udp
    tcpip.stack-direct tcpip.icmpv4 tcpip.udpv4-socket tcpip.tcpv4-socket
-   tcpip.icmpv4-socket tcpip.stack-socket tcpip.ipv6))
+   tcpip.icmpv4-socket tcpip.stack-socket tcpip.ipv6 ipaddr-cstruct
+   macaddr-cstruct))
 
 (alias
  (name runtest)

test/test_ipv6.ml

@@ -4,7 +4,7 @@ module B = Vnetif_backends.Basic
 module V = Vnetif.Make(B)
 module E = Ethernet.Make(V)
 
-module Ipv6 = Ipv6.Make(E)(Mirage_random_test)(Time)(Mclock)
+module Ipv6 = Ipv6.Make(V)(E)(Mirage_random_test)(Time)(Mclock)
 module Udp = Udp.Make(Ipv6)(Mirage_random_test)
 open Lwt.Infix
 
@@ -30,7 +30,7 @@ let get_stack backend address =
   let gateways = [] in
   V.connect backend >>= fun netif ->
   E.connect netif >>= fun ethif ->
-  Ipv6.connect ~ip ~netmask ~gateways ethif >>= fun ip ->
+  Ipv6.connect ~ip ~netmask ~gateways netif ethif >>= fun ip ->
   Udp.connect ip >>= fun udp ->
   Lwt.return { backend; netif; ethif; ip; udp }
 
@@ -61,14 +61,8 @@ let check_for_one_udp_packet on_received_one ~src ~dst buf =
 
 let send_forever sender receiver_address udp_message =
   let rec loop () =
-    (* Check that we have an IP before sending *)
-    if List.length (Ipv6.get_ip sender.ip) >= 1 then
-    begin
-            Udp.write sender.udp ~dst:receiver_address ~dst_port:1234 udp_message
-            >|= Rresult.R.get_ok
-    end else
-            Lwt.return_unit
-    >>= fun () ->
+    Udp.write sender.udp ~dst:receiver_address ~dst_port:1234 udp_message
+    >|= Rresult.R.get_ok >>= fun () ->
     Time.sleep_ns (Duration.of_ms 50) >>= fun () ->
     loop () in
   loop ()
@@ -89,6 +83,142 @@ let pass_udp_traffic () =
       Alcotest.fail "UDP packet should have been received";
   ]
 
+let create_ethernet backend =
+  V.connect backend >>= fun netif ->
+  E.connect netif >|= fun ethif ->
+  (fun ipv6 ->
+     V.listen netif ~header_size:Ethernet_wire.sizeof_ethernet
+       (E.input ethif
+          ~arpv4:(fun _ -> Lwt.return_unit)
+          ~ipv4:(fun _ -> Lwt.return_unit)
+          ~ipv6) >|= fun _ -> ()),
+  (fun dst ?size f -> E.write ethif dst `IPv6 ?size f),
+  E.mac ethif
+
+let solicited_node_prefix =
+  Ipaddr.V6.(Prefix.make 104 (of_int16 (0xff02, 0, 0, 0, 0, 1, 0xff00, 0)))
+
+let dad_na_is_sent () =
+  let address = Ipaddr.V6.of_string_exn "fc00::23" in
+  let backend = B.create () in
+  get_stack backend address >>= fun stack ->
+  create_ethernet backend >>= fun (listen_raw, write_raw, _) ->
+  let received_one, on_received_one = Lwt.task () in
+  let nd_size = Ipv6_wire.sizeof_ipv6 + Ipv6_wire.sizeof_ns in
+  let nd buf =
+    Ipv6_wire.set_ipv6_version_flow buf 0x60000000l; (* IPv6 *)
+    Ipv6_wire.set_ipv6_len buf Ipv6_wire.sizeof_ns;
+    Ipaddr_cstruct.V6.write_cstruct_exn Ipaddr.V6.unspecified (Cstruct.shift buf 8);
+    Ipaddr_cstruct.V6.write_cstruct_exn (Ipaddr.V6.Prefix.network_address solicited_node_prefix address) (Cstruct.shift buf 24);
+    Ipv6_wire.set_ipv6_hlim buf 255;
+    Ipv6_wire.set_ipv6_nhdr buf (Ipv6_wire.protocol_to_int `ICMP);
+    let hdr, icmpbuf = Cstruct.split buf Ipv6_wire.sizeof_ipv6 in
+    Ipv6_wire.set_ns_ty icmpbuf 135; (* NS *)
+    Ipv6_wire.set_ns_code icmpbuf 0;
+    Ipv6_wire.set_ns_reserved icmpbuf 0l;
+    Ipaddr_cstruct.V6.write_cstruct_exn address (Cstruct.shift icmpbuf 8);
+    Ipv6_wire.set_icmpv6_csum icmpbuf 0;
+    Ipv6_wire.set_icmpv6_csum icmpbuf @@ Ndpv6.checksum hdr [icmpbuf];
+    nd_size
+  and is_na buf =
+    let icmpbuf = Cstruct.shift buf Ipv6_wire.sizeof_ipv6 in
+    Ipv6_wire.get_ipv6_version_flow buf = 0x60000000l && (* IPv6 *)
+    Ipaddr.V6.compare
+      (Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift buf 8))
+      address = 0 &&
+    Ipaddr.V6.compare
+      (Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift buf 24))
+      Ipaddr.V6.link_nodes = 0 &&
+    Ipv6_wire.get_ipv6_hlim buf = 255 &&
+    Ipv6_wire.get_ipv6_nhdr buf = Ipv6_wire.protocol_to_int `ICMP &&
+    Ipv6_wire.get_na_ty icmpbuf = 136 &&
+    Ipv6_wire.get_na_code icmpbuf = 0 &&
+    Ipaddr.V6.compare
+      (Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift icmpbuf 8))
+      address = 0
+  in
+  Lwt.pick [
+    listen stack;
+    listen_raw (fun buf ->
+        if is_na buf then
+          Lwt.wakeup_later on_received_one ();
+        Lwt.return_unit);
+    (write_raw (E.mac stack.ethif) ~size:nd_size nd >|= fun _ -> ());
+    received_one;
+    (Time.sleep_ns (Duration.of_ms 1000) >>= fun () ->
+     Alcotest.fail "NA packet should have been received")
+  ]
+
+let multicast_mac =
+  let pbuf = Cstruct.create 6 in
+  Cstruct.BE.set_uint16 pbuf 0 0x3333;
+  fun ip ->
+    let _, _, _, n = Ipaddr.V6.to_int32 ip in
+    Cstruct.BE.set_uint32 pbuf 2 n;
+    Macaddr_cstruct.of_cstruct_exn pbuf
+
+let dad_na_is_received () =
+  let address = Ipaddr.V6.of_string_exn "fc00::23" in
+  let backend = B.create () in
+  create_ethernet backend >>= fun (listen_raw, write_raw, mac) ->
+  let na_size = Ipv6_wire.sizeof_ipv6 + Ipv6_wire.sizeof_na + Ipv6_wire.sizeof_llopt in
+  let is_ns buf =
+    let icmpbuf = Cstruct.shift buf Ipv6_wire.sizeof_ipv6 in
+    if
+      Ipv6_wire.get_ipv6_version_flow buf = 0x60000000l && (* IPv6 *)
+      Ipaddr.V6.compare
+        (Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift buf 8))
+        Ipaddr.V6.unspecified = 0 &&
+      Ipaddr.V6.Prefix.mem
+        (Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift buf 24))
+        solicited_node_prefix &&
+      Ipv6_wire.get_ipv6_hlim buf = 255 &&
+      Ipv6_wire.get_ipv6_nhdr buf = Ipv6_wire.protocol_to_int `ICMP &&
+      Ipv6_wire.get_ns_ty icmpbuf = 135 &&
+      Ipv6_wire.get_ns_code icmpbuf = 0
+    then
+      Some (Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift icmpbuf 8))
+    else
+      None
+  in
+  let na addr buf =
+    Ipv6_wire.set_ipv6_version_flow buf 0x60000000l; (* IPv6 *)
+    Ipv6_wire.set_ipv6_len buf (Ipv6_wire.sizeof_na + Ipv6_wire.sizeof_llopt);
+    Ipaddr_cstruct.V6.write_cstruct_exn addr (Cstruct.shift buf 8);
+    Ipaddr_cstruct.V6.write_cstruct_exn Ipaddr.V6.link_nodes (Cstruct.shift buf 24);
+    Ipv6_wire.set_ipv6_hlim buf 255;
+    Ipv6_wire.set_ipv6_nhdr buf (Ipv6_wire.protocol_to_int `ICMP);
+    let hdr, icmpbuf = Cstruct.split buf Ipv6_wire.sizeof_ipv6 in
+    Ipv6_wire.set_na_ty icmpbuf 136; (* NA *)
+    Ipv6_wire.set_na_code icmpbuf 0;
+    Ipv6_wire.set_na_reserved icmpbuf 0x20000000l;
+    Ipaddr_cstruct.V6.write_cstruct_exn addr (Cstruct.shift icmpbuf 8);
+    let optbuf = Cstruct.shift icmpbuf Ipv6_wire.sizeof_na in
+    Ipv6_wire.set_llopt_ty optbuf 2;
+    Ipv6_wire.set_llopt_len optbuf 1;
+    Macaddr_cstruct.write_cstruct_exn mac (Cstruct.shift optbuf 2);
+    Ipv6_wire.set_icmpv6_csum icmpbuf 0;
+    Ipv6_wire.set_icmpv6_csum icmpbuf @@ Ndpv6.checksum hdr [icmpbuf];
+    na_size
+  in
+  Lwt.pick [
+    (listen_raw (fun buf ->
+         match is_ns buf with
+         | None -> Lwt.return_unit
+         | Some addr ->
+           let dst = multicast_mac Ipaddr.V6.link_nodes in
+           write_raw dst ~size:na_size (na addr) >|= fun _ -> ()));
+    (Lwt.catch
+       (fun () -> get_stack backend address >|= fun _ -> Error ())
+       (fun _ -> Lwt.return (Ok ())) >|= function
+     | Ok () -> ()
+     | Error () -> Alcotest.fail "Expected stack initialization failure");
+    (Time.sleep_ns (Duration.of_ms 5000) >>= fun () ->
+     Alcotest.fail "stack initialization should have failed")
+  ]
+
 let suite = [
   "Send a UDP packet from one IPV6 stack and check it is received by another", `Quick, pass_udp_traffic;
+  "NA is sent when a ND is received", `Quick, dad_na_is_sent;
+  "NA is received, stack fails to initialise", `Quick, dad_na_is_received;
 ]