Merge pull request #372 from avsm/master

Release 2.3.0

.travis-ci.sh

@@ -5,7 +5,8 @@ case "$OCAML_VERSION,$OPAM_VERSION" in
 3.12.1,1.2.0) ppa=avsm/ocaml312+opam12 ;;
 4.00.1,1.2.0) ppa=avsm/ocaml40+opam12 ;;
 4.01.0,1.2.0) ppa=avsm/ocaml41+opam12 ;;
-4.02.0,1.2.0) ppa=avsm/ocaml42+opam12 ;;
+4.02.1,1.2.0) ppa=avsm/ocaml42+opam12 ;;
+4.02.1,1.2.1) ppa=avsm/ppa-opam-experimental ;;
 *) echo Unknown $OCAML_VERSION,$OPAM_VERSION; exit 1 ;;
 esac
 
@@ -16,14 +17,12 @@ export OPAMYES=1
 
 # when preparing a set of synchronised updates for a Mirage release:
 # for regular minor updates:
-opam init >/dev/null 2>&1
-opam remote add mirage-dev git://github.com/mirage/mirage-dev
+opam init git://github.com/mirage/opam-repository#mirage-connect >/dev/null 2>&1
+#opam remote add mirage-dev git://github.com/mirage/mirage-dev
 opam install cstruct ounit cmdliner ipaddr re lwt io-page xenstore xenstore_transport
 eval `opam config env`
 opam pin add mirage .
 opam pin add mirage-types .
-# temporary pin for ipv6
-opam pin add tcpip git://github.com/mirage/mirage-tcpip -n
 opam install mirage mirage-types
 
 export OPAMVERBOSE=1

.travis.yml

@@ -2,4 +2,5 @@ language: c
 script: bash -ex .travis-ci.sh
 env:
   - OCAML_VERSION=4.01.0 OPAM_VERSION=1.2.0
-  - OCAML_VERSION=4.02.0 OPAM_VERSION=1.2.0
+  - OCAML_VERSION=4.02.1 OPAM_VERSION=1.2.0
+  - OCAML_VERSION=4.02.1 OPAM_VERSION=1.2.1

CHANGES

