Merge pull request mirage#55 from avsm/yomimono-dhcp-without-listen

Further tidyups to mirage#53 fix

CHANGES

@@ -1,3 +1,8 @@
+1.1.5 (18-June-2014)
+* Ensure that DHCP completes before the application is started, so that
+  unikernels that establish outgoing connections can do so without a race.
+  (fix from Mindy Preston in #53, followup in #55)
+
 1.1.4 (03-June-2014):
 * [tcp] Fully process the last `ACK` in a 3-way handshake for server connections.
   This ensures that a `FIN` is correctly transmitted upon application-initiated

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.3
 Name:        tcpip
-Version:     1.1.4
+Version:     1.1.5
 Synopsis:    Ethernet, TCP/IPv4 and DHCPv4 library
 Authors:     Anil Madhavapeddy, Balraj Singh, Richard Mortier
 License:     ISC

lib/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: ad7ce68613bd14bc1d9b5d0283b8fd16)
-version = "1.1.4"
+# DO NOT EDIT (digest: 915fb48a64872696b047d8ca9ceb5f60)
+version = "1.1.5"
 description = "Ethernet, TCP/IPv4 and DHCPv4 library"
 requires = "io-page mirage-types ipaddr cstruct"
 archive(byte) = "tcpip.cma"
@@ -9,7 +9,7 @@ archive(native) = "tcpip.cmxa"
 archive(native, plugin) = "tcpip.cmxs"
 exists_if = "tcpip.cma"
 package "udpv4-unix" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.udpv4 tcpip.ipv4-unix lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix"
@@ -21,7 +21,7 @@ package "udpv4-unix" (
 )
 
 package "udpv4-socket" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "tcpip.udpv4 lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix"
  archive(byte) = "udpv4-socket.cma"
@@ -32,7 +32,7 @@ package "udpv4-socket" (
 )
 
 package "udpv4" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip"
@@ -44,7 +44,7 @@ package "udpv4" (
 )
 
 package "tcpv4-unix" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.tcpv4 tcpip.ipv4-unix tcpip.channel lwt lwt.unix mirage-unix mirage-clock-unix ipaddr.unix cstruct.lwt io-page.unix"
@@ -56,7 +56,7 @@ package "tcpv4-unix" (
 )
 
 package "tcpv4-socket" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix"
  archive(byte) = "tcpv4-socket.cma"
@@ -67,7 +67,7 @@ package "tcpv4-socket" (
 )
 
 package "tcpv4" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip tcpip.ipv4"
@@ -79,7 +79,7 @@ package "tcpv4" (
 )
 
 package "stack-unix" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.udpv4-unix tcpip.tcpv4-unix tcpip.stack-direct lwt lwt.unix ipaddr.unix mirage-unix mirage-clock-unix mirage-console-unix mirage-types.lwt io-page.unix"
@@ -91,7 +91,7 @@ package "stack-unix" (
 )
 
 package "stack-socket" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.udpv4-socket tcpip.tcpv4-socket lwt lwt.unix ipaddr.unix io-page.unix"
@@ -103,7 +103,7 @@ package "stack-socket" (
 )
 
 package "stack-direct" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip.ethif tcpip.udpv4 tcpip.tcpv4 tcpip.dhcpv4"
@@ -115,7 +115,7 @@ package "stack-direct" (
 )
 
 package "ipv4-unix" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "tcpip.ethif-unix tcpip.ipv4 lwt lwt.unix"
  archive(byte) = "ipv4-unix.cma"
@@ -126,7 +126,7 @@ package "ipv4-unix" (
 )
 
 package "ipv4" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip"
@@ -138,7 +138,7 @@ package "ipv4" (
 )
 
 package "ethif-unix" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "tcpip.ethif mirage-net-unix lwt lwt.unix"
  archive(byte) = "ethif-unix.cma"
@@ -149,7 +149,7 @@ package "ethif-unix" (
 )
 
 package "ethif" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt"
@@ -161,7 +161,7 @@ package "ethif" (
 )
 
 package "dhcpv4" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip.udpv4"
@@ -173,7 +173,7 @@ package "dhcpv4" (
 )
 
 package "channel" (
- version = "1.1.4"
+ version = "1.1.5"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "io-page mirage-types ipaddr cstruct lwt.syntax lwt"
  archive(byte) = "channel.cma"

lib/tcpip_stack_direct.ml

@@ -81,8 +81,11 @@ module Make
   let configure t config =
     match config with
     | `DHCP -> begin
+        (* TODO: spawn a background thread to reconfigure the interface
+           when future offers are received. *)
         let dhcp, offers = Dhcp.create t.c t.ipv4 t.udpv4 in
         listen_udpv4 t 68 (Dhcp.input dhcp);
+        (* TODO: stop listening to this port when done with DHCP. *)
         Lwt_stream.get offers
         >>= function
         | None -> fail (Failure "No DHCP offer received")
@@ -109,7 +112,7 @@ module Make
     with Not_found -> None
 
   let listen t =
-    let t1 = Netif.listen t.netif (
+    Netif.listen t.netif (
       Ethif.input
         ~ipv4:(
           Ipv4.input
@@ -120,12 +123,6 @@ module Make
             ~default:(fun ~proto ~src ~dst buf -> return ())
             t.ipv4)
         ~ipv6:(fun b -> Console.log_s t.c ("Dropping ipv6")) t.ethif)
-    in
-    let t2 =
-      Console.log_s t.c "Manager: configuring"
-      >>= fun () ->
-      configure t t.mode
-    in t1 <&> t2
 
   let connect id =
     let {V1_LWT.console = c; interface = netif; mode; name } = id in
@@ -149,8 +146,22 @@ module Make
     let tcpv4_listeners = Hashtbl.create 7 in
     let t = { id; c; mode; netif; ethif; ipv4; tcpv4; udpv4;
       udpv4_listeners; tcpv4_listeners } in
+    Console.log_s t.c "Manager: configuring"
+    >>= fun () ->
+    let _ = listen t in
+    configure t t.mode
+    >>= fun () ->
+    (* TODO: this is fine for now, because the DHCP state machine isn't fully 
+       implemented and its thread will terminate after one successful lease 
+       transaction.  For a DHCP thread that runs forever, `configure` will need
+       to spawn a background thread, but we need to consider how to inform the
+       application stack that the IP address has changed (perhaps via a control
+       Lwt_stream that the application can ignore if it doesn't care). *)
+    Console.log_s t.c "Manager: configuration done"
+    >>= fun () ->
     return (`Ok t)
 
   let disconnect t =
-    return ()
+    (* TODO: kill the listening thread *)
+    Console.log_s t.c "Manager: disconnect"
 end

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: b66a7a96f0a247c441492dedb1d808fa) *)
+(* DO NOT EDIT (digest: 9a43bdb68f572d76b1e9c848b19d69dd) *)
 (*
    Regenerated by OASIS v0.4.4
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6638,7 +6638,7 @@ let setup_t =
           alpha_features = [];
           beta_features = [];
           name = "tcpip";
-          version = "1.1.4";
+          version = "1.1.5";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7341,14 +7341,15 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.4";
-     oasis_digest = Some "ëè\152\159\t\003-ãý©ÑÓÎdÀÜ";
+     oasis_digest =
+       Some "\159\179\"\025\151\254<\208\193\014\147|\239\201\162\228";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
   };;
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7353 "setup.ml"
+# 7354 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;