diff --git a/charrua.opam b/charrua.opam index 3c8f119..6520636 100644 --- a/charrua.opam +++ b/charrua.opam @@ -25,7 +25,6 @@ depends: [ "macaddr-sexp" "ethernet" {>= "2.2.0"} "tcpip" {>= "5.0.0"} - "rresult" ] synopsis: "DHCP wire frame encoder and decoder" description: """ diff --git a/lib/dhcp_wire.ml b/lib/dhcp_wire.ml index abdc340..58fc545 100644 --- a/lib/dhcp_wire.ml +++ b/lib/dhcp_wire.ml @@ -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 @@ -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 @@ -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 @@ -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) && diff --git a/lib/dune b/lib/dune index 9e096ab..6775c91 100644 --- a/lib/dune +++ b/lib/dune @@ -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)) diff --git a/test/client/test_client.ml b/test/client/test_client.ml index 7874400..db67d6a 100644 --- a/test/client/test_client.ml +++ b/test/client/test_client.ml @@ -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 @@ -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) @@ -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) @@ -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); @@ -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 diff --git a/test/test.ml b/test/test.ml index 40efe6a..fd53715 100644 --- a/test/test.ml +++ b/test/test.ml @@ -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