Merge pull request mirage#40 from avsm/master

v0.9.5, remove socket backend

.travis-ci.sh

@@ -0,0 +1,29 @@
+# OPAM packages needed to build tests.
+OPAM_PACKAGES="mirage-net-unix mirage-clock-unix"
+
+case "$OCAML_VERSION,$OPAM_VERSION" in
+3.12.1,1.0.0) ppa=avsm/ocaml312+opam10 ;;
+3.12.1,1.1.0) ppa=avsm/ocaml312+opam11 ;;
+4.00.1,1.0.0) ppa=avsm/ocaml40+opam10 ;;
+4.00.1,1.1.0) ppa=avsm/ocaml40+opam11 ;;
+4.01.0,1.0.0) ppa=avsm/ocaml41+opam10 ;;
+4.01.0,1.1.0) ppa=avsm/ocaml41+opam11 ;;
+*) echo Unknown $OCAML_VERSION,$OPAM_VERSION; exit 1 ;;
+esac
+
+echo "yes" | sudo add-apt-repository ppa:$ppa
+sudo apt-get update -qq
+sudo apt-get install -qq ocaml ocaml-native-compilers camlp4-extra opam
+export OPAMYES=1
+export OPAMVERBOSE=1
+echo OCaml version
+ocaml -version
+echo OPAM versions
+opam --version
+opam --git-version
+
+opam init 
+opam install ${OPAM_PACKAGES}
+
+eval `opam config env`
+make

.travis.yml

@@ -0,0 +1,6 @@
+language: c
+script: bash -ex .travis-ci.sh
+env:
+  - OCAML_VERSION=4.01.0 OPAM_VERSION=1.1.0
+  - OCAML_VERSION=4.00.1 OPAM_VERSION=1.1.0
+  - OCAML_VERSION=3.12.1 OPAM_VERSION=1.1.0

CHANGES

@@ -1,5 +1,11 @@
+0.9.5 (08-December-2013):
+* Shift to the `mirage-types` 0.5.0+ interfaces, which breaks the
+  socket backend (temporarily).
+* Port the direct stack to the new interfaces.
+* Add Travis CI scripts.
+
 0.9.4 (09-August-2013):
-* Use the `Ipaddr` external library and remove the homebrew
+* Use the `Ipaddr` external library and remove the Homebrew
   equivalents in `Nettypes`.
 
 0.9.3 (18-July-2013):

direct/META.in → META.in

@@ -2,4 +2,4 @@ version = "@VERSION@"
 description = "TCP/IP networking stack"
 archive(byte) = "net.cma"
 archive(native) = "net.cmxa"
-requires = "mirage ipaddr"
+requires = "mirage-clock-unix mirage-unix mirage-net-unix ipaddr cstruct"

Makefile

@@ -1,25 +1,23 @@
-NET ?= socket
+.PHONY: all _config build install doc clean
 
-ifneq "$(MIRAGE_NET)" ""
-NET := $(MIRAGE_NET)
-endif
+PREFIX ?= /usr/local
+INSTALLDIR := $(DESTDIR)$(PREFIX)
+INCLUDE := $(INSTALLDIR)/include/mirage
+XEN_INCLUDE := $(INCLUDE)/xen
 
-.PHONY: all clean install test
-.DEFAULT: all
+all: build
+
+_config:
+	./cmd configure
+
+build: _config
+	./cmd build
 
-all:
-	cd $(NET) && $(MAKE) all
-build:
-	cd $(NET) && $(MAKE) all
-clean:
-	cd $(NET) && $(MAKE) clean
 install:
-	cd $(NET) && $(MAKE) install
-test:
-	cd $(NET) && $(MAKE) test
+	./cmd install
 
-socket-%:
-	$(MAKE) NET=socket $*
+doc: _config
+	./cmd doc
 
-direct-%:
-	$(MAKE) NET=direct $*
+clean:
+	./cmd clean

direct/_tags → _tags

@@ -10,5 +10,4 @@
 <lib_test/*>: use_lib, custom
 <syntax/*>: build_syntax
 true: camlp4o
-<**/*.{mli,ml}>: package(mirage), package(cstruct)
-true: annot
+true: annot, bin_annot, debug

