Merge pull request #63 from mirage/csum

Re-implement UDP checksum on input.

lib/dhcp_wire.ml

@@ -1043,12 +1043,9 @@ let pkt_of_buf buf len =
     let min_len = sizeof_dhcp + Ethif_wire.sizeof_ethernet +
                   Ipv4_wire.sizeof_ipv4 + Udp_wire.sizeof_udp
     in
-    let length_check =
-      if len < min_len then
-        Error (sprintf "packet is too small: %d < %d" len min_len)
-      else Ok ()
-    in
-    length_check >>= fun () ->
+    Util.guard (len >= min_len)
+      (sprintf "packet is too small: %d < %d" len min_len)
+    >>= fun () ->
     (* Handle ethernet *)
     Ethif_packet.Unmarshal.of_cstruct buf >>= fun (eth_header, eth_payload) ->
     match eth_header.Ethif_packet.ethertype with
@@ -1059,6 +1056,11 @@ let pkt_of_buf buf len =
       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 ->
+        Util.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 op = int_to_op_exn (get_dhcp_op udp_payload) in

lib/util.ml

@@ -70,6 +70,8 @@ let cons_if p v tl = if p then v :: tl else tl
 let cons_if_some v tl = match v with Some v -> v :: tl | None -> tl
 let cons_if_some_f v fnr tl = match v with Some x -> fnr x :: tl | None -> tl
 
+let guard p e = if p then Result.Ok () else Result.Error e
+
 let addr_in_range addr range =
   let low_ip, high_ip = range in
   let low_32 = Ipaddr.V4.to_int32 low_ip in

test/test.ml

@@ -43,6 +43,8 @@ let mask_t = Ipaddr.V4.of_string_exn "255.255.255.0"
 let range_t = (Ipaddr.V4.of_string_exn "192.168.1.50",
                Ipaddr.V4.of_string_exn "192.168.1.100")
 
+let assert_error x = assert (Rresult.R.is_error x)
+
 open Dhcp_wire
 open Dhcp_server
 
@@ -54,6 +56,42 @@ let t_option_codes () =
     ignore (int_to_option_code_exn i)
   done
 
+let t_csum () =
+  let pkt = {
+    htype = Ethernet_10mb;
+    hlen = 6;
+    hops = 0;
+    xid = 0xabad1deal;
+    chaddr = mac_t;
+    srcport = client_port;
+    dstport = server_port;
+    srcmac = mac_t;
+    dstmac = Macaddr.broadcast;
+    srcip = Ipaddr.V4.any;
+    dstip = Ipaddr.V4.broadcast;
+    op = BOOTREQUEST;
+    secs = 0;
+    flags = Broadcast;
+    siaddr = Ipaddr.V4.any;
+    ciaddr = Ipaddr.V4.any;
+    yiaddr = Ipaddr.V4.any;
+    giaddr = Ipaddr.V4.any;
+    sname = "";
+    file = "";
+    options = [ Message_type DHCPREQUEST ]
+  } in
+  (* Corrupt every byte of the packet and assert that csum fails *)
+  let buf = buf_of_pkt pkt in
+  (* Skip ethernet + upper ip header *)
+  for off = (14 + 12) to pred (Cstruct.len buf) do
+    let evilbyte = Cstruct.get_uint8 buf off in
+    (* Corrupt payload *)
+    Cstruct.set_uint8 buf off (succ evilbyte);
+    assert_error (pkt_of_buf buf (Cstruct.len buf));
+    (* Put back *)
+    Cstruct.set_uint8 buf off evilbyte;
+  done
+
 let t_long_lists () =
   let pkt = {
     htype = Ethernet_10mb;
@@ -938,6 +976,7 @@ let run_test test =
 
 let all_tests = [
   (t_option_codes, "option codes");
+  (t_csum, "checksum");
   (t_long_lists, "long options lists");
   (Pcap.t_pcap, "pcap");
   (t_simple_config, "simple config");