diff --git a/.travis.yml b/.travis.yml index a7ca57f..2b5d052 100644 --- a/.travis.yml +++ b/.travis.yml @@ -7,6 +7,7 @@ script: bash -ex ./.travis-docker.sh env: global: - PACKAGE="mirage-net-unix" + - EXTRA_REMOTES="https://github.com/mirage/mirage-dev.git#layering" matrix: - DISTRO="alpine" OCAML_VERSION="4.04" - DISTRO="alpine" OCAML_VERSION="4.05" diff --git a/mirage-net-unix.opam b/mirage-net-unix.opam index a808b0e..1b37271 100644 --- a/mirage-net-unix.opam +++ b/mirage-net-unix.opam @@ -13,17 +13,18 @@ depends: [ "cstruct" {>= "1.7.1"} "cstruct-lwt" "lwt" {>= "2.4.3"} - "mirage-net-lwt" {>= "1.0.0"} - "io-page-unix" {>= "2.0.0"} - "tuntap" {>= "1.3.0"} + "mirage-net-lwt" {>= "2.0.0"} + "tuntap" {>= "1.8.0"} "alcotest" {with-test} + "logs" + "macaddr" ] build: [ ["dune" "subst"] {pinned} ["dune" "build" "-p" name "-j" jobs] ] dev-repo: "git+https://github.com/mirage/mirage-net-unix.git" -synopsis: "Unix implementation of the Mirage NETWORK interface" +synopsis: "Unix implementation of the Mirage_net_lwt interface" description: """ This interface exposes raw Ethernet frames using `ocaml-tuntap`, suitable for use with an OCaml network stack such as the one diff --git a/src/dune b/src/dune index ffa17ec..10330e9 100644 --- a/src/dune +++ b/src/dune @@ -1,5 +1,5 @@ (library (name mirage_net_unix) (public_name mirage-net-unix) - (libraries io-page-unix cstruct cstruct-lwt lwt.unix mirage-net-lwt tuntap) + (libraries logs macaddr cstruct cstruct-lwt lwt.unix mirage-net-lwt tuntap) (wrapped false)) diff --git a/src/netif.ml b/src/netif.ml index 1efd58c..89f0a1f 100644 --- a/src/netif.ml +++ b/src/netif.ml @@ -14,15 +14,13 @@ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) +open Lwt.Infix [@@@warning "-52"] -open Result open Mirage_net -let log fmt = Format.printf ("Netif: " ^^ fmt ^^ "\n%!") - -let (>>=) = Lwt.(>>=) -let (>|=) = Lwt.(>|=) +let src = Logs.Src.create "netif" ~doc:"Mirage unix network module" +module Log = (val Logs.src_log src : Logs.LOG) type +'a io = 'a Lwt.t @@ -30,27 +28,26 @@ type t = { id: string; dev: Lwt_unix.file_descr; mutable active: bool; - mutable mac: Macaddr.t; + mac: Macaddr.t; + mtu : int; stats : Mirage_net.stats; } let fd t = t.dev type error = [ - | Mirage_net.error + | Mirage_net.Net.error | `Partial of string * int * Cstruct.t | `Exn of exn ] let pp_error ppf = function - | #Mirage_net.error as e -> Mirage_net.pp_error ppf e + | #Mirage_net.Net.error as e -> Mirage_net.Net.pp_error ppf e | `Partial (id, len', buffer) -> Fmt.pf ppf "netif %s: partial write (%d, expected %d)" id len' buffer.Cstruct.len | `Exn e -> Fmt.exn ppf e -let devices = Hashtbl.create 1 - let err_permission_denied devname = Printf.sprintf "Permission denied while opening the %s device. Please re-run using sudo." @@ -63,14 +60,15 @@ let connect devname = let dev = Lwt_unix.of_unix_file_descr ~blocking:true fd in let mac = Macaddr.make_local (fun _ -> Random.int 256) in Tuntap.set_up_and_running devname; - log "plugging into %s with mac %s" devname (Macaddr.to_string mac); + let mtu = Tuntap.get_mtu devname in + Log.debug (fun m -> m "plugging into %s with mac %a and mtu %d" + devname Macaddr.pp mac mtu); let active = true in let t = { - id=devname; dev; active; mac; + id=devname; dev; active; mac; mtu; stats= { rx_bytes=0L;rx_pkts=0l; tx_bytes=0L; tx_pkts=0l } } in - Hashtbl.add devices devname t; - log "connect %s" devname; + Log.info (fun m -> m "connect %s with mac %a" devname Macaddr.pp mac); Lwt.return t with | Failure "tun[open]: Permission denied" -> @@ -78,19 +76,17 @@ let connect devname = | exn -> Lwt.fail exn let disconnect t = - log "disconnect %s" t.id; + Log.info (fun m -> m "disconnect %s" t.id); t.active <- false; Lwt_unix.close t.dev >>= fun () -> Tuntap.closetap t.id; Lwt.return_unit type macaddr = Macaddr.t -type page_aligned_buffer = Io_page.t type buffer = Cstruct.t (* Input a frame, and block if nothing is available *) -let rec read t page = - let buf = Io_page.to_cstruct page in +let rec read t buf = let process () = Lwt.catch (fun () -> Lwt_cstruct.read t.dev buf >|= function @@ -103,17 +99,17 @@ let rec read t page = Ok buf) (function | Unix.Unix_error(Unix.ENXIO, _, _) -> - log "[read] device %s is down, stopping" t.id; + Log.err (fun m -> m "[read] device %s is down, stopping" t.id); Lwt.return (Error `Disconnected) | Lwt.Canceled -> - log "[read] user program requested cancellation of listen on %s" t.id; + Log.err (fun m -> m "[read] user program requested cancellation of listen on %s" t.id); Lwt.return (Error `Canceled) | exn -> - log "[read] error: %s, continuing" (Printexc.to_string exn); + Log.err (fun m -> m "[read] error: %s, continuing" (Printexc.to_string exn)); Lwt.return (Error `Continue)) in process () >>= function - | Error `Continue -> read t page + | Error `Continue -> read t buf | Error `Canceled -> Lwt.return (Error `Canceled) | Error `Disconnected -> Lwt.return (Error `Disconnected) | Ok buf -> Lwt.return (Ok buf) @@ -122,51 +118,50 @@ let safe_apply f x = Lwt.catch (fun () -> f x) (fun exn -> - log "[listen] error while handling %s, continuing. bt: %s" - (Printexc.to_string exn) (Printexc.get_backtrace ()); + Log.err (fun m -> m "[listen] error while handling %s, continuing. bt: %s" + (Printexc.to_string exn) (Printexc.get_backtrace ())); Lwt.return_unit) + (* Loop and listen for packets permanently *) (* this function has to be tail recursive, since it is called at the top level, otherwise memory of received packets and all reachable data is never claimed. take care when modifying, here be dragons! *) -let rec listen t fn = +let rec listen t ~header_size fn = match t.active with | true -> - let page = Io_page.get 1 in + let buf = Cstruct.create (t.mtu + header_size) in let process () = - read t page >|= function + read t buf >|= function | Ok buf -> Lwt.async (fun () -> safe_apply fn buf) ; Ok () | Error `Canceled -> Error `Disconnected | Error `Disconnected -> t.active <- false ; Error `Disconnected in process () >>= (function - | Ok () -> (listen[@tailcall]) t fn + | Ok () -> (listen[@tailcall]) t ~header_size fn | Error e -> Lwt.return (Error e)) | false -> Lwt.return (Ok ()) (* Transmit a packet from a Cstruct.t *) -let write t buffer = - let open Cstruct in - (* Unfortunately we peek inside the cstruct type here: *) +let write t ~size fillf = (* This is the interface to the cruel Lwt world with exceptions, we've to guard *) - Lwt.catch (fun () -> - Lwt_bytes.write t.dev buffer.buffer buffer.off buffer.len >|= fun len' -> - t.stats.tx_pkts <- Int32.succ t.stats.tx_pkts; - t.stats.tx_bytes <- Int64.add t.stats.tx_bytes (Int64.of_int buffer.len); - if len' <> buffer.len then Error (`Partial (t.id, len', buffer)) - else Ok ()) - (fun exn -> Lwt.return (Error (`Exn exn))) - - -let writev t = function - | [] -> Lwt.return (Ok ()) - | [page] -> write t page - | pages -> - write t @@ Cstruct.concat pages + let buf = Cstruct.create size in + let len = fillf buf in + if len > size then + Lwt.return (Error `Invalid_length) + else + Lwt.catch (fun () -> + Lwt_bytes.write t.dev buf.Cstruct.buffer 0 len >|= fun len' -> + t.stats.tx_pkts <- Int32.succ t.stats.tx_pkts; + t.stats.tx_bytes <- Int64.add t.stats.tx_bytes (Int64.of_int len); + if len' <> len then Error (`Partial (t.id, len', buf)) + else Ok ()) + (fun exn -> Lwt.return (Error (`Exn exn))) let mac t = t.mac +let mtu t = t.mtu + let get_stats_counters t = t.stats let reset_stats_counters t = diff --git a/test/test.ml b/test/test.ml index 9b72af8..f83701e 100644 --- a/test/test.ml +++ b/test/test.ml @@ -34,9 +34,9 @@ let test_close () = let test_write () = Netif.connect "tap2" >>= fun t -> - let data = Cstruct.create 4096 in - Netif.writev t [ data ] >>= fun _t -> - Netif.writev t [ data ; (Cstruct.create 14) ] >>= fun _t -> + let mtu = Netif.mtu t in + Netif.write t ~size:mtu (fun _data -> mtu) >>= fun _t -> + Netif.write t ~size:(mtu + 14) (fun _data -> mtu + 14) >>= fun _t -> Lwt.return_unit let suite = [