_vars

@@ -0,0 +1,5 @@
+NAME=mirage-tcpip-direct-unix
+VERSION=0.9.5
+DEPS="mirage-clock-unix mirage-unix mirage-net-unix ipaddr cstruct"
+SYNTAX_DEPS="cstruct.syntax lwt.syntax"
+LIB="net"

direct/lib/channel.ml → lib/channel.ml

@@ -139,7 +139,7 @@ module Make(Flow:FLOW) :
   (* Output functions *)
 
   let alloc_obuf t =
-    let buf = Cstruct.of_bigarray (OS.Io_page.get 1) in
+    let buf = Cstruct.of_bigarray (Io_page.get 1) in
     t.obuf <- Some buf;
     t.opos <- 0;
     buf

direct/lib/config.mli → lib/config.mli

@@ -17,4 +17,4 @@
 (** Configuration modes for interfaces. 
    Defaults to DHCP, and individual ids can be assigned static IPs *)
 
-val t: OS.Netif.id -> [ `DHCP | `IPv4 of Ipaddr.V4.t * Ipaddr.V4.t * Ipaddr.V4.t list ]
+val t: Netif.id -> [ `DHCP | `IPv4 of Ipaddr.V4.t * Ipaddr.V4.t * Ipaddr.V4.t list ]

direct/lib/dhcp/client.ml → lib/dhcp/client.ml

@@ -70,7 +70,7 @@ let output_broadcast t ~xid ~yiaddr ~siaddr ~options =
   let options = Option.Packet.to_bytes options in
   let options_len = String.length options in
   let total_len = options_len + sizeof_dhcp in
-  let buf = OS.Io_page.(to_cstruct (get 1)) in
+  let buf = Io_page.(to_cstruct (get 1)) in
   set_dhcp_op buf (mode_to_int BootRequest);
   set_dhcp_htype buf 1;
   set_dhcp_hlen buf 6;

direct/lib/ethif.ml → lib/ethif.ml