@@ -1,8 +1,15 @@
-2.3.0
-* Check that opam is at least version 1.2.0 (#355)
-* Don't put '-classic-display' in the generated Makefiles. (#364)
+2.3.0 (2015-03-10):
 * Remove the `IO_PAGE` module type from `V1`. This has now moved into the
   `io-page` pacakge (#356)
+* Remove `DEVICE.connect` from the `V1` module types.  When a module is
+  functorised over a `DEVICE` it should only have the ability to
+  *use* devices it is given, not to connect to new ones. (#150)
+* Add `FLOW.error_message` to the `V1` module types to allow for
+  generic handling of errors. (#346)
+* Add `IP.uipaddr` as a universal IP address type. (#361)
+* Support the `entropy` version 0.2+ interfaces. (#359)
+* Check that the `opam` command is at least version 1.2.0 (#355)
+* Don't put '-classic-display' in the generated Makefiles. (#364)
 
 2.2.1 (2015-01-29):
 * Fix logging errors when `mirage` output is not redirected. (#355)

_oasis

@@ -2,7 +2,7 @@ OASISFormat: 0.4
 Name:        mirage
 Version:     2.3.0
 Synopsis:    Mirage configuration tool
-Authors:     Thomas Gazagnaire, Anil Madhavapeddy
+Authors:     Thomas Gazagnaire, Anil Madhavapeddy, Dave Scott, Thomas Leonard
 License:     ISC
 Plugins:     META (0.4)
 BuildTools:  ocamlbuild

lib/mirage.ml

@@ -447,14 +447,20 @@ module Entropy = struct
   let name _ =
     "entropy"
 
-  let module_name () = "Entropy"
+  let module_name _ = "Entropy"
 
-  let construction () =
+  let construction _ =
+    match !mode with
+    | `Unix | `MacOSX -> "Entropy_unix"
+    | `Xen  -> "Entropy_xen.Make(OS.Time)"
+
+  let id t =
     match !mode with
-    | `Unix | `MacOSX -> "Entropy_unix.Make (OS.Time)"
-    | `Xen  -> "Entropy_xen"
+    (* default on Unix is the system entropy source *)
+    | (`Unix | `MacOSX) -> "()"
+    | `Xen -> "`From_host"
 
-  let packages () =
+  let packages _ =
     match !mode with
     | `Unix | `MacOSX -> [ "mirage-entropy-unix" ]
     | `Xen  -> [ "mirage-entropy-xen" ]
@@ -465,10 +471,10 @@ module Entropy = struct
     append_main "module %s = %s" (module_name t) (construction t) ;
     newline_main () ;
     append_main "let %s () =" (name t);
-    append_main "  %s.connect ()" (module_name t);
+    append_main "  %s.connect %s" (module_name t) (id t);
     newline_main ()
 
-  let clean () = ()
+  let clean _ = ()
 
   let update_path t _ = t
 
@@ -478,6 +484,7 @@ type entropy = ENTROPY
 
 let entropy = Type ENTROPY
 
+(* The default is to get real entropy from the host *)
 let default_entropy: entropy impl =
   impl entropy () (module Entropy)
 
@@ -1358,21 +1365,23 @@ module STACKV4_direct = struct
     Impl.configure t.console;
     Impl.configure t.network;
     Impl.configure t.random;
-    append_main "module %s = struct" (module_name t);
-    append_main "  module E = Ethif.Make(%s)" (Impl.module_name t.network);
-    append_main "  module I = Ipv4.Make(E)";
-    append_main "  module U = Udp.Make(I)";
-    append_main "  module T = Tcp.Flow.Make(I)(%s)(%s)(%s)"
-      (Impl.module_name t.time)
-      (Impl.module_name t.clock)
-      (Impl.module_name t.random);
-    append_main "  module S = Tcpip_stack_direct.Make(%s)(%s)(%s)(%s)(E)(I)(U)(T)"
+    let ethif_name = module_name t ^ "_E" in
+    let ipv4_name = module_name t ^ "_I" in
+    let udpv4_name = module_name t ^ "_U" in
+    let tcpv4_name = module_name t ^ "_T" in
+    append_main "module %s = Ethif.Make(%s)" ethif_name (Impl.module_name t.network);
+    append_main "module %s = Ipv4.Make(%s)" ipv4_name ethif_name;
+    append_main "module %s = Udp.Make (%s)" udpv4_name ipv4_name;
+    append_main "module %s = Tcp.Flow.Make(%s)(%s)(%s)(%s)"
+      tcpv4_name ipv4_name (Impl.module_name t.time)
+      (Impl.module_name t.clock) (Impl.module_name t.random);
+    append_main "module %s = Tcpip_stack_direct.Make(%s)(%s)(%s)(%s)(%s)(%s)(%s)(%s)"
+      (module_name t)
       (Impl.module_name t.console)
       (Impl.module_name t.time)
       (Impl.module_name t.random)
-      (Impl.module_name t.network);
-    append_main "  include S";
-    append_main "end";
+      (Impl.module_name t.network)
+      ethif_name ipv4_name udpv4_name tcpv4_name;
     newline_main ();
     append_main "let %s () =" name;
     append_main "  %s () >>= function" (Impl.name t.console);
@@ -1393,7 +1402,19 @@ module STACKV4_direct = struct
       | `IPV4 i -> append_main "    mode = `IPv4 %s;" (meta_ipv4_config i);
     end;
     append_main "  } in";
-    append_main "  %s.connect config" (module_name t);
+    append_main "  %s.connect interface >>= function" ethif_name;
+    append_main "  | `Error _ -> %s" (driver_initialisation_error ethif_name);
+    append_main "  | `Ok ethif ->";
+    append_main "  %s.connect ethif >>= function" ipv4_name;
+    append_main "  | `Error _ -> %s" (driver_initialisation_error ipv4_name);
+    append_main "  | `Ok ipv4 ->";
+    append_main "  %s.connect ipv4 >>= function" udpv4_name;
+    append_main "  | `Error _ -> %s" (driver_initialisation_error udpv4_name);
+    append_main "  | `Ok udpv4 ->";
+    append_main "  %s.connect ipv4 >>= function" tcpv4_name;
+    append_main "  | `Error _ -> %s" (driver_initialisation_error tcpv4_name);
+    append_main "  | `Ok tcpv4 ->";
+    append_main "  %s.connect config ethif ipv4 udpv4 tcpv4" (module_name t);
     newline_main ()
 
   let clean t =
@@ -1456,7 +1477,13 @@ module STACKV4_socket = struct
     append_main "    console; interface = [%s];" (meta_ips t.ipv4s);
     append_main "    mode = ();";
     append_main "  } in";
-    append_main "  %s.connect config" (module_name t);
+    append_main "  Udpv4_socket.connect None >>= function";
+    append_main "  | `Error _ -> %s" (driver_initialisation_error "Udpv4_socket");
+    append_main "  | `Ok udpv4 ->";
+    append_main "  Tcpv4_socket.connect None >>= function";
+    append_main "  | `Error _ -> %s" (driver_initialisation_error "Tcpv4_socket");
+    append_main "  | `Ok tcpv4 ->";
+    append_main "  %s.connect config udpv4 tcpv4" (module_name t);
     newline_main ()
 
   let clean t =
@@ -2345,8 +2372,9 @@ let configure_opam t =
       else (
         let opam_version = read_command "opam --version" in
         let version_error () =
-          error "Your version of opam: %s is not up-to-date. \
-                 Please update to (at least) 1.2." opam_version
+          error "Your version of OPAM (%s) is not recent enough. \
+                 Please update to (at least) 1.2: https://opam.ocaml.org/doc/Install.html \
+                 You can pass the `--no-opam-version-check` flag to force its use." opam_version
         in
         match split opam_version '.' with
         | major::minor::_ ->

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.5 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: c6ec4f60bae60b7e09a002f6b9b1f45b) *)
+(* DO NOT EDIT (digest: 87cd27c838f563a6dc02448aa7730fa9) *)
 (*
    Regenerated by OASIS v0.4.5
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -4631,7 +4631,7 @@ module BaseDynVar = struct
 
   let init pkg =
     (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
-    (* TODO: provide compile option for library library_byte_args_VARNAME... *)
+    (* TODO: provide compile option for library libary_byte_args_VARNAME... *)
     List.iter
       (function
          | Executable (cs, bs, exec) ->
@@ -6685,7 +6685,13 @@ let setup_t =
           license_file = None;
           copyrights = [];
           maintainers = [];
-          authors = ["Thomas Gazagnaire"; "Anil Madhavapeddy"];
+          authors =
+            [
+               "Thomas Gazagnaire";
+               "Anil Madhavapeddy";
+               "Dave Scott";
+               "Thomas Leonard"
+            ];
           homepage = None;
           synopsis = "Mirage configuration tool";
           description = None;
@@ -6829,14 +6835,14 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.5";
-     oasis_digest = Some "L\151ÀßFñFÿ\134¾êß\128\025µ©";
+     oasis_digest = Some "\129\198nZ_W\170^,\138\209\240\178P\180\153";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
   };;
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 6841 "setup.ml"
+# 6847 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

types/META

@@ -1,11 +1,11 @@
-version = "2.2.1"
+version = "2.3.0"
 description = "Collection of module signatures for Mirage"
 archive(byte) = ""
 archive(byte, plugin) = ""
 archive(native) = ""
 exists_if = "V1.cmi"
 package "lwt" (
-  version = "2.2.0"
+  version = "2.3.0"
   description = "Lwt module signatures for Mirage"
   archive(byte) = ""
   archive(byte, plugin) = ""

types/V1.mli

@@ -27,18 +27,11 @@ module type DEVICE = sig
   (** The type representing the internal state of the device *)
 
   type error
-  (** An error signalled by the device, normally returned after a
-      connection attempt *)
+  (** An error signalled by the device *)
 
   type id
-  (** Type defining an identifier for this device that uniquely
-      identifies it among a device tree. *)
-
-  val id : t -> id
-  (** Return the identifier that was used to construct this device *)
-
-  val connect: id -> [ `Error of error | `Ok of t ] io
-  (** Connect to the device identified by [id] *)
+  (** This type is no longer used and will be removed once other
+   * modules stop using it in their type signatures. *)
 
   val disconnect : t -> unit io
   (** Disconnect from the device.  While this might take some
@@ -148,6 +141,9 @@ module type FLOW = sig
 
   type error
 
+  val error_message : error -> string
+  (** Convert an error to a human-readable message, suitable for logging. *)
+
   val read : flow -> [`Ok of buffer | `Eof | `Error of error ] io
   (** [read flow] will block until it either successfully reads a segment
       of data from the current flow, receives an [Eof] signifying that
@@ -443,6 +439,20 @@ module type IP = sig
 
   val get_ip_gateways: t -> ipaddr list
   (** Get the IP gateways associated with this interface. *)
+
+  type uipaddr
+  (** The type for universal IP addresses. It supports all the
+      possible versions. *)
+
+  val to_uipaddr: ipaddr -> uipaddr
+  (** Convert an IP address with a specific version (eg. V4) into a
+      universal IP address. *)
+
+  val of_uipaddr: uipaddr -> ipaddr option
+  (** Project a universal IP address into the version supported by the
+      current implementation. Return [None] if there is a version
+      mismatch. *)
+
 end
 
 module type IPV4 = sig

types/V1_LWT.mli

@@ -42,20 +42,23 @@ module type ETHIF = ETHIF
 module type IP = IP
   with type 'a io = 'a Lwt.t
    and type buffer = Cstruct.t
+   and type uipaddr = Ipaddr.t
 
 (** IPv4 stack *)
 module type IPV4 = IPV4
   with type 'a io = 'a Lwt.t
    and type buffer = Cstruct.t
    and type ipaddr = Ipaddr.V4.t
    and type prefix = Ipaddr.V4.t (* FIXME: Use Ipaddr.V4.Prefix.t *)
+   and type uipaddr = Ipaddr.t
 
 (** IPv6 stack *)
 module type IPV6 = IPV6
   with type 'a io = 'a Lwt.t
    and type buffer = Cstruct.t
    and type ipaddr = Ipaddr.V6.t
    and type prefix = Ipaddr.V6.Prefix.t
+   and type uipaddr = Ipaddr.t
 
 (** UDP stack *)
 module type UDP = UDP