diff --git a/src/ipv4/fragments.ml b/src/ipv4/fragments.ml new file mode 100644 index 000000000..dcd29dfbe --- /dev/null +++ b/src/ipv4/fragments.ml @@ -0,0 +1,178 @@ +(* + * Copyright (c) 2018 Hannes Mehnert + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS l SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +let src = Logs.Src.create "ipv4-fragments" ~doc:"IPv4 fragmentation" +module Log = (val Logs.src_log src : Logs.LOG) + +open Rresult.R.Infix + +(* TODO: +current state: + + lifetime is 10s max between first and last fragment + size is 1MB hardcoded + max 16 fragments for each "flow" (source ip, destrination ip, protocol, ipv4 identifier) + inserted into sorted list, checks overlaps and holes on reassembly (triggered once a fragment without "more fragments" has been received) + +this has some issues: + + anyone can spam (with a constant stream of fragmented packets - needs to fill 1MB in 10s) the fragment cache, leading to resource exhaustion of the cache ("valid" fragments are dropped if they're incoming too slowly) + insertion into linked list is O(n) (with n is maximal 16) + ping -s 65535 isn't answered with MTU=1500 (doesn't fit into 16 fragments) + +what we could do instead + + maximum storage per source ip + use a bitmask or tree data structure for the segments (offset is on 8byte boundaries) + may lead to verification of overlaps at insertion time --> can drop immediately +*) + +(* IP Fragmentation using a LRU cache: + + The key of our cache is source ip * destination ip * protocol * identifier. + The value is a quintuple consisting of first segment received. IP options + (which are usually sent only in the first IP segment), "last segment + received" (i.e. an IPv4 segment without the more fragment bit set), a counter + of the length of items, and a list of pairs, which contain an offset and + payload. The list is sorted by offset in descending order. *) + +module V = struct + type t = int64 * Cstruct.t * bool * int * (int * Cstruct.t) list + + let weight (_, _, _, _, v) = Cstruct.lenv (List.map snd v) +end + +module K = struct + type t = Ipaddr.V4.t * Ipaddr.V4.t * int * int + + let compare (src, dst, proto, id) (src', dst', proto', id') = + let (&&&) a b = match a with 0 -> b | x -> x in + let int_cmp : int -> int -> int = compare in + Ipaddr.V4.compare src src' &&& + Ipaddr.V4.compare dst dst' &&& + int_cmp proto proto' &&& + int_cmp id id' +end + +module Cache = Lru.F.Make(K)(V) + +(* insert_sorted inserts a fragment in a list, sort is by frag_start, descending *) +let rec insert_sorted ((frag_start, _) as frag) = function + | [] -> [ frag ] + | ((frag'_start, _) as frag')::tl -> + if frag'_start <= frag_start + then frag::frag'::tl + else frag'::insert_sorted frag tl + +(* attempt_reassemble takes a list of fragments, and returns either + - Ok payload when the payload was completed + - Error Hole if some fragment is still missing + - Error Bad if the list of fragments was bad: it contains overlapping + segments. This is an indication for malicious activity, and we drop the + IP fragment + +There are various attacks (and DoS) on IP reassembly, most prominent use +overlapping segments (and selection thereof), we just drop overlapping segments +(similar as Linux does since https://git.kernel.org/pub/scm/linux/kernel/git/davem/net-next.git/commit/?id=c30f1fc041b74ecdb072dd44f858750414b8b19f). +*) + +type r = Bad | Hole + +let attempt_reassemble fragments = + Log.debug (fun m -> m "reassemble %a" + Fmt.(list ~sep:(unit "; ") (pair ~sep:(unit ", len ") int int)) + (List.map (fun (off, data) -> off, Cstruct.len data) fragments)) ; + (* input: list of (offset, fragment) with decreasing offset *) + (* output: maybe a cstruct.t if there are no gaps *) + let len = + (* List.hd is safe here, since we are never called with an empty list *) + let off, data = List.hd fragments in + off + Cstruct.len data + in + let rec check until = function + | [] -> if until = 0 then Ok () else Error Hole + | (start, d)::tl -> + let until' = start + (Cstruct.len d) in + if until = until' + then check start tl + else if until' > until + then Error Bad + else Error Hole + in + check len fragments >>= fun () -> + let buf = Cstruct.create_unsafe len in + List.iter (fun (off, data) -> + Cstruct.blit data 0 buf off (Cstruct.len data)) + fragments ; + Ok buf + +let max_number_of_fragments = 16 + +let max_duration = Duration.of_sec 10 + +let process cache ts (packet : Ipv4_packet.t) payload = + Log.debug (fun m -> m "process called with off %x" packet.off) ; + if packet.off land 0x3FFF = 0 then (* ignore reserved and don't fragment *) + (* fastpath *) + cache, Some (packet, payload) + else + let offset, more = + (packet.off land 0x1FFF) lsl 3, (* of 8 byte blocks *) + packet.off land 0x2000 = 0x2000 + and key = (packet.src, packet.dst, packet.proto, packet.id) + in + match Cache.find key cache with + | None -> + Log.debug (fun m -> m "%a none found, inserting into cache" Ipv4_packet.pp packet) ; + Cache.add key (ts, packet.options, not more, 1, [(offset, payload)]) cache, None + | Some ((ts', options, finished, cnt, frags), cache') -> + if Int64.sub ts ts' >= max_duration then begin + Log.warn (fun m -> m "%a found some, but timestamp exceeded duration %a, dropping old segments and inserting new segment into cache" Ipv4_packet.pp packet Duration.pp max_duration) ; + Cache.add key (ts, packet.options, not more, 1, [(offset, payload)]) cache, None + end else + let all_frags = insert_sorted (offset, payload) frags + and try_reassemble = finished || not more + and options' = if offset = 0 then packet.options else options + in + Log.debug (fun m -> m "%d found, finished %b more %b try_reassemble %b" + cnt finished more try_reassemble) ; + let maybe_add_to_cache c = + if cnt < max_number_of_fragments then + Cache.add key (ts', options', try_reassemble, succ cnt, all_frags) c + else + (Log.warn (fun m -> m "%a dropping from cache, maximum number of fragments exceeded" + Ipv4_packet.pp packet) ; + Cache.remove key c) + in + if try_reassemble then + match attempt_reassemble all_frags with + | Ok p -> + Log.debug (fun m -> m "%a reassembled to payload %d" Ipv4_packet.pp packet (Cstruct.len p)) ; + let packet' = { packet with options = options' ; off = 0 } in + Cache.remove key cache', Some (packet', p) + | Error Bad -> + Log.warn (fun m -> m "%a dropping from cache, bad fragments (%a)" + Ipv4_packet.pp packet + Fmt.(list ~sep:(unit "; ") (pair ~sep:(unit ", ") int int)) + (List.map (fun (s, d) -> (s, Cstruct.len d)) all_frags)) ; + Logs.debug (fun m -> m "full fragments: %a" + Fmt.(list ~sep:(unit "@.") Cstruct.hexdump_pp) + (List.map snd all_frags)) ; + + Cache.remove key cache', None + | Error Hole -> maybe_add_to_cache cache', None + else + maybe_add_to_cache cache', None diff --git a/src/ipv4/fragments.mli b/src/ipv4/fragments.mli new file mode 100644 index 000000000..3acc342c0 --- /dev/null +++ b/src/ipv4/fragments.mli @@ -0,0 +1,36 @@ +(* + * Copyright (c) 2018 Hannes Mehnert + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS l SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +module V : sig + type t = int64 * Cstruct.t * bool * int * (int * Cstruct.t) list + + val weight : t -> int +end + +module K : sig + type t = Ipaddr.V4.t * Ipaddr.V4.t * int * int + val compare : t -> t -> int +end + +module Cache : sig + include Lru.F.S with type k = K.t and type v = V.t +end + +val max_number_of_fragments : int +val max_duration : int64 + +val process : Cache.t -> int64 -> Ipv4_packet.t -> Cstruct.t -> + Cache.t * (Ipv4_packet.t * Cstruct.t) option diff --git a/src/ipv4/ipv4_common.ml b/src/ipv4/ipv4_common.ml index c4604ccce..a8eba84e6 100644 --- a/src/ipv4/ipv4_common.ml +++ b/src/ipv4/ipv4_common.ml @@ -23,7 +23,8 @@ let allocate_frame ~src ~source ~(dst:Ipaddr.V4.t) ~(proto : [`ICMP | `TCP | `UD let buf = Cstruct.shift ethernet_frame Ethif_wire.sizeof_ethernet in (* TODO: why 38 for TTL? *) let ipv4_header = Ipv4_packet.({options = Cstruct.create 0; - src; dst; ttl = 38; + src; dst; ttl = 38; + off = 0 ; id = 0x0000 ; proto = Ipv4_packet.Marshal.protocol_to_int proto; }) in (* set the payload_len to 0, since we don't know what it'll be yet *) (* the caller needs to then use [writev] or [write] to output the buffer; diff --git a/src/ipv4/ipv4_packet.ml b/src/ipv4/ipv4_packet.ml index c4d32320c..ec3c51ea2 100644 --- a/src/ipv4/ipv4_packet.ml +++ b/src/ipv4/ipv4_packet.ml @@ -1,8 +1,10 @@ type t = { src : Ipaddr.V4.t; dst : Ipaddr.V4.t; - proto : Cstruct.uint8; + id : Cstruct.uint16; + off : Cstruct.uint16; ttl : Cstruct.uint8; + proto : Cstruct.uint8; options : Cstruct.t; } @@ -12,14 +14,16 @@ type protocol = [ | `UDP ] let pp fmt t = - Format.fprintf fmt "IPv4 packet %a -> %a: proto %d, ttl %d, options %a" - Ipaddr.V4.pp_hum t.src Ipaddr.V4.pp_hum t.dst t.proto t.ttl Cstruct.hexdump_pp t.options + Format.fprintf fmt "IPv4 packet %a -> %a: id %04x, off %d proto %d, ttl %d, options %a" + Ipaddr.V4.pp_hum t.src Ipaddr.V4.pp_hum t.dst t.id t.off t.proto t.ttl Cstruct.hexdump_pp t.options -let equal {src; dst; proto; ttl; options} q = +let equal {src; dst; id; off; ttl; proto; options} q = src = q.src && dst = q.dst && - proto = q.proto && + id = q.id && + off = q.off && ttl = q.ttl && + proto = q.proto && Cstruct.equal options q.options module Marshal = struct @@ -33,6 +37,7 @@ module Marshal = struct | `UDP -> 17 let pseudoheader ~src ~dst ~proto len = + (* should we do sth about id or off (assert false?) *) let proto = protocol_to_int proto in let ph = Cstruct.create 12 in let numify = Ipaddr.V4.to_int32 in @@ -120,8 +125,10 @@ module Unmarshal = struct 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 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 options = if options_end > sizeof_ipv4 then (Cstruct.sub buf sizeof_ipv4 (options_end - sizeof_ipv4)) else (Cstruct.create 0) @@ -131,7 +138,7 @@ module Unmarshal = struct Error (Printf.sprintf "Payload buffer (%d bytes) too small to contain payload (of size %d from header)" payload_available payload_len) ) else ( let payload = Cstruct.sub buf options_end payload_len in - Ok ({src; dst; proto; ttl; options;}, payload) + Ok ({src; dst; id; off; ttl; proto; options;}, payload) ) in size_check buf >>= check_version >>= get_header_length >>= parse buf diff --git a/src/ipv4/ipv4_packet.mli b/src/ipv4/ipv4_packet.mli index 67d883145..a8c142382 100644 --- a/src/ipv4/ipv4_packet.mli +++ b/src/ipv4/ipv4_packet.mli @@ -1,8 +1,10 @@ type t = { src : Ipaddr.V4.t; dst : Ipaddr.V4.t; - proto : Cstruct.uint8; + id : Cstruct.uint16; + off : Cstruct.uint16; ttl : Cstruct.uint8; + proto : Cstruct.uint8; options : Cstruct.t; } diff --git a/src/ipv4/jbuild b/src/ipv4/jbuild index f83d549c9..6a56b9bfa 100644 --- a/src/ipv4/jbuild +++ b/src/ipv4/jbuild @@ -3,6 +3,6 @@ ((name tcpip_ipv4) (public_name tcpip.ipv4) (libraries (logs io-page mirage-protocols-lwt ipaddr cstruct rresult - tcpip tcpip.ethif tcpip.udp mirage-random mirage-clock randomconv)) + tcpip tcpip.ethif tcpip.udp mirage-random mirage-clock randomconv lru)) (preprocess (pps (ppx_cstruct))) (wrapped false))) diff --git a/src/ipv4/static_ipv4.ml b/src/ipv4/static_ipv4.ml index dba53619a..07ca98aa3 100644 --- a/src/ipv4/static_ipv4.ml +++ b/src/ipv4/static_ipv4.ml @@ -36,9 +36,11 @@ module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethif: Mirage_protoco type t = { ethif : Ethif.t; arp : Arpv4.t; + clock : C.t; mutable ip: Ipaddr.V4.t; network: Ipaddr.V4.Prefix.t; mutable gateway: Ipaddr.V4.t option; + mutable cache: Fragments.Cache.t; } let adjust_output_header = Ipv4_common.adjust_output_header ~rng:R.generate @@ -74,36 +76,43 @@ module Make (R: Mirage_random.C) (C: Mirage_clock.MCLOCK) (Ethif: Mirage_protoco writev t frame [buf] (* TODO: ought we to check to make sure the destination is relevant here? currently we'll process all incoming packets, regardless of destination address *) - let input _t ~tcp ~udp ~default buf = - let open Ipv4_packet in - match Unmarshal.of_cstruct buf with + let input t ~tcp ~udp ~default buf = + match Ipv4_packet.Unmarshal.of_cstruct buf with | Error s -> - Log.info (fun f -> f "IP.input: unparseable header (%s): %S" s (Cstruct.to_string buf)); + Log.info (fun m -> m "error %s while parsing IPv4 frame %a" s Cstruct.hexdump_pp buf); Lwt.return_unit | Ok (packet, payload) -> - match Unmarshal.int_to_protocol packet.proto, Cstruct.len payload with - | Some _, 0 -> - (* Don't pass on empty buffers as payloads to known protocols, as they have no relevant headers *) - Lwt.return_unit - | None, 0 -> (* we don't know anything about the protocol; an empty - payload may be meaningful somehow? *) - default ~proto:packet.proto ~src:packet.src ~dst:packet.dst payload - | Some `TCP, _ -> tcp ~src:packet.src ~dst:packet.dst payload - | Some `UDP, _ -> udp ~src:packet.src ~dst:packet.dst payload - | Some `ICMP, _ | None, _ -> - default ~proto:packet.proto ~src:packet.src ~dst:packet.dst payload + if Cstruct.len payload = 0 then + (Log.info (fun m -> m "dropping zero length IPv4 frame %a" Ipv4_packet.pp packet) ; + Lwt.return_unit) + else + let ts = C.elapsed_ns t.clock in + let cache, res = Fragments.process t.cache ts packet payload in + t.cache <- cache ; + match res with + | None -> Lwt.return_unit + | Some (packet, payload) -> + let src, dst = packet.src, packet.dst in + match Ipv4_packet.Unmarshal.int_to_protocol packet.proto with + | Some `TCP -> tcp ~src ~dst payload + | Some `UDP -> udp ~src ~dst payload + | Some `ICMP | None -> default ~proto:packet.proto ~src ~dst payload let connect ?(ip=Ipaddr.V4.any) ?(network=Ipaddr.V4.Prefix.make 0 Ipaddr.V4.any) - ?(gateway=None) _clock ethif arp = + ?(gateway=None) clock ethif arp = match Ipaddr.V4.Prefix.mem ip network with | false -> - Log.warn (fun f -> f "IPv4: ip %a is not in the prefix %a" Ipaddr.V4.pp_hum ip Ipaddr.V4.Prefix.pp_hum network); + Log.warn (fun f -> f "IPv4: ip %a is not in the prefix %a" + Ipaddr.V4.pp_hum ip Ipaddr.V4.Prefix.pp_hum network); Lwt.fail_with "given IP is not in the network provided" | true -> Arpv4.set_ips arp [ip] >>= fun () -> - let t = { ethif; arp; ip; network; gateway } in + (* TODO currently hardcoded to 4MB, should be configurable + and maybe limited per-src/dst-ip as well? *) + let cache = Fragments.Cache.empty (1024 * 1024 * 4) in + let t = { ethif; arp; ip; clock; network; gateway ; cache } in Lwt.return t let disconnect _ = Lwt.return_unit diff --git a/tcpip.opam b/tcpip.opam index 3afdf412d..66ca238e6 100644 --- a/tcpip.opam +++ b/tcpip.opam @@ -48,6 +48,7 @@ depends: [ "pcap-format" {with-test} "mirage-clock-unix" {with-test & >= "1.2.0"} "mirage-random-test" {with-test} + "lru" ] synopsis: "OCaml TCP/IP networking stack, used in MirageOS" description: """ diff --git a/test/test_checksums.ml b/test/test_checksums.ml index 11be4122a..5c78bc1c8 100644 --- a/test/test_checksums.ml +++ b/test/test_checksums.ml @@ -51,7 +51,7 @@ let udp_ipv4_zero_checksum () = let ipv4_header = Ipv4_packet.{ src; dst; proto = Ipv4_packet.Marshal.protocol_to_int proto; - ttl; options } in + ttl; id = 0 ; off = 0 ; options } in let pseudoheader = Ipv4_packet.Marshal.pseudoheader ~src ~dst diff --git a/test/test_ipv4.ml b/test/test_ipv4.ml index e292b1e62..ea8303bdc 100644 --- a/test/test_ipv4.ml +++ b/test/test_ipv4.ml @@ -38,7 +38,7 @@ let test_size () = let src = Ipaddr.V4.of_string_exn "127.0.0.1" in let dst = Ipaddr.V4.of_string_exn "127.0.0.2" in let ttl = 64 in - let ip = { Ipv4_packet.src; dst; proto = 17; ttl; options = (Cstruct.of_string "aaaa") } in + let ip = { Ipv4_packet.src; dst; proto = 17; ttl; id = 0 ; off = 0 ; options = (Cstruct.of_string "aaaa") } in let payload = Cstruct.of_string "abcdefgh" in let tmp = Ipv4_packet.Marshal.make_cstruct ~payload_len:(Cstruct.len payload) ip in let tmp = Cstruct.concat [tmp; payload] in @@ -46,9 +46,196 @@ let test_size () = |> Alcotest.(check (result (pair ipv4_packet cstruct) string)) "Loading an IP packet with IP options" (Ok (ip, payload)); Lwt.return_unit +let test_packet = + let src = Ipaddr.V4.of_string_exn "127.0.0.1" in + let dst = Ipaddr.V4.of_string_exn "127.0.0.2" in + let ttl = 64 in + { Ipv4_packet.src; dst; proto = 17; ttl; id = 0 ; off = 0 ; options = (Cstruct.of_string "aaaa") } + +let empty_cache = Fragments.Cache.empty 1000 + +let basic_fragments payload () = + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ + (Some (test_packet, payload)) + (snd @@ Fragments.process empty_cache 0L test_packet payload)) ; + let off_packet = { test_packet with off = 1 } in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ + None + (snd @@ Fragments.process empty_cache 0L off_packet payload)) ; + Lwt.return_unit + +let basic_reassembly () = + let more_frags = { test_packet with off = 0x2000 } in + let payload = Cstruct.create 16 in + let cache, res = Fragments.process empty_cache 0L more_frags payload in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + let off_packet = { test_packet with off = 2 } in + Alcotest.(check (option (pair ipv4_packet cstruct)) "reassembly of two segments works" + (Some (test_packet, Cstruct.append payload payload)) + (snd @@ Fragments.process cache 0L off_packet payload)) ; + Lwt.return_unit + +let basic_reassembly_timeout () = + let more_frags = { test_packet with off = 0x2000 } in + let payload = Cstruct.create 16 in + let cache, res = Fragments.process empty_cache 0L more_frags payload in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + let off_packet = { test_packet with off = 2 } in + let below_max = Int64.sub Fragments.max_duration 1L in + Alcotest.(check (option (pair ipv4_packet cstruct)) "even after just before max duration" + (Some (test_packet, Cstruct.append payload payload)) + (snd @@ Fragments.process cache below_max off_packet payload)) ; + Alcotest.(check (option (pair ipv4_packet cstruct)) "none after max duration" + None + (snd @@ Fragments.process cache Fragments.max_duration off_packet payload)) ; + let more_off_packet = { test_packet with off = 0x2002 } in + let cache, res = Fragments.process cache below_max more_off_packet payload in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + let final_packet = { test_packet with off = 4 } in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ + (Some (test_packet, Cstruct.concat [ payload; payload; payload])) + (snd @@ Fragments.process cache below_max final_packet payload)) ; + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ + None + (snd @@ Fragments.process cache Fragments.max_duration off_packet payload)) ; + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + Lwt.return_unit + +let reassembly_out_of_orfer () = + let more_frags = { test_packet with off = 0x2000 } in + let payload = Cstruct.create 16 in + let off_packet = { test_packet with off = 2 } in + let cache, res = Fragments.process empty_cache 0L off_packet payload in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + Alcotest.(check (option (pair ipv4_packet cstruct)) "reassembly of two segments works" + (Some (test_packet, Cstruct.append payload payload)) + (snd @@ Fragments.process cache 0L more_frags payload)) ; + Lwt.return_unit + +let reassembly_multiple_out_of_orfer packets final_payload () = + let _, res = List.fold_left (fun (cache, res) (off, payload) -> + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + let packet = { test_packet with off } in + Fragments.process cache 0L packet payload) + (empty_cache, None) packets + in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ + (Some (test_packet, final_payload)) + res) ; + Lwt.return_unit + +let basic_overlaps () = + let more_frags = { test_packet with off = 0x2000 } in + let payload = Cstruct.create 16 in + let off_packet = { test_packet with off = 1 } in + let cache, res = Fragments.process empty_cache 0L off_packet payload in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None + (snd @@ Fragments.process cache 0L more_frags payload)) ; + Lwt.return_unit + +let basic_other_ip_flow () = + let more_frags = { test_packet with off = 0x2000 } in + let payload = Cstruct.create 16 in + let cache, res = Fragments.process empty_cache 0L more_frags payload in + let off_packet = { test_packet with off = 2 ; src = Ipaddr.V4.of_string_exn "127.0.0.2" } in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None + (snd @@ Fragments.process cache 0L off_packet payload)) ; + let off_packet' = { test_packet with off = 2 ; proto = 25 } in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None + (snd @@ Fragments.process cache 0L off_packet' payload)) ; + Lwt.return_unit + +let none_returned packets () = + let _, res = List.fold_left (fun (cache, res) (off, payload) -> + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + let packet = { test_packet with off } in + Fragments.process cache 0L packet payload) + (empty_cache, None) packets + in + Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ; + Lwt.return_unit + +let white = Cstruct.create 16 +let black = + let buf = Cstruct.create 16 in + Cstruct.memset buf 0xFF ; + buf +let gray = + let buf = Cstruct.create 16 in + Cstruct.memset buf 0x55 ; + buf + +let mf = 0x2000 + +let ins_all_positions x l = + let rec aux prev acc = function + | [] -> List.rev ((prev @ [x]) :: acc) + | hd::tl as l -> aux (prev @ [hd]) ((prev @ [x] @ l) :: acc) tl + in + aux [] [] l + +let rec permutations = function + | [] -> [] + | [x] -> [[x]] + | x::xs -> List.fold_left (fun acc p -> acc @ ins_all_positions x p ) [] + (permutations xs) + let suite = [ "unmarshal ip datagram with options", `Quick, test_unmarshal_with_options; "unmarshal ip datagram without options", `Quick, test_unmarshal_without_options; "unmarshal ip datagram with no payload & hlen > 5", `Quick, test_unmarshal_regression; - "size", `Quick, test_size; -] + "size", `Quick, test_size ] @ + List.mapi (fun i size -> + Printf.sprintf "basic fragment %d: payload %d" i size, `Quick, basic_fragments (Cstruct.create size)) + [ 0 ; 1 ; 2 ; 10 ; 100 ; 1000 ; 5000 ; 10000 ] @ [ + "basic reassembly", `Quick, basic_reassembly; + "basic reassembly timeout", `Quick, basic_reassembly_timeout; + "reassembly out of order", `Quick, reassembly_out_of_orfer ; + "other ip flow", `Quick, basic_other_ip_flow ] @ + List.mapi (fun i (packets, final) -> + Printf.sprintf "ressembly multiple %d" i, `Quick, + reassembly_multiple_out_of_orfer packets final) + ([ + ([ (mf, white); (2, black) ], Cstruct.concat [white;black]); + ([ (mf, black); (2, white) ], Cstruct.concat [black;white]); + ([ (2, black); (mf, white) ], Cstruct.concat [white;black]); + ([ (2, white); (mf, black) ], Cstruct.concat [black;white]); + ([ (mf, Cstruct.create 984); (123, black)], Cstruct.concat [Cstruct.create 984;black]); + ([ (mf, Cstruct.create 984); (123 lor mf, black); (125, gray)], + Cstruct.concat [Cstruct.create 984;black;gray]); + ([ (mf, Cstruct.create 1000); (125, (Cstruct.concat [black;black;black]))], + Cstruct.concat [Cstruct.create 1000;black;black;black]); + ]@ + List.map (fun x -> (x, Cstruct.concat [gray;white;black])) + (permutations [ (mf, gray); (2 lor mf, white); (4, black)]) @ + List.map (fun x -> (x, Cstruct.concat [gray;white;black;Cstruct.create 10])) + (permutations [ (mf, gray); (2 lor mf, white); (4 lor mf, black); (6, Cstruct.create 10)]) @ + List.map (fun x -> (x, Cstruct.concat [black;gray;white;black;gray])) + (permutations [ (mf, black); (2 lor mf, gray); (4 lor mf, white); (6 lor mf, black); (8, gray)]) + ) @ + [ "nothing returned", `Quick, basic_overlaps ] @ + List.mapi (fun i packets -> + Printf.sprintf "nothing returned %d" i, `Quick, + none_returned packets) + ([ + [ (mf, white); (1, black) ]; + [ (mf, black); (3, white) ]; + [ (mf, Cstruct.create 992); (124 lor mf, black);(126, gray)]; + [ (mf, Cstruct.create 1024); (128, black)]; + ] @ + permutations [ (mf, gray); (2 lor mf, white); (3, black)] @ + permutations [ (mf, gray); (2 lor mf, white); (5, black)] @ + permutations [ (mf, gray); (3 lor mf, white); (4, black)] @ + permutations [ (mf, gray); (3 lor mf, white); (5, black)] @ + permutations [ (mf, gray); (1 lor mf, white); (3, black)] @ + permutations [ (mf, gray); (1 lor mf, white); (4, black)] @ + permutations [ (mf, (Cstruct.append gray gray)); (3 lor mf, white)] @ + permutations [ (mf, (Cstruct.append gray gray)); (2 lor mf, white)] @ + permutations [ (mf, gray); (2 lor mf, white); (4 lor mf, black); (6 lor mf, gray)] @ + permutations [ (mf, gray); (2 lor mf, white); (4 lor mf, black); (5, gray)] @ + permutations [ (mf, gray); (4 lor mf, white); (4 lor mf, black); (6, gray)] @ + permutations [ (mf, gray); (1 lor mf, white); (3 lor mf, black); (5, gray)] @ + permutations [ (mf, gray); (2 lor mf, white); (4 lor mf, black); (7, gray)] + ) diff --git a/test/test_tcp_options.ml b/test/test_tcp_options.ml index d1933c6a3..f58f15f34 100644 --- a/test/test_tcp_options.ml +++ b/test/test_tcp_options.ml @@ -175,7 +175,7 @@ let test_marshal_into_cstruct () = let src = Ipaddr.V4.of_string_exn "127.0.0.1" in let dst = Ipaddr.V4.of_string_exn "127.0.0.1" in let ipv4_header = - {Ipv4_packet.src; dst; proto = 6; ttl = 64; options = Cstruct.create 0} + {Ipv4_packet.src; dst; proto = 6; ttl = 64; id = 0 ; off = 0 ; options = Cstruct.create 0} in let payload = Cstruct.of_string "ab" in let pseudoheader = @@ -232,7 +232,7 @@ let test_marshal_without_padding () = let src = Ipaddr.V4.of_string_exn "127.0.0.1" in let dst = Ipaddr.V4.of_string_exn "127.0.0.1" in let ipv4_header = - {Ipv4_packet.src; dst; proto = 6; ttl = 64; options = Cstruct.create 0} + {Ipv4_packet.src; dst; proto = 6; ttl = 64; id = 0 ; off = 0 ; options = Cstruct.create 0} in let payload = Cstruct.of_string "\x02\x04\x05\xb4" in let pseudoheader =