|
| 1 | +open Lwt.Infix |
| 2 | + |
| 3 | +(* |
| 4 | + * Connects two stacks to the same backend. |
| 5 | + * One is a complete v4 stack (the system under test, referred to as [sut]). |
| 6 | + * The other gives us low level access to inject crafted TCP packets, |
| 7 | + * and sends and receives crafted packets to check the [sut] behavior. |
| 8 | + *) |
| 9 | +module VNETIF_STACK = Vnetif_common.VNETIF_STACK(Vnetif_backends.Basic) |
| 10 | + |
| 11 | +module Time = Vnetif_common.Time |
| 12 | +module V = Vnetif.Make(Vnetif_backends.Basic) |
| 13 | +module E = Ethernet.Make(V) |
| 14 | +module A = Arp.Make(E)(Time) |
| 15 | +module I = Static_ipv4.Make(Mirage_random_test)(Vnetif_common.Clock)(E)(A) |
| 16 | +module Wire = Tcp.Wire |
| 17 | +module WIRE = Wire.Make(I) |
| 18 | +module Tcp_wire = Tcp.Tcp_wire |
| 19 | +module Tcp_unmarshal = Tcp.Tcp_packet.Unmarshal |
| 20 | +module Sequence = Tcp.Sequence |
| 21 | + |
| 22 | +let sut_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.101/24" |
| 23 | +let server_ip = Ipaddr.V4.of_string_exn "10.0.0.100" |
| 24 | +let server_cidr = Ipaddr.V4.Prefix.make 24 server_ip |
| 25 | +let gateway = Ipaddr.V4.of_string_exn "10.0.0.1" |
| 26 | + |
| 27 | +let header_size = Ethernet.Packet.sizeof_ethernet |
| 28 | + |
| 29 | + |
| 30 | + |
| 31 | +(* defaults when injecting packets *) |
| 32 | +let options = [] |
| 33 | +let window = 5120 |
| 34 | + |
| 35 | +(* Helper functions *) |
| 36 | +let reply_id_from ~src ~dst data = |
| 37 | + let sport = Tcp_wire.get_tcp_src_port data in |
| 38 | + let dport = Tcp_wire.get_tcp_dst_port data in |
| 39 | + WIRE.v ~dst_port:sport ~dst:src ~src_port:dport ~src:dst |
| 40 | + |
| 41 | +let ack_for data = |
| 42 | + match Tcp_unmarshal.of_cstruct data with |
| 43 | + | Error s -> Alcotest.fail ("attempting to ack data: " ^ s) |
| 44 | + | Ok (packet, data) -> |
| 45 | + let open Tcp.Tcp_packet in |
| 46 | + let data_len = |
| 47 | + Sequence.of_int ((Cstruct.length data) + |
| 48 | + (if packet.fin then 1 else 0) + |
| 49 | + (if packet.syn then 1 else 0)) in |
| 50 | + let sequence = packet.sequence in |
| 51 | + let ack_n = Sequence.(add sequence data_len) in |
| 52 | + ack_n |
| 53 | + |
| 54 | +let ack data = |
| 55 | + Some(ack_for data) |
| 56 | + |
| 57 | +let ack_in_future data off = |
| 58 | + Some Sequence.(add (ack_for data) (of_int off)) |
| 59 | + |
| 60 | +let ack_from_past data off = |
| 61 | + Some Sequence.(sub (ack_for data) (of_int off)) |
| 62 | + |
| 63 | +let fail_result_not_expected fail = function |
| 64 | + | Error _err -> |
| 65 | + fail "error not expected" |
| 66 | + | Ok `Eof -> |
| 67 | + fail "eof" |
| 68 | + | Ok (`Data data) -> |
| 69 | + Alcotest.fail (Format.asprintf "data not expected but received: %a" |
| 70 | + Cstruct.hexdump_pp data) |
| 71 | + |
| 72 | + |
| 73 | + |
| 74 | +let create_sut_stack backend = |
| 75 | + VNETIF_STACK.create_stack ~cidr:sut_cidr ~gateway backend |
| 76 | + |
| 77 | +let create_raw_stack backend = |
| 78 | + V.connect backend >>= fun netif -> |
| 79 | + E.connect netif >>= fun ethif -> |
| 80 | + A.connect ethif >>= fun arpv4 -> |
| 81 | + I.connect ~cidr:server_cidr ~gateway ethif arpv4 >>= fun ip -> |
| 82 | + Lwt.return (netif, ethif, arpv4, ip) |
| 83 | + |
| 84 | +type 'state fsm_result = |
| 85 | + | Fsm_next of 'state |
| 86 | + | Fsm_done |
| 87 | + | Fsm_error of string |
| 88 | + |
| 89 | +(* This could be moved to a common module and reused for other low level tcp tests *) |
| 90 | + |
| 91 | +(* setups network and run a given sut and raw fsm *) |
| 92 | +let run backend fsm sut () = |
| 93 | + let initial_state, fsm_handler = fsm in |
| 94 | + create_sut_stack backend >>= fun stackv4 -> |
| 95 | + create_raw_stack backend >>= fun (netif, ethif, arp, rawip) -> |
| 96 | + let error_mbox = Lwt_mvar.create_empty () in |
| 97 | + let stream, pushf = Lwt_stream.create () in |
| 98 | + Lwt.pick [ |
| 99 | + VNETIF_STACK.Stackv4.listen stackv4; |
| 100 | + |
| 101 | + (* Consume TCP packets one by one, in sequence *) |
| 102 | + let rec fsm_thread state = |
| 103 | + Lwt_stream.next stream >>= fun (src, dst, data) -> |
| 104 | + fsm_handler rawip state ~src ~dst data >>= function |
| 105 | + | Fsm_next s -> |
| 106 | + fsm_thread s |
| 107 | + | Fsm_done -> |
| 108 | + Lwt.return_unit |
| 109 | + | Fsm_error err -> |
| 110 | + Lwt_mvar.put error_mbox err >>= fun () -> |
| 111 | + (* it will be terminated anyway when the error is picked up *) |
| 112 | + fsm_thread state in |
| 113 | + |
| 114 | + Lwt.async (fun () -> |
| 115 | + (V.listen netif ~header_size |
| 116 | + (E.input |
| 117 | + ~arpv4:(A.input arp) |
| 118 | + ~ipv4:(I.input |
| 119 | + ~tcp: (fun ~src ~dst data -> pushf (Some(src,dst,data)); Lwt.return_unit) |
| 120 | + ~udp:(fun ~src:_ ~dst:_ _data -> Lwt.return_unit) |
| 121 | + ~default:(fun ~proto ~src ~dst _data -> |
| 122 | + Logs.debug (fun f -> f "default handler invoked for packet from %a to %a, protocol %d -- dropping" Ipaddr.V4.pp src Ipaddr.V4.pp dst proto); Lwt.return_unit) |
| 123 | + rawip |
| 124 | + ) |
| 125 | + ~ipv6:(fun _buf -> |
| 126 | + Logs.debug (fun f -> f "IPv6 packet -- dropping"); |
| 127 | + Lwt.return_unit) |
| 128 | + ethif) ) >|= fun _ -> ()); |
| 129 | + |
| 130 | + (* Either both fsm and the sut terminates, or a timeout occurs, or one of the sut/fsm informs an error *) |
| 131 | + Lwt.pick [ |
| 132 | + (Time.sleep_ns (Duration.of_sec 5) >>= fun () -> |
| 133 | + Lwt.return_some "timed out"); |
| 134 | + |
| 135 | + (Lwt.join [ |
| 136 | + (fsm_thread initial_state); |
| 137 | + |
| 138 | + (* time to let the other end connects to the network and listen. |
| 139 | + * Otherwise initial syn might need to be repeated slowing down the test *) |
| 140 | + (Time.sleep_ns (Duration.of_ms 100) >>= fun () -> |
| 141 | + sut stackv4 (Lwt_mvar.put error_mbox) >>= fun _ -> |
| 142 | + Time.sleep_ns (Duration.of_ms 100)); |
| 143 | + ] >>= fun () -> Lwt.return_none); |
| 144 | + |
| 145 | + (Lwt_mvar.take error_mbox >>= fun cause -> |
| 146 | + Lwt.return_some cause); |
| 147 | + ] >|= function |
| 148 | + | None -> () |
| 149 | + | Some err -> Alcotest.fail err |
| 150 | + ] |
0 commit comments