@@ -24,7 +24,7 @@ type packet =
 | Output of Cstruct.t list
 
 type t = {
-  netif: OS.Netif.t;
+  netif: Netif.t;
   mac: Macaddr.t;
   arp: Arp.t;
   mutable ipv4: (Cstruct.t -> unit Lwt.t);
@@ -58,31 +58,31 @@ let set_promiscuous t f =
 let disable_promiscuous t =
     t.promiscuous <- None
 
-(* Loop and listen for frames *)
-let rec listen t =
-  OS.Netif.listen t.netif (input t)
-
 let get_frame t =
-  OS.Netif.get_writebuf t.netif
+  return (Io_page.to_cstruct (Io_page.get 1))
 
 let write t frame =
   match t.promiscuous with
-  |Some f -> f (Output [frame]) >>= fun () -> OS.Netif.write t.netif frame
-  |None -> OS.Netif.write t.netif frame
+  |Some f -> f (Output [frame]) >>= fun () -> Netif.write t.netif frame
+  |None -> Netif.write t.netif frame
 
 let writev t bufs =
   match t.promiscuous with
-  |Some f -> f (Output bufs) >>= fun () -> OS.Netif.writev t.netif bufs
-  |None -> OS.Netif.writev t.netif bufs
+  |Some f -> f (Output bufs) >>= fun () -> Netif.writev t.netif bufs
+  |None -> Netif.writev t.netif bufs
+
+(* Loop and listen for frames *)
+let rec listen t =
+  Netif.listen t.netif (input t)
 
 let create netif =
   let ipv4 = fun (_:Cstruct.t) -> return () in
   (* TODO: there's a race here if the MAC can change in the future *)
-  let mac = OS.Netif.mac netif in
+  let mac = Netif.mac netif in
   let arp =
     let get_mac () = mac in
-    let get_etherbuf () = OS.Netif.get_writebuf netif in
-    let output buf = OS.Netif.write netif buf in
+    let get_etherbuf () = return (Io_page.to_cstruct (Io_page.get 1)) in
+    let output buf = Netif.write netif buf in
     Arp.create ~output ~get_mac ~get_etherbuf in
   let t = { netif; ipv4; mac; arp; promiscuous=None; } in
   let listen = listen t in

direct/lib/ethif.mli → lib/ethif.mli

@@ -32,7 +32,7 @@ type packet =
     and calls [listen] on the result. It returns a tuple composed of a
     value of type t, and the result of the [listen] function that has
     been called on it. *)
-val create : OS.Netif.t -> t * unit Lwt.t
+val create : Netif.t -> t * unit Lwt.t
 
 (** Functions to set up callback for processing an IPv4 packet. By
     default, [create] ignores all received packets, so use [attach] to
@@ -46,7 +46,7 @@ val detach : t -> [< `IPv4 ] -> unit
 (** Accessors for t values *)
 
 val mac       : t -> Macaddr.t
-val get_netif : t -> OS.Netif.t
+val get_netif : t -> Netif.t
 
 
 (** [set_promiscuous ethif cb] will install [cb] as a callback to be
@@ -68,11 +68,6 @@ val default_process : t -> Cstruct.t -> unit Lwt.t
     callback function *)
 val input : t -> Cstruct.t -> unit Lwt.t
 
-(** [listen ethif] will loop on interface [ethif] waiting for incoming
-    frames, and will use the [input] function to process them. *)
-val listen : t -> unit Lwt.t
-
-
 (** Functions related to the ARP protocol, and applied to the arp
     value contained inside [t]. Please refer to the documentation of
     module [Arp] for more information. *)
@@ -97,5 +92,3 @@ val sizeof_ethernet : int
 val set_ethernet_dst : string -> int -> Cstruct.t -> unit
 val set_ethernet_src : string -> int -> Cstruct.t -> unit
 val set_ethernet_ethertype : Cstruct.t -> int -> unit
-
-

direct/lib/manager.ml → lib/manager.ml

@@ -21,7 +21,7 @@
 open Lwt
 open Nettypes
 
-type id = OS.Netif.id
+type id = Netif.id
 
 type interface = {
   id    : id;
@@ -52,13 +52,12 @@ type config = [ `DHCP | `IPv4 of Ipaddr.V4.t * Ipaddr.V4.t * Ipaddr.V4.t list ]
 let configure i =
   function
   |`DHCP ->
-    Printf.printf "Manager: Interface %s to DHCP\n%!" (OS.Netif.string_of_id i.id);
+    Printf.printf "Manager: Interface %s to DHCP\n%!" (i.id);
     lwt t, th = Dhcp.Client.create i.ipv4 i.udp in
     Printf.printf "Manager: DHCP done\n%!";
     return ()
   |`IPv4 (addr, netmask, gateways) ->
-    Printf.printf "Manager: Interface %s to %s nm %s gw [%s]\n%!"
-      (OS.Netif.string_of_id i.id)
+    Printf.printf "Manager: Interface %s to %s nm %s gw [%s]\n%!" i.id
       (Ipaddr.V4.to_string addr)
       (Ipaddr.V4.to_string netmask)
       (String.concat ", " (List.map Ipaddr.V4.to_string gateways));
@@ -69,8 +68,8 @@ let configure i =
 
 (* Plug in a new network interface with given id *)
 let plug t netif =
-  let id = OS.Netif.id netif in
-  Printf.printf "Manager: plug %s\n%!" (OS.Netif.string_of_id id);
+  let id = Netif.id netif in
+  Printf.printf "Manager: plug %s\n%!" id;
   let (ethif, ethif_t) = Ethif.create netif in
   let (ipv4, ipv4_t)   = Ipv4.create ethif in
   let (icmp, icmp_t)   = Icmp.create ipv4 in
@@ -91,11 +90,10 @@ let unplug t id =
 
 (* Manage the protocol threads. The listener becomes a new thread
    that is spawned when a new interface shows up. *)
-let create cb =
+let create intfs cb =
   Printf.printf "Manager: create\n%!";
   let listeners = Hashtbl.create 1 in
   let t = { cb; listeners } in
-  lwt intfs = OS.Netif.create () in
   let () = List.iter (plug t) intfs in
   (* Now asynchronously launching the callbacks! *)
   Hashtbl.iter (fun id intf ->

direct/lib/manager.mli → lib/manager.mli

@@ -27,7 +27,7 @@ type config = [ `DHCP | `IPv4 of Ipaddr.V4.t * Ipaddr.V4.t * Ipaddr.V4.t list ]
 
 (** Textual id identifying a network interface, typically "tap0" on
     UNIX and "0" on Xen. *)
-type id = OS.Netif.id
+type id = Netif.id
 
 (** Type representing a network interface, including facilities to
     send data (Ethernet frames, IP packets, ICMP, UDP, TCP, ...)
@@ -55,7 +55,7 @@ val get_tcp   : interface -> Tcp.Pcb.t
     of type interface for each of those devices and call [callback] of
     each of them. The return value is a cancellable thread that will
     free all interface values when cancelled. *)
-val create : callback -> unit Lwt.t
+val create : Netif.t list -> callback -> unit Lwt.t
 
 (** [configure intf cfg] applies [cfg] to [intf]. After this step,
     depending on the configuration (DHCP or static address), [intf]

direct/lib/tcp/pcb.ml → lib/tcp/pcb.ml

@@ -60,7 +60,7 @@ type listener = {
 }
 
 
-let pbuf = Cstruct.sub (Cstruct.of_bigarray (OS.Io_page.get 1)) 0 sizeof_pseudo_header 
+let pbuf = Cstruct.sub (Cstruct.of_bigarray (Io_page.get 1)) 0 sizeof_pseudo_header 
 let checksum ~src ~dst =
   fun data ->
     set_pseudo_header_src pbuf (Ipaddr.V4.to_int32 src);

direct/lib/tcp/profiler.ml → lib/tcp/profiler.ml

@@ -16,7 +16,7 @@
 
 open Printf
 
-let lastprinttime = ref (OS.Clock.time ())
+let lastprinttime = ref (Clock.time ())
 let totaltime = ref 0.0
 let epochlen = 1.0
 
@@ -41,18 +41,18 @@ let start s =
 	printf "Profiler error: %s was running and started again - ignoring start\n%!" s
       end else begin
 	p.on <- true;
-	p.start <- (OS.Clock.time ());
+	p.start <- (Clock.time ());
       end
   | None ->
       let name = s in
       let total = 0.0 in
       let recent = 0.0 in
-      let start = (OS.Clock.time ()) in
+      let start = (Clock.time ()) in
       let on = true in
       Hashtbl.add profiles s {name; total; recent; start; on}
 
 let finish s =
-  let ctime = OS.Clock.time () in
+  let ctime = Clock.time () in
   let finish_p s = match (hashtbl_find profiles s) with
   | Some p ->
       if p.on then begin

direct/lib/tcp/user_buffer.ml → lib/tcp/user_buffer.ml

@@ -159,7 +159,7 @@ module Tx = struct
   let compactbufs bl =
     (* TODO: fix hardecoded threshold *)
     if (List.length bl > 8) then begin
-      let b = OS.Io_page.(to_cstruct (get 1)) in
+      let b = Io_page.(to_cstruct (get 1)) in
       let copyf doff ab =
 	Cstruct.blit ab 0 b doff (Cstruct.len ab);
 	doff + (Cstruct.len ab)

direct/lib/tcp/window.ml → lib/tcp/window.ml

@@ -156,7 +156,7 @@ let tx_advance t b =
   if not t.rtt_timer_on && not t.fast_recovery then begin
     t.rtt_timer_on <- true;
     t.rtt_timer_seq <- t.tx_nxt;
-    t.rtt_timer_starttime <- OS.Clock.time ();
+    t.rtt_timer_starttime <- Clock.time ();
   end;
   t.tx_nxt <- Sequence.add t.tx_nxt (Sequence.of_int b)
 
@@ -179,7 +179,7 @@ let tx_ack t r win =
       t.snd_una <- r;
       if t.rtt_timer_on && Sequence.gt r t.rtt_timer_seq then begin
         t.rtt_timer_on <- false;
-        let rtt_m = OS.Clock.time () -. t.rtt_timer_starttime in
+        let rtt_m = Clock.time () -. t.rtt_timer_starttime in
 	if t.rtt_timer_reset then begin
 	  t.rtt_timer_reset <- false;
           t.rttvar <- (0.5 *. rtt_m);