Skip to content

Commit

Permalink
remove ppx from mirage-tcpip
Browse files Browse the repository at this point in the history
  • Loading branch information
hannesm committed Mar 17, 2023
1 parent ac655de commit b6ccf51
Show file tree
Hide file tree
Showing 32 changed files with 731 additions and 460 deletions.
2 changes: 0 additions & 2 deletions src/icmp/dune
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,4 @@
(instrumentation
(backend bisect_ppx))
(libraries logs tcpip ipaddr tcpip.checksum)
(preprocess
(pps ppx_cstruct))
(wrapped false))
5 changes: 2 additions & 3 deletions src/icmp/icmpv4.ml
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,6 @@ module Make (IP : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) = struct
f "ICMP: error parsing message from %a: %s" Ipaddr.V4.pp src s);
Lwt.return_unit
| Ok (message, payload) ->
let open Icmpv4_wire in
match message.ty, message.subheader with
| Echo_reply, _ ->
Log.info (fun f ->
Expand All @@ -65,7 +64,7 @@ module Make (IP : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) = struct
if t.echo_reply then begin
let icmp = {
code = 0x00;
ty = Icmpv4_wire.Echo_reply;
ty = Echo_reply;
subheader = Id_and_seq (id, seq);
} in
writev t ~dst:src [ Marshal.make_cstruct icmp ~payload; payload ]
Expand All @@ -77,7 +76,7 @@ module Make (IP : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) = struct
| ty, _ ->
Log.info (fun f ->
f "ICMP unknown ty %s from %a"
(ty_to_string ty) Ipaddr.V4.pp src);
(Icmpv4_wire.ty_to_string ty) Ipaddr.V4.pp src);
Lwt.return_unit

end
20 changes: 10 additions & 10 deletions src/icmp/icmpv4_packet.ml
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ let pp fmt t =
| Address addr -> say fmt "subheader: ip %a" Ipaddr.V4.pp addr
| Unused -> ()
in
say fmt "ICMP type %s, code %d, subheader [%a]" (Icmpv4_wire.ty_to_string t.ty)
say fmt "ICMP type %s, code %d, subheader [%a]" (ty_to_string t.ty)
t.code pp_subheader t.subheader

