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

remove rresult dependency, use Result instead #114

Merged
merged 1 commit into from
Oct 27, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
1 change: 0 additions & 1 deletion charrua.opam
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,6 @@ depends: [
"macaddr-sexp"
"ethernet" {>= "2.2.0"}
"tcpip" {>= "5.0.0"}
"rresult"
]
synopsis: "DHCP wire frame encoder and decoder"
description: """
Expand Down
45 changes: 26 additions & 19 deletions lib/dhcp_wire.ml
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,8 @@
open Sexplib.Conv
open Sexplib.Std

let ( let* ) = Result.bind

let guard p e = if p then Result.Ok () else Result.Error e

let some_or_invalid f v = match f v with
Expand Down Expand Up @@ -1078,31 +1080,34 @@ let buf_of_options sbuf options =
set_uint8 ebuf 0 (option_code_to_int END); shift ebuf 1

let pkt_of_buf buf len =
let open Rresult in
let open Printf in
let wrap () =
let min_len = sizeof_dhcp + Ethernet_wire.sizeof_ethernet +
Ipv4_wire.sizeof_ipv4 + Udp_wire.sizeof_udp
in
guard (len >= min_len) (sprintf "packet is too small: %d < %d" len min_len)
>>= fun () ->
let* () =
guard (len >= min_len) (sprintf "packet is too small: %d < %d" len min_len)
in
(* Handle ethernet *)
Ethernet_packet.Unmarshal.of_cstruct buf >>= fun (eth_header, eth_payload) ->
let* eth_header, eth_payload = Ethernet_packet.Unmarshal.of_cstruct buf in
match eth_header.Ethernet_packet.ethertype with
| `ARP | `IPv6 -> Error "packet is not ipv4"
| `IPv4 ->
Ipv4_packet.Unmarshal.of_cstruct eth_payload
>>= fun (ipv4_header, ipv4_payload) ->
let* ipv4_header, ipv4_payload =
Ipv4_packet.Unmarshal.of_cstruct eth_payload
in
match Ipv4_packet.Unmarshal.int_to_protocol ipv4_header.Ipv4_packet.proto with
| Some `ICMP | Some `TCP | None -> Error "packet is not udp"
| Some `UDP ->
guard
(Ipv4_packet.Unmarshal.verify_transport_checksum
~proto:`UDP ~ipv4_header ~transport_packet:ipv4_payload)
"bad udp checksum"
>>= fun () ->
Udp_packet.Unmarshal.of_cstruct ipv4_payload >>=
fun (udp_header, udp_payload) ->
let* () =
guard
(Ipv4_packet.Unmarshal.verify_transport_checksum
~proto:`UDP ~ipv4_header ~transport_packet:ipv4_payload)
"bad udp checksum"
in
let* udp_header, udp_payload =
Udp_packet.Unmarshal.of_cstruct ipv4_payload
in
let op = int_to_op_exn (get_dhcp_op udp_payload) in
let htype = if (get_dhcp_htype udp_payload) = 1 then
Ethernet_10mb
Expand All @@ -1126,7 +1131,7 @@ let pkt_of_buf buf len =
else
Error "Not a mac address."
in
check_chaddr >>= fun chaddr ->
let* chaddr = check_chaddr in
let sname = cstruct_copy_normalized copy_dhcp_sname udp_payload in
let file = cstruct_copy_normalized copy_dhcp_file udp_payload in
let options = options_of_buf udp_payload len in
Expand Down Expand Up @@ -1219,20 +1224,22 @@ let buf_of_pkt pkg =
Cstruct.sub dhcp 0 l

let is_dhcp buf _len =
let open Rresult in
let aux buf =
Ethernet_packet.Unmarshal.of_cstruct buf >>= fun (eth_header, eth_payload) ->
let* eth_header, eth_payload = Ethernet_packet.Unmarshal.of_cstruct buf in
match eth_header.Ethernet_packet.ethertype with
| `ARP | `IPv6 -> Ok false
| `IPv4 ->
Ipv4_packet.Unmarshal.of_cstruct eth_payload >>= fun (ipv4_header, ipv4_payload) ->
let* ipv4_header, ipv4_payload =
Ipv4_packet.Unmarshal.of_cstruct eth_payload
in
(* TODO: tcpip doesn't currently do checksum checking, so we lose some
functionality by making this change *)
match Ipv4_packet.Unmarshal.int_to_protocol ipv4_header.Ipv4_packet.proto with
| Some `ICMP | Some `TCP | None -> Ok false
| Some `UDP ->
Udp_packet.Unmarshal.of_cstruct ipv4_payload >>=
fun (udp_header, _udp_payload) ->
let* udp_header, _udp_payload =
Udp_packet.Unmarshal.of_cstruct ipv4_payload
in
Ok ((udp_header.Udp_packet.dst_port = server_port ||
udp_header.Udp_packet.dst_port = client_port)
&&
Expand Down
4 changes: 2 additions & 2 deletions lib/dune
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
(library
(name dhcp_wire)
(public_name charrua)
(preprocess (pps ppx_sexp_conv ppx_cstruct -- -no-check))
(preprocess (pps ppx_sexp_conv ppx_cstruct))
(libraries cstruct ethernet sexplib tcpip.ipv4 tcpip.udp ipaddr ipaddr-sexp
macaddr macaddr-sexp rresult))
macaddr macaddr-sexp))
10 changes: 5 additions & 5 deletions test/client/test_client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ let client_to_selecting () =
let buf = Dhcp_wire.buf_of_pkt pkt in
let answer = Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
Alcotest.(check (result pass reject)) "input succeeds" answer answer;
(s, Rresult.R.get_ok answer)
(s, Result.get_ok answer)

let assert_reply p =
let open Dhcp_server.Input in
Expand Down Expand Up @@ -99,7 +99,7 @@ let client_asks_dhcprequest () =
| `Response (_s, pkt) ->
let buf = Dhcp_wire.buf_of_pkt pkt in
parseable buf;
let dhcprequest = Rresult.R.get_ok @@
let dhcprequest = Result.get_ok @@
Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
Alcotest.(check (option msgtype)) "responded to DHCPOFFER with DHCPREQUEST"
(Some DHCPREQUEST) (find_message_type dhcprequest.options)
Expand All @@ -116,7 +116,7 @@ let server_gives_dhcpack () =
| `New_lease _-> Alcotest.fail "thought a DHCPOFFER was a lease"
| `Response (_s, pkt) ->
let buf = Dhcp_wire.buf_of_pkt pkt in
let dhcprequest = Rresult.R.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
let dhcprequest = Result.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
let (dhcpack, _db) = assert_reply @@ Dhcp_server.Input.input_pkt config db dhcprequest 0l in
Alcotest.(check (option msgtype)) "got a DHCPACK in response to DHCPREQUEST"
(Some DHCPACK) (find_message_type dhcpack.options)
Expand All @@ -130,7 +130,7 @@ let client_returns_lease () =
| `Noop | `New_lease _ -> Alcotest.fail "incorrect response to DHCPOFFER"
| `Response (s, pkt) ->
let buf = Dhcp_wire.buf_of_pkt pkt in
let dhcprequest = Rresult.R.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
let dhcprequest = Result.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
let (dhcpack, _db) = assert_reply @@ Dhcp_server.Input.input_pkt config db dhcprequest 0l in
Alcotest.(check (option msgtype)) "got a DHCPACK in response to DHCPREQUEST"
(Some DHCPACK) (find_message_type dhcpack.options);
Expand Down Expand Up @@ -166,7 +166,7 @@ let random_bound n =
| `Noop | `New_lease _ -> Alcotest.fail "couldn't enter REQUESTING properly"
| `Response (s, dhcprequest) ->
let buf = Dhcp_wire.buf_of_pkt dhcprequest in
let dhcprequest = Rresult.R.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
let dhcprequest = Result.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
let (dhcpack, _db) = assert_reply @@ Dhcp_server.Input.input_pkt config db dhcprequest 0l in
match Dhcp_client.input s (Dhcp_wire.buf_of_pkt dhcpack) with
| `Noop | `Response _ -> Alcotest.fail "client did not recognize DHCPACK as
Expand Down
2 changes: 1 addition & 1 deletion test/test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ let addr_in_range addr range =
let addr_32 = Ipaddr.V4.to_int32 addr in
addr_32 >= low_32 && addr_32 <= high_32

let assert_error x = assert (Rresult.R.is_error x)
let assert_error x = assert (Result.is_error x)

open Dhcp_wire
open Dhcp_server
Expand Down