Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

use full range for sequence numbers #374

Closed
wants to merge 10 commits into from
6 changes: 2 additions & 4 deletions src/arpv4/arpv4.ml
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@
*)

open Lwt.Infix
open Result

let src = Logs.Src.create "arpv4" ~doc:"Mirage ARP module"
module Log = (val Logs.src_log src : Logs.LOG)
Expand All @@ -29,7 +28,6 @@ module Make (Ethif : Mirage_protocols_lwt.ETHIF)
type buffer = Cstruct.t
type ipaddr = Ipaddr.V4.t
type macaddr = Macaddr.t
type ethif = Ethif.t
type repr = string
type error = Mirage_protocols.Arp.error
let pp_error = Mirage_protocols.Arp.pp_error
Expand Down Expand Up @@ -120,11 +118,11 @@ module Make (Ethif : Mirage_protocols_lwt.ETHIF)
let open Arpv4_packet in
MProf.Trace.label "arpv4.input";
match Unmarshal.of_cstruct frame with
| Result.Error s ->
| Error s ->
Log.debug (fun f -> f "Failed to parse arpv4 header: %a (buffer: %S)"
Unmarshal.pp_error s (Cstruct.to_string frame));
Lwt.return_unit
| Result.Ok arp ->
| Ok arp ->
notify t arp.spa arp.sha; (* cache the sender's mapping. this will get GARPs too *)
match arp.op with
| Arpv4_wire.Reply -> Lwt.return_unit
Expand Down
4 changes: 1 addition & 3 deletions src/arpv4/arpv4.mli
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,6 @@ module Make (Ethif : Mirage_protocols_lwt.ETHIF)
(Time : Mirage_time_lwt.S) : sig
include Mirage_protocols_lwt.ARP

type ethif = Ethif.t

(** [connect] creates a value of type [t]. *)
val connect : ethif -> Clock.t -> t Lwt.t
val connect : Ethif.t -> Clock.t -> t Lwt.t
end
32 changes: 16 additions & 16 deletions src/arpv4/arpv4_packet.ml
Original file line number Diff line number Diff line change
Expand Up @@ -39,33 +39,33 @@ module Unmarshal = struct
let of_cstruct buf =
let open Rresult in
let check_len buf =
if (Cstruct.len buf) < sizeof_arp then (Result.Error Too_short) else
Result.Ok buf
if (Cstruct.len buf) < sizeof_arp then (Error Too_short) else
Ok buf
in
let check_types buf =
(* we only know how to deal with ethernet <-> IPv4 *)
if get_arp_htype buf <> 1 || get_arp_ptype buf <> 0x0800
|| get_arp_hlen buf <> 6 || get_arp_plen buf <> 4 then Result.Error Unusable
else Result.Ok buf
|| get_arp_hlen buf <> 6 || get_arp_plen buf <> 4 then Error Unusable
else Ok buf
in
let check_op buf = match get_arp_op buf |> Arpv4_wire.int_to_op with
| Some op -> Result.Ok op
| None -> Result.Error (Unknown_code (get_arp_op buf))
| Some op -> Ok op
| None -> Error (Unknown_code (get_arp_op buf))
in
check_len buf >>= check_types >>= check_op >>= fun op ->
let src_mac = copy_arp_sha buf in
let target_mac = copy_arp_tha buf in
match (Macaddr.of_bytes src_mac, Macaddr.of_bytes target_mac) with
| None, None -> Result.Error (Bad_mac [ src_mac ; target_mac ])
| None, Some _ -> Result.Error (Bad_mac [ src_mac ])
| Some _, None -> Result.Error (Bad_mac [ target_mac ])
| None, None -> Error (Bad_mac [ src_mac ; target_mac ])
| None, Some _ -> Error (Bad_mac [ src_mac ])
| Some _, None -> Error (Bad_mac [ target_mac ])
| Some src_mac, Some target_mac ->
let src_ip = Ipaddr.V4.of_int32 (get_arp_spa buf) in
let target_ip = Ipaddr.V4.of_int32 (get_arp_tpa buf) in
Result.Ok { op;
sha = src_mac; spa = src_ip;
tha = target_mac; tpa = target_ip
}
Ok { op;
sha = src_mac; spa = src_ip;
tha = target_mac; tpa = target_ip
}
end
module Marshal = struct

Expand All @@ -80,8 +80,8 @@ module Marshal = struct

let check_len buf =
if sizeof_arp > Cstruct.len buf then
Result.Error "Not enough space for an arpv4 header"
else Result.Ok ()
Error "Not enough space for an arpv4 header"
else Ok ()

(* call only with bufs that are sure to be large enough (>= 24 bytes) *)
let unsafe_fill t buf =
Expand All @@ -100,7 +100,7 @@ module Marshal = struct
let open Rresult in
check_len buf >>= fun () ->
unsafe_fill t buf;
Result.Ok ()
Ok ()

let make_cstruct t =
let buf = Cstruct.create sizeof_arp in
Expand Down
4 changes: 2 additions & 2 deletions src/arpv4/arpv4_packet.mli
Original file line number Diff line number Diff line change
Expand Up @@ -21,15 +21,15 @@ module Unmarshal : sig

val pp_error : Format.formatter -> error -> unit

val of_cstruct : Cstruct.t -> (t, error) Result.result
val of_cstruct : Cstruct.t -> (t, error) result
end
module Marshal : sig
type error = string

(** [into_cstruct t buf] attempts to write an ARP header representing
[t.op], and the source/destination ip/mac in [t] into [buf] at offset 0.
[buf] should be at least 24 bytes in size for the call to succeed. *)
val into_cstruct : t -> Cstruct.t -> (unit, error) Result.result
val into_cstruct : t -> Cstruct.t -> (unit, error) result

(** given a [t], construct and return an ARP header representing
[t.op], and the source/destination ip/mac in [t]. [make_cstruct] will allocate
Expand Down
2 changes: 0 additions & 2 deletions src/ethif/ethif.ml
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,6 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
open Result
open Lwt.Infix

let src = Logs.Src.create "ethif" ~doc:"Mirage Ethernet"
Expand All @@ -28,7 +27,6 @@ module Make(Netif : Mirage_net_lwt.S) = struct
type 'a io = 'a Lwt.t
type buffer = Cstruct.t
type macaddr = Macaddr.t
type netif = Netif.t

type error = Netif.error
let pp_error = Netif.pp_error
Expand Down
4 changes: 2 additions & 2 deletions src/ethif/ethif.mli
Original file line number Diff line number Diff line change
Expand Up @@ -16,9 +16,9 @@
*)

module Make ( N:Mirage_net_lwt.S) : sig
include Mirage_protocols_lwt.ETHIF with type netif = N.t
include Mirage_protocols_lwt.ETHIF

val connect : ?mtu:int -> netif -> t Lwt.t
val connect : ?mtu:int -> N.t -> t Lwt.t
(** [connect ?mtu netif] connects an ethernet layer on top of the raw
network device [netif]. The Maximum Transfer Unit may be set via the
optional [?mtu] parameter, otherwise a default value of 1500 will be
Expand Down
12 changes: 6 additions & 6 deletions src/ethif/ethif_packet.ml
Original file line number Diff line number Diff line change
Expand Up @@ -22,25 +22,25 @@ module Unmarshal = struct
let of_cstruct frame =
if Cstruct.len frame >= sizeof_ethernet then
match get_ethernet_ethertype frame |> int_to_ethertype with
| None -> Result.Error (Printf.sprintf "unknown ethertype 0x%x in frame"
| None -> Error (Printf.sprintf "unknown ethertype 0x%x in frame"
(get_ethernet_ethertype frame))
| Some ethertype ->
let payload = Cstruct.shift frame sizeof_ethernet
and source = Macaddr.of_bytes_exn (copy_ethernet_src frame)
and destination = Macaddr.of_bytes_exn (copy_ethernet_dst frame)
in
Result.Ok ({ destination; source; ethertype;}, payload)
Ok ({ destination; source; ethertype;}, payload)
else
Result.Error "frame too small to contain a valid ethernet header"
Error "frame too small to contain a valid ethernet header"
end

module Marshal = struct
open Rresult

let check_len buf =
if sizeof_ethernet > Cstruct.len buf then
Result.Error "Not enough space for an Ethernet header"
else Result.Ok ()
Error "Not enough space for an Ethernet header"
else Ok ()

let unsafe_fill t buf =
set_ethernet_dst (Macaddr.to_bytes t.destination) 0 buf;
Expand All @@ -50,7 +50,7 @@ module Marshal = struct

let into_cstruct t buf =
check_len buf >>= fun () ->
Result.Ok (unsafe_fill t buf)
Ok (unsafe_fill t buf)

let make_cstruct t =
let buf = Cstruct.create sizeof_ethernet in
Expand Down
6 changes: 3 additions & 3 deletions src/ethif/ethif_packet.mli
Original file line number Diff line number Diff line change
Expand Up @@ -10,16 +10,16 @@ val pp : Format.formatter -> t -> unit
val equal : t -> t -> bool

module Unmarshal : sig
val of_cstruct : Cstruct.t -> ((t * Cstruct.t), error) Result.result
val of_cstruct : Cstruct.t -> ((t * Cstruct.t), error) result
end
module Marshal : sig
(** [into_cstruct t buf] writes a 14-byte ethernet header representing
[t.ethertype], [t.src_mac], and [t.dst_mac] to [buf] at offset 0.
Return Result.Ok () on success and Result.Error error on failure.
Returns [Ok ()] on success and [Error error] on failure.
Currently, the only possibility for failure
is a [buf] too small to contain the header; to avoid this, provide a
buffer of size at least 14. *)
val into_cstruct : t -> Cstruct.t -> (unit, error) Result.result
val into_cstruct : t -> Cstruct.t -> (unit, error) result

(** given a [t], construct and return an Ethernet header representing
[t.ethertype], [t.source], and [t.destination]. [make_cstruct] will allocate
Expand Down
5 changes: 2 additions & 3 deletions src/icmp/icmpv4.ml
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
open Lwt.Infix
open Result

let src = Logs.Src.create "icmpv4" ~doc:"Mirage ICMPv4"
module Log = (val Logs.src_log src : Logs.LOG)
Expand Down Expand Up @@ -40,11 +39,11 @@ module Make(IP : Mirage_protocols_lwt.IPV4) = struct
let should_reply t dst = List.mem dst @@ IP.get_ip t.ip in
MProf.Trace.label "icmp_input";
match Unmarshal.of_cstruct buf with
| Result.Error s ->
| Error s ->
Log.info (fun f ->
f "ICMP: error parsing message from %a: %s" Ipaddr.V4.pp_hum src s);
Lwt.return_unit
| Result.Ok (message, payload) ->
| Ok (message, payload) ->
let open Icmpv4_wire in
match message.ty, message.subheader with
| Echo_reply, _ ->
Expand Down
16 changes: 8 additions & 8 deletions src/icmp/icmpv4_packet.ml
Original file line number Diff line number Diff line change
Expand Up @@ -61,19 +61,19 @@ module Unmarshal = struct
let open Rresult in
let check_len () =
if Cstruct.len buf < sizeof_icmpv4 then
Result.Error "packet too short for ICMPv4 header"
else Result.Ok () in
Error "packet too short for ICMPv4 header"
else Ok () in
let check_ty () =
match int_to_ty (get_icmpv4_ty buf) with
| None -> Result.Error "unrecognized ICMPv4 type"
| Some ty -> Result.Ok ty
| None -> Error "unrecognized ICMPv4 type"
| Some ty -> Ok ty
in
(* TODO: check checksum as well, and return an error if it's invalid *)
check_len () >>= check_ty >>= fun ty ->
let code = get_icmpv4_code buf in
let subheader = subheader_of_cstruct ty (Cstruct.shift buf 4) in
let payload = Cstruct.shift buf sizeof_icmpv4 in
Result.Ok ({ code; ty; subheader}, payload)
Ok ({ code; ty; subheader}, payload)
end

module Marshal = struct
Expand All @@ -99,14 +99,14 @@ module Marshal = struct

let check_len buf =
if Cstruct.len buf < Icmpv4_wire.sizeof_icmpv4 then
Result.Error "Not enough space for ICMP header"
else Result.Ok ()
Error "Not enough space for ICMP header"
else Ok ()

let into_cstruct t buf ~payload =
let open Rresult in
check_len buf >>= fun () ->
unsafe_fill t buf ~payload;
Result.Ok ()
Ok ()

let make_cstruct t ~payload =
let buf = Cstruct.create Icmpv4_wire.sizeof_icmpv4 in
Expand Down
4 changes: 2 additions & 2 deletions src/icmp/icmpv4_packet.mli
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ module Unmarshal : sig

val subheader_of_cstruct : Icmpv4_wire.ty -> Cstruct.t -> subheader

val of_cstruct : Cstruct.t -> (t * Cstruct.t, error) Result.result
val of_cstruct : Cstruct.t -> (t * Cstruct.t, error) result
end
module Marshal : sig
type error = string
Expand All @@ -28,7 +28,7 @@ module Marshal : sig
writes it into [buf] at offset 0. [payload] is used to calculate the ICMPv4 header
checksum, but is not included in the generated buffer. [into_cstruct] may
fail if the buffer is of insufficient size. *)
val into_cstruct : t -> Cstruct.t -> payload:Cstruct.t -> (unit, error) Result.result
val into_cstruct : t -> Cstruct.t -> payload:Cstruct.t -> (unit, error) result

(** [make_cstruct t ~payload] allocates, fills, and returns a Cstruct.t with the header
information from [t]. The payload is used to calculate the ICMPv4 header
Expand Down
37 changes: 18 additions & 19 deletions src/ipv4/ipv4_packet.ml
Original file line number Diff line number Diff line change
Expand Up @@ -62,10 +62,9 @@ module Marshal = struct

let into_cstruct ~payload_len t buf =
if Cstruct.len buf < (sizeof_ipv4 + Cstruct.len t.options) then
Result.Error "Not enough space for IPv4 header"
else begin
Result.Ok (unsafe_fill ~payload_len t buf)
end
Error "Not enough space for IPv4 header"
else
Ok (unsafe_fill ~payload_len t buf)

let make_cstruct ~payload_len t =
let nearest_4 n = match n mod 4 with
Expand Down Expand Up @@ -93,29 +92,29 @@ module Unmarshal = struct
let check_version buf =
let version n = (n land 0xf0) in
match get_ipv4_hlen_version buf |> version with
| 0x40 -> Result.Ok buf
| n -> Result.Error (Printf.sprintf "IPv4 presented with a packet that claims a different IP version: %x" n)
| 0x40 -> Ok buf
| n -> Error (Printf.sprintf "IPv4 presented with a packet that claims a different IP version: %x" n)
in
let size_check buf =
if (Cstruct.len buf < sizeof_ipv4) then Result.Error "buffer sent to IPv4 parser had size < 20"
else Result.Ok buf
if (Cstruct.len buf < sizeof_ipv4) then Error "buffer sent to IPv4 parser had size < 20"
else Ok buf
in
let get_header_length buf =
let length_of_hlen_version n = (n land 0x0f) * 4 in
let hlen = get_ipv4_hlen_version buf |> length_of_hlen_version in
if (get_ipv4_len buf) < sizeof_ipv4 then
Result.Error (Printf.sprintf
"total length %d is smaller than minimum header length"
(get_ipv4_len buf))
Error (Printf.sprintf
"total length %d is smaller than minimum header length"
(get_ipv4_len buf))
else if get_ipv4_len buf < hlen then
Result.Error (Printf.sprintf
"total length %d is smaller than stated header length %d"
(get_ipv4_len buf) hlen)
else if hlen < sizeof_ipv4 then Result.Error
(Printf.sprintf "IPv4 header claimed to have size < 20: %d" hlen)
else if Cstruct.len buf < hlen then Result.Error
(Printf.sprintf "IPv4 packet w/length %d claimed to have header of size %d" (Cstruct.len buf) hlen)
else Result.Ok hlen
Error (Printf.sprintf
"total length %d is smaller than stated header length %d"
(get_ipv4_len buf) hlen)
else if hlen < sizeof_ipv4 then
Error (Printf.sprintf "IPv4 header claimed to have size < 20: %d" hlen)
else if Cstruct.len buf < hlen then
Error (Printf.sprintf "IPv4 packet w/length %d claimed to have header of size %d" (Cstruct.len buf) hlen)
else Ok hlen
in
let parse buf options_end =
let payload_len = (get_ipv4_len buf) - options_end in
Expand Down
4 changes: 2 additions & 2 deletions src/ipv4/ipv4_packet.mli
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ module Unmarshal : sig

val int_to_protocol : int -> protocol option

val of_cstruct : Cstruct.t -> (t * Cstruct.t, error) Result.result
val of_cstruct : Cstruct.t -> (t * Cstruct.t, error) result

val verify_transport_checksum : proto:([`TCP | `UDP]) -> ipv4_header:t ->
transport_packet:Cstruct.t -> bool
Expand All @@ -37,7 +37,7 @@ module Marshal : sig
(** [into_cstruct ~payload_len t buf] attempts to write a header representing [t] (including
[t.options]) into [buf] at offset 0.
If there is insufficient space to represent [t], an error will be returned. *)
val into_cstruct : payload_len:int -> t -> Cstruct.t -> (unit, error) Result.result
val into_cstruct : payload_len:int -> t -> Cstruct.t -> (unit, error) result

(** [make_cstruct ~payload_len t] allocates, fills, and returns a buffer
repesenting the IPV4 header corresponding to [t].
Expand Down
2 changes: 0 additions & 2 deletions src/ipv4/routing.ml
Original file line number Diff line number Diff line change
@@ -1,5 +1,3 @@
open Result

(* RFC 1112: 01-00-5E-00-00-00 ORed with lower 23 bits of the ip address *)
let mac_of_multicast ip =
let ipb = Ipaddr.V4.to_bytes ip in
Expand Down
3 changes: 0 additions & 3 deletions src/ipv4/static_ipv4.ml
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,6 @@
*)

open Lwt.Infix
open Result

let src = Logs.Src.create "ipv4" ~doc:"Mirage IPv4"
module Log = (val Logs.src_log src : Logs.LOG)
Expand All @@ -29,11 +28,9 @@ module Make(Ethif: Mirage_protocols_lwt.ETHIF) (Arpv4 : Mirage_protocols_lwt.ARP
| #Mirage_protocols.Ip.error as e -> Mirage_protocols.Ip.pp_error ppf e
| `Ethif e -> Ethif.pp_error ppf e

type ethif = Ethif.t
type 'a io = 'a Lwt.t
type buffer = Cstruct.t
type ipaddr = Ipaddr.V4.t
type prefix = Ipaddr.V4.Prefix.t
type callback = src:ipaddr -> dst:ipaddr -> buffer -> unit Lwt.t

type t = {
Expand Down
Loading