let subheader_eq = function
Expand Down Expand Up @@ -64,14 +64,14 @@ module Unmarshal = struct
Error "packet too short for ICMPv4 header"
else Ok () in
let check_ty () =
match int_to_ty (get_icmpv4_ty buf) with
match int_to_ty (get_ty buf) with
| None -> Error "unrecognized ICMPv4 type"
| Some ty -> Ok ty
in
(* TODO: check checksum as well, and return an error if it's invalid *)
let* () = check_len () in
let* ty = check_ty () in
let code = get_icmpv4_code buf in
let code = get_code buf in
let subheader = subheader_of_cstruct ty (Cstruct.shift buf 4) in
let payload = Cstruct.shift buf sizeof_icmpv4 in
Ok ({ code; ty; subheader}, payload)
Expand All @@ -91,15 +91,15 @@ module Marshal = struct
| Unused -> set_uint32 buf 0 Int32.zero

let unsafe_fill {ty; code; subheader} buf ~payload =
set_icmpv4_ty buf (ty_to_int ty);
set_icmpv4_code buf code;
set_icmpv4_csum buf 0x0000;
set_ty buf (ty_to_int ty);
set_code buf code;
set_checksum buf 0x0000;
subheader_into_cstruct ~buf:(Cstruct.shift buf 4) subheader;
let packets = [(Cstruct.sub buf 0 Icmpv4_wire.sizeof_icmpv4); payload] in
set_icmpv4_csum buf (Tcpip_checksum.ones_complement_list packets)
let packets = [(Cstruct.sub buf 0 sizeof_icmpv4); payload] in
set_checksum buf (Tcpip_checksum.ones_complement_list packets)

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

Expand All @@ -109,7 +109,7 @@ module Marshal = struct
Ok ()

let make_cstruct t ~payload =
let buf = Cstruct.create Icmpv4_wire.sizeof_icmpv4 in
let buf = Cstruct.create sizeof_icmpv4 in
unsafe_fill t buf ~payload;
buf
end
101 changes: 79 additions & 22 deletions src/icmp/icmpv4_wire.ml
Original file line number Diff line number Diff line change
@@ -1,32 +1,58 @@
[%%cstruct
type icmpv4 = {
ty: uint8_t;
code: uint8_t;
csum: uint16_t;
id: uint16_t;
seq: uint16_t;
} [@@big_endian]
]

[%%cenum
type ty =
| Echo_reply [@id 0]
| Destination_unreachable [@id 3]
| Echo_reply
| Destination_unreachable
| Source_quench
| Redirect
| Echo_request [@id 8]
| Time_exceeded [@id 11]
| Echo_request
| Time_exceeded
| Parameter_problem
| Timestamp_request
| Timestamp_reply
| Information_request
| Information_reply
[@@uint8_t]
]

[%%cenum
let ty_to_string = function
| Echo_reply -> "echo reply"
| Destination_unreachable -> "destination unreachable"
| Source_quench -> "source quench"
| Redirect -> "redirect"
| Echo_request -> "echo request"
| Time_exceeded -> "time exceeded"
| Parameter_problem -> "parameter problem"
| Timestamp_request -> "timestamp request"
| Timestamp_reply -> "timestamp reply"
| Information_request -> "information request"
| Information_reply -> "information reply"

let int_to_ty = function
| 0 -> Some Echo_reply
| 3 -> Some Destination_unreachable
| 4 -> Some Source_quench
| 5 -> Some Redirect
| 8 -> Some Echo_request
| 11 -> Some Time_exceeded
| 12 -> Some Parameter_problem
| 13 -> Some Timestamp_request
| 14 -> Some Timestamp_reply
| 15 -> Some Information_request
| 16 -> Some Information_reply
| _ -> None

let ty_to_int = function
| Echo_reply -> 0
| Destination_unreachable -> 3
| Source_quench -> 4
| Redirect -> 5
| Echo_request -> 8
| Time_exceeded -> 11
| Parameter_problem -> 12
| Timestamp_request -> 13
| Timestamp_reply -> 14
| Information_request -> 15
| Information_reply -> 16

type unreachable_reason =
| Network_unreachable [@id 0]
| Network_unreachable
| Host_unreachable
| Protocol_unreachable
| Port_unreachable
Expand All @@ -41,6 +67,37 @@ type unreachable_reason =
| TOS_host_unreachable
| Communication_prohibited
| Host_precedence_violation
| Precedence_insufficient [@id 15]
[@@uint8_t]
]
| Precedence_insufficient

let unreachable_reason_to_int = function
| Network_unreachable -> 0
| Host_unreachable -> 1
| Protocol_unreachable -> 2
| Port_unreachable -> 3
| Would_fragment -> 4
| Source_route_failed -> 5
| Destination_network_unknown -> 6
| Destination_host_unknown -> 7
| Source_host_isolated -> 8
| Destination_net_prohibited -> 9
| Destination_host_prohibited -> 10
| TOS_network_unreachable -> 11
| TOS_host_unreachable -> 12
| Communication_prohibited -> 13
| Host_precedence_violation -> 14
| Precedence_insufficient -> 15

let sizeof_icmpv4 = 8

let ty_off = 0
let code_off = 1
let csum_off = 2

let get_ty buf = Cstruct.get_uint8 buf ty_off
let set_ty buf value = Cstruct.set_uint8 buf ty_off value

let get_code buf = Cstruct.get_uint8 buf code_off
let set_code buf value = Cstruct.set_uint8 buf code_off value

let get_checksum buf = Cstruct.BE.get_uint16 buf csum_off
let set_checksum buf value = Cstruct.BE.set_uint16 buf csum_off value
47 changes: 47 additions & 0 deletions src/icmp/icmpv4_wire.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,47 @@
type ty =
| Echo_reply
| Destination_unreachable
| Source_quench
| Redirect
| Echo_request
| Time_exceeded
| Parameter_problem
| Timestamp_request
| Timestamp_reply
| Information_request
| Information_reply

val ty_to_string : ty -> string
val int_to_ty : int -> ty option
val ty_to_int : ty -> int

type unreachable_reason =
| Network_unreachable
| Host_unreachable
| Protocol_unreachable
| Port_unreachable
| Would_fragment
| Source_route_failed
| Destination_network_unknown
| Destination_host_unknown
| Source_host_isolated
| Destination_net_prohibited
| Destination_host_prohibited
| TOS_network_unreachable
| TOS_host_unreachable
| Communication_prohibited
| Host_precedence_violation
| Precedence_insufficient

val unreachable_reason_to_int : unreachable_reason -> int

val sizeof_icmpv4 : int

val get_ty : Cstruct.t -> int
val set_ty : Cstruct.t -> int -> unit

val get_code : Cstruct.t -> int
val set_code : Cstruct.t -> int -> unit

val get_checksum : Cstruct.t -> int
val set_checksum : Cstruct.t -> int -> unit
2 changes: 0 additions & 2 deletions src/ipv4/dune
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,4 @@
(backend bisect_ppx))
(libraries logs ipaddr cstruct tcpip tcpip.udp tcpip.checksum mirage-random
mirage-clock randomconv lru arp.mirage ethernet)
(preprocess
(pps ppx_cstruct))
(wrapped false))
2 changes: 1 addition & 1 deletion src/ipv4/fragments.ml
Original file line number Diff line number Diff line change
Expand Up @@ -196,7 +196,7 @@ let fragment ~mtu hdr payload =
if more then Cstruct.split payload data_size else payload, Cstruct.empty
in
let payload_len = Cstruct.length this_payload in
Ipv4_wire.set_ipv4_csum hdr_buf 0;
Ipv4_wire.set_checksum hdr_buf 0;
(match Ipv4_packet.Marshal.into_cstruct ~payload_len hdr' hdr_buf with
(* hdr_buf is allocated with hdr_size (computed below) bytes, thus
into_cstruct will never return an error! *)
Expand Down
6 changes: 0 additions & 6 deletions src/ipv4/ipv4_common.ml

This file was deleted.

66 changes: 33 additions & 33 deletions src/ipv4/ipv4_packet.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,17 +54,17 @@ module Marshal = struct
| k -> (4 - k) + n
in
let options_len = nearest_4 @@ Cstruct.length t.options in
set_ipv4_hlen_version buf ((4 lsl 4) + 5 + (options_len / 4));
set_ipv4_id buf t.id;
set_ipv4_off buf t.off;
set_ipv4_ttl buf t.ttl;
set_ipv4_proto buf t.proto;
set_ipv4_src buf (Ipaddr.V4.to_int32 t.src);
set_ipv4_dst buf (Ipaddr.V4.to_int32 t.dst);
set_hlen_version buf ((4 lsl 4) + 5 + (options_len / 4));
set_id buf t.id;
set_off buf t.off;
set_ttl buf t.ttl;
set_proto buf t.proto;
set_src buf t.src;
set_dst buf t.dst;
Cstruct.blit t.options 0 buf sizeof_ipv4 (Cstruct.length t.options);
set_ipv4_len buf (sizeof_ipv4 + options_len + payload_len);
set_len buf (sizeof_ipv4 + options_len + payload_len);
let checksum = Tcpip_checksum.ones_complement @@ Cstruct.sub buf 0 (20 + options_len) in
set_ipv4_csum buf checksum
set_checksum buf checksum


let into_cstruct ~payload_len t buf =
Expand Down Expand Up @@ -99,7 +99,7 @@ module Unmarshal = struct
let open Ipv4_wire in
let check_version buf =
let version n = (n land 0xf0) in
match get_ipv4_hlen_version buf |> version with
match get_hlen_version buf |> version with
| 0x40 -> Ok ()
| n -> Error (Printf.sprintf "IPv4 presented with a packet that claims a different IP version: %x" n)
in
Expand All @@ -109,28 +109,29 @@ module Unmarshal = struct
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
Error (Printf.sprintf
"total length %d is smaller than minimum header length"
(get_ipv4_len buf))
else if get_ipv4_len buf < hlen then
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.length buf < hlen then
Error (Printf.sprintf "IPv4 packet w/length %d claimed to have header of size %d" (Cstruct.length buf) hlen)
else Ok hlen
let hlen = get_hlen_version buf |> length_of_hlen_version in
let len = get_len buf in
if len < sizeof_ipv4 then
Error (Printf.sprintf
"total length %d is smaller than minimum header length" len)
else if len < hlen then
Error (Printf.sprintf
"total length %d is smaller than stated header length %d"
len hlen)
else if hlen < sizeof_ipv4 then
Error (Printf.sprintf "IPv4 header claimed to have size < 20: %d" hlen)
else if Cstruct.length buf < hlen then
Error (Printf.sprintf "IPv4 packet w/length %d claimed to have header of size %d" (Cstruct.length buf) hlen)
else Ok hlen
in
let parse buf options_end =
let src = Ipaddr.V4.of_int32 (get_ipv4_src buf) in
let dst = Ipaddr.V4.of_int32 (get_ipv4_dst buf) in
let id = get_ipv4_id buf in
let off = get_ipv4_off buf in
let ttl = get_ipv4_ttl buf in
let proto = get_ipv4_proto buf in
let src = get_src buf
and dst = get_dst buf
and id = get_id buf
and off = get_off buf
and ttl = get_ttl buf
and proto = get_proto buf
in
let options =
if options_end > sizeof_ipv4 then (Cstruct.sub buf sizeof_ipv4 (options_end - sizeof_ipv4))
else (Cstruct.create 0)
Expand All @@ -143,9 +144,8 @@ module Unmarshal = struct
parse buf hl

let of_cstruct buf =
let open Ipv4_wire in
let parse buf options_end =
let payload_len = (get_ipv4_len buf) - options_end in
let payload_len = Ipv4_wire.get_len buf - options_end in
let payload_available = Cstruct.length buf - options_end in
if payload_available < payload_len then (
Error (Printf.sprintf "Payload buffer (%d bytes) too small to contain payload (of size %d from header)" payload_available payload_len)
Expand All @@ -172,7 +172,7 @@ module Unmarshal = struct
| `TCP -> (* checksum isn't optional in tcp, but pkt must be long enough *)
check ipv4_header ~proto (Cstruct.length transport_packet)
| `UDP ->
match Udp_wire.get_udp_checksum transport_packet with
match Udp_wire.get_checksum transport_packet with
| n when (=) 0 @@ compare n 0x0000 -> true (* no checksum supplied, so the check trivially passes *)
| _ ->
check ipv4_header ~proto (Cstruct.length transport_packet)
Expand Down
Loading

0 comments on commit b6ccf51

Please sign in to comment.