Merge pull request #277 from yomimono/transport_checksums

add verify_transport_checksum to ipv4_packet.unmarshal

_oasis

@@ -58,7 +58,9 @@ Library ipv4
   Modules:            Static_ipv4, Ipv4_wire, Ipv4_packet
   InternalModules:    Ipv4_common, Routing
   BuildDepends:       logs,io-page,mirage-types,ipaddr,cstruct.ppx,lwt,result,rresult,
-                      tcpip,tcpip.ethif,mirage-runtime
+                      mirage-runtime,
+                      tcpip,tcpip.ethif,
+                      tcpip.udp, tcpip.tcp
 
 Library ipv6
   CompiledObject:     best

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: ea93b1247c81a923c5d4a356c985a73e)
+# DO NOT EDIT (digest: a59f871cc3d4f9d3c94a803e4045a12e)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -56,22 +56,6 @@ true: annot, bin_annot
 <lib/arpv4/*.ml{,i,y}>: pkg_result
 <lib/arpv4/*.ml{,i,y}>: pkg_rresult
 <lib/arpv4/*.ml{,i,y}>: use_ethif
-# Library ipv4
-"lib/ipv4/ipv4.cmxs": use_ipv4
-<lib/ipv4/*.ml{,i,y}>: pkg_cstruct
-<lib/ipv4/*.ml{,i,y}>: pkg_cstruct.ppx
-<lib/ipv4/*.ml{,i,y}>: pkg_io-page
-<lib/ipv4/*.ml{,i,y}>: pkg_ipaddr
-<lib/ipv4/*.ml{,i,y}>: pkg_logs
-<lib/ipv4/*.ml{,i,y}>: pkg_lwt
-<lib/ipv4/*.ml{,i,y}>: pkg_mirage-profile
-<lib/ipv4/*.ml{,i,y}>: pkg_mirage-runtime
-<lib/ipv4/*.ml{,i,y}>: pkg_mirage-types
-<lib/ipv4/*.ml{,i,y}>: pkg_mirage-types-lwt
-<lib/ipv4/*.ml{,i,y}>: pkg_result
-<lib/ipv4/*.ml{,i,y}>: pkg_rresult
-<lib/ipv4/*.ml{,i,y}>: use_ethif
-<lib/ipv4/*.ml{,i,y}>: use_tcpip
 # Library ipv6
 "lib/ipv6/ipv6.cmxs": use_ipv6
 <lib/ipv6/*.ml{,i,y}>: pkg_cstruct
@@ -152,6 +136,27 @@ true: annot, bin_annot
 <lib/tcp/*.ml{,i,y}>: pkg_result
 <lib/tcp/*.ml{,i,y}>: pkg_rresult
 <lib/tcp/*.ml{,i,y}>: use_tcpip
+# Library ipv4
+"lib/ipv4/ipv4.cmxs": use_ipv4
+<lib/ipv4/*.ml{,i,y}>: pkg_cstruct
+<lib/ipv4/*.ml{,i,y}>: pkg_cstruct.ppx
+<lib/ipv4/*.ml{,i,y}>: pkg_duration
+<lib/ipv4/*.ml{,i,y}>: pkg_fmt
+<lib/ipv4/*.ml{,i,y}>: pkg_io-page
+<lib/ipv4/*.ml{,i,y}>: pkg_ipaddr
+<lib/ipv4/*.ml{,i,y}>: pkg_logs
+<lib/ipv4/*.ml{,i,y}>: pkg_lwt
+<lib/ipv4/*.ml{,i,y}>: pkg_mirage-profile
+<lib/ipv4/*.ml{,i,y}>: pkg_mirage-runtime
+<lib/ipv4/*.ml{,i,y}>: pkg_mirage-types
+<lib/ipv4/*.ml{,i,y}>: pkg_mirage-types-lwt
+<lib/ipv4/*.ml{,i,y}>: pkg_randomconv
+<lib/ipv4/*.ml{,i,y}>: pkg_result
+<lib/ipv4/*.ml{,i,y}>: pkg_rresult
+<lib/ipv4/*.ml{,i,y}>: use_ethif
+<lib/ipv4/*.ml{,i,y}>: use_tcp
+<lib/ipv4/*.ml{,i,y}>: use_tcpip
+<lib/ipv4/*.ml{,i,y}>: use_udp
 # Library tcpip-stack-direct
 "lib/tcpip-stack-direct.cmxs": use_tcpip-stack-direct
 <lib/*.ml{,i,y}>: pkg_fmt

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 750319fb7d1ad0aa0cd18d6842562655)
+# DO NOT EDIT (digest: bf264be3ca47d19f155f60298bbb98b7)
 version = "2.8.0"
 description =
 "Implementations for network-related module types from MirageOS."
@@ -139,7 +139,7 @@ package "ipv4" (
  description =
  "Implementations for network-related module types from MirageOS."
  requires =
- "logs io-page mirage-types ipaddr cstruct.ppx lwt result rresult tcpip tcpip.ethif mirage-runtime"
+ "logs io-page mirage-types ipaddr cstruct.ppx lwt result rresult mirage-runtime tcpip tcpip.ethif tcpip.udp tcpip.tcp"
  archive(byte) = "ipv4.cma"
  archive(byte, plugin) = "ipv4.cma"
  archive(native) = "ipv4.cmxa"

lib/ipv4/ipv4_packet.ml

@@ -17,58 +17,6 @@ let pp fmt t =
 
 let equal p q = (p = q)
 
-module Unmarshal = struct
-  type error = string
-
-  let int_to_protocol = function
-    | 1  -> Some `ICMP
-    | 6  -> Some `TCP
-    | 17 -> Some `UDP
-    | _  -> None
-
-  let of_cstruct buf =
-    let open Rresult in
-    let open Ipv4_wire in
-    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)
-    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
-    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))
-        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 Result.Ok hlen
-    in
-    let parse buf options_end =
-      let payload_len = (get_ipv4_len buf) - options_end in
-      let src = Ipaddr.V4.of_int32 (get_ipv4_src buf) in
-      let dst = Ipaddr.V4.of_int32 (get_ipv4_dst buf) in
-      let proto = get_ipv4_proto buf in
-      let ttl = get_ipv4_ttl buf in
-      let options =
-        if options_end > sizeof_ipv4 then (Cstruct.sub buf sizeof_ipv4 (options_end - sizeof_ipv4))
-        else (Cstruct.create 0)
-      in
-      let payload = Cstruct.sub buf options_end payload_len in
-      Result.Ok ({src; dst; proto; ttl; options;}, payload)
-    in
-    size_check buf >>= check_version >>= get_header_length >>= parse buf
-end
 module Marshal = struct
   open Ipv4_wire
 
@@ -125,3 +73,75 @@ module Marshal = struct
     unsafe_fill ~payload t buf;
     buf
 end
+module Unmarshal = struct
+  type error = string
+
+  let int_to_protocol = function
+    | 1  -> Some `ICMP
+    | 6  -> Some `TCP
+    | 17 -> Some `UDP
+    | _  -> None
+
+  let of_cstruct buf =
+    let open Rresult in
+    let open Ipv4_wire in
+    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)
+    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
+    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))
+        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 Result.Ok hlen
+    in
+    let parse buf options_end =
+      let payload_len = (get_ipv4_len buf) - options_end in
+      let src = Ipaddr.V4.of_int32 (get_ipv4_src buf) in
+      let dst = Ipaddr.V4.of_int32 (get_ipv4_dst buf) in
+      let proto = get_ipv4_proto buf in
+      let ttl = get_ipv4_ttl buf in
+      let options =
+        if options_end > sizeof_ipv4 then (Cstruct.sub buf sizeof_ipv4 (options_end - sizeof_ipv4))
+        else (Cstruct.create 0)
+      in
+      let payload = Cstruct.sub buf options_end payload_len in
+      Result.Ok ({src; dst; proto; ttl; options;}, payload)
+    in
+    size_check buf >>= check_version >>= get_header_length >>= parse buf
+
+  let verify_transport_checksum ~proto ~ipv4_header ~transport_packet =
+    (* note: it's not necessary to ensure padding to integral number of 16-bit fields here; ones_complement_list does this for us *)
+    let check ~proto ipv4_header len =
+      try
+        let ph = Marshal.pseudoheader ~src:ipv4_header.src ~dst:ipv4_header.dst ~proto len in
+        let calculated_checksum = Tcpip_checksum.ones_complement_list [ph ; transport_packet] in
+        0 = compare 0x0000 calculated_checksum
+      with
+      | Invalid_argument _ -> false
+    in
+    match proto with
+    | `TCP -> (* checksum isn't optional in tcp, but pkt must be long enough *)
+      check ipv4_header ~proto (Cstruct.len transport_packet)
+    | `UDP ->
+      match Udp_wire.get_udp_checksum transport_packet with
+      | n when (=) 0 @@ compare n 0x0000 -> true (* no checksum supplied, so the check trivially passes *)
+      | _ ->
+        check ipv4_header ~proto (Cstruct.len transport_packet)
+
+end

lib/ipv4/ipv4_packet.mli

@@ -20,6 +20,9 @@ module Unmarshal : sig
   val int_to_protocol : int -> protocol option
 
   val of_cstruct : Cstruct.t -> (t * Cstruct.t, error) Result.result
+
+  val verify_transport_checksum : proto:([`TCP | `UDP]) -> ipv4_header:t ->
+      transport_packet:Cstruct.t -> bool
 end
 
 module Marshal : sig

lib_test/test.ml

@@ -15,12 +15,13 @@
  *)
 
 let suite = [
-  "tcp_window"     , Test_tcp_window.suite   ;
+  "checksums"      , Test_checksums.suite   ;
+  "tcp_window"     , Test_tcp_window.suite  ;
   "udp"            , Test_udp.suite         ;
   "socket"         , Test_socket.suite      ;
   "icmpv4"         , Test_icmpv4.suite      ;
   "tcp_options"    , Test_tcp_options.suite ;
-  "ip_options"     , Test_ip_options.suite ;
+  "ip_options"     , Test_ip_options.suite  ;
   "rfc5961"        , Test_rfc5961.suite     ;
   "arp"            , Test_arp.suite         ;
   "connect"        , Test_connect.suite     ;

lib_test/test_checksums.ml

@@ -0,0 +1,65 @@
+open Rresult
+
+let unwrap_ipv4 buf = Ipv4_packet.Unmarshal.of_cstruct buf |> R.reword_error R.msg |> R.error_msg_to_invalid_arg
+let verify_ipv4_udp = Ipv4_packet.Unmarshal.verify_transport_checksum ~proto:`UDP
+let verify_ipv4_tcp = Ipv4_packet.Unmarshal.verify_transport_checksum ~proto:`TCP
+
+let example_ipv4_udp = "\
+\x45\xb8\x00\x4c\xbf\x7c\x40\x00\x34\x11\xdf\x65\x90\x5c\x09\x16\
+\x0a\x89\x03\x0c\x00\x7b\x00\x7b\x00\x38\xf4\xfb\x24\x01\x03\xee\
+\x00\x00\x00\x00\x00\x00\x00\x43\x47\x50\x53\x00\xdc\x03\xd0\x04\
+\x53\x76\x73\x95\xdc\x03\xd0\x06\xcb\xd2\x4f\xfb\xdc\x03\xd0\x06\
+\xcd\x57\x43\xa0\xdc\x03\xd0\x06\xcd\xb6\x2e\x51"
+
+let example_ipv4_tcp = "\
+\x45\x00\x00\x34\x00\x00\x40\x00\x2d\x06\x47\x91\x93\x4b\x65\x53\
+\x0a\x89\x03\x0c\x01\xbb\xe5\xd0\x6f\x75\x20\x55\xf6\x5e\xdb\xef\
+\x80\x12\x72\x10\xad\x83\x00\x00\x02\x04\x05\x48\x01\x01\x04\x02\
+\x01\x03\x03\x08"
+
+let udp_ipv4_correct_positive () =
+  let buf = Cstruct.of_string example_ipv4_udp in
+  let (ipv4_header, transport_packet) = unwrap_ipv4 buf in
+  Alcotest.(check bool) "for a correct UDP checksum, return true"
+    true @@ verify_ipv4_udp ~ipv4_header ~transport_packet;
+  Lwt.return_unit
+
+let udp_ipv4_correct_negative () =
+  let buf = Cstruct.of_string example_ipv4_udp in
+  Cstruct.BE.set_uint32 buf ((Cstruct.len buf) - 4) 0x1234l;
+  let (ipv4_header, transport_packet) = unwrap_ipv4 buf in
+  Alcotest.(check bool) "mutating the packet w/o fixing checksum causes verification to fail"
+    false @@ verify_ipv4_udp ~ipv4_header ~transport_packet;
+  Lwt.return_unit
+
+let udp_ipv4_allows_zero () =
+  let buf = Cstruct.of_string example_ipv4_udp in
+  let (ipv4_header, transport_packet) = unwrap_ipv4 buf in
+  Udp_wire.set_udp_checksum transport_packet 0x0000;
+  Alcotest.(check bool) "0x0000 checksum is OK for UDP"
+    true @@ verify_ipv4_udp ~ipv4_header ~transport_packet;
+  Lwt.return_unit
+
+let tcp_ipv4_correct_positive () =
+  let buf = Cstruct.of_string example_ipv4_tcp in
+  let (ipv4_header, transport_packet) = unwrap_ipv4 buf in
+  Alcotest.(check bool) "for a correct TCP checksum, return true"
+    true @@ verify_ipv4_tcp ~ipv4_header ~transport_packet;
+  Lwt.return_unit
+
+let tcp_ipv4_correct_negative () =
+  let buf = Cstruct.of_string example_ipv4_tcp in
+  Cstruct.BE.set_uint32 buf ((Cstruct.len buf) - 4) 0x1234l;
+  let (ipv4_header, transport_packet) = unwrap_ipv4 buf in
+  Alcotest.(check bool) "mutating a TCP packet w/o fixing checksum causes verification to fail"
+    false @@ verify_ipv4_tcp ~ipv4_header ~transport_packet;
+  Lwt.return_unit
+
+let suite =
+[
+  "correct UDP IPV4 checksums are recognized",  `Quick, udp_ipv4_correct_positive;
+  "incorrect UDP IPV4 checksums are recognized",  `Quick, udp_ipv4_correct_negative;
+  "0x00 UDP checksum is valid", `Quick, udp_ipv4_allows_zero;
+  "correct TCP IPV4 checksums are recognized",  `Quick, tcp_ipv4_correct_positive;
+  "incorrect TCP IPV4 checksums are recognized",  `Quick, tcp_ipv4_correct_negative;
+]

myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 65ba287fe6c51822cf527d9c15afdfb4) *)
+(* DO NOT EDIT (digest: 61d522780b0d74636b2863a6585885db) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -891,11 +891,11 @@ let package_default =
           ("tcpip_xen", ["lib"], []);
           ("ethif", ["lib/ethif"], []);
           ("arpv4", ["lib/arpv4"], []);
-          ("ipv4", ["lib/ipv4"], []);
           ("ipv6", ["lib/ipv6"], []);
           ("icmpv4", ["lib/icmp"], []);
           ("udp", ["lib/udp"], []);
           ("tcp", ["lib/tcp"], []);
+          ("ipv4", ["lib/ipv4"], []);
           ("tcpip-stack-direct", ["lib"], []);
           ("icmpv4-socket", ["unix"], []);
           ("udpv4-socket", ["unix"], []);
@@ -937,7 +937,7 @@ let package_default =
           ("lib/udp", ["lib"]);
           ("lib/tcp", ["lib"]);
           ("lib/ipv6", ["lib"; "lib/ethif"]);
-          ("lib/ipv4", ["lib"; "lib/ethif"]);
+          ("lib/ipv4", ["lib"; "lib/ethif"; "lib/tcp"; "lib/udp"]);
           ("lib/icmp", ["lib"]);
           ("lib/arpv4", ["lib/ethif"])
        ]