This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
26
unikernel/duniverse/mirage-tcpip/test/common.ml
Normal file
26
unikernel/duniverse/mirage-tcpip/test/common.ml
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
open Lwt.Infix
|
||||
|
||||
let failf fmt = Fmt.kstr (fun s -> Alcotest.fail s) fmt
|
||||
|
||||
let ( let* ) = Result.bind
|
||||
|
||||
let or_error name fn t =
|
||||
fn t >>= function
|
||||
| Error _ -> failf "or_error starting %s" name
|
||||
| Ok t -> Lwt.return t
|
||||
|
||||
let expect_error error name fn t =
|
||||
fn t >>= function
|
||||
| Error error2 when error2 = error -> Lwt.return t
|
||||
| _ -> failf "expected error on %s" name
|
||||
|
||||
let ipv4_packet = Alcotest.testable Ipv4_packet.pp Ipv4_packet.equal
|
||||
let udp_packet = Alcotest.testable Udp_packet.pp Udp_packet.equal
|
||||
let tcp_packet = Alcotest.testable Tcp.Tcp_packet.pp Tcp.Tcp_packet.equal
|
||||
let cstruct = Alcotest.testable Cstruct.hexdump_pp Cstruct.equal
|
||||
|
||||
let sequence =
|
||||
let eq x y = Tcp.Sequence.compare x y = 0 in
|
||||
Alcotest.testable Tcp.Sequence.pp eq
|
||||
|
||||
let options = Alcotest.testable Tcp.Options.pp Tcp.Options.equal
|
||||
10
unikernel/duniverse/mirage-tcpip/test/dune
Normal file
10
unikernel/duniverse/mirage-tcpip/test/dune
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
(test
|
||||
(name test)
|
||||
(libraries alcotest mirage-crypto-rng mirage-crypto-rng.unix lwt.unix logs logs.fmt
|
||||
mirage-flow mirage-vnetif mirage-mtime pcap-format duration
|
||||
arp arp.mirage ethernet tcpip.ipv4 tcpip.tcp tcpip.udp
|
||||
tcpip.stack-direct tcpip.icmpv4 tcpip.udpv4v6-socket tcpip.tcpv4v6-socket
|
||||
tcpip.icmpv4-socket tcpip.stack-socket tcpip.ipv6 ipaddr-cstruct
|
||||
macaddr-cstruct tcpip)
|
||||
(action
|
||||
(run %{test} -q -e --color=always)))
|
||||
149
unikernel/duniverse/mirage-tcpip/test/low_level.ml
Normal file
149
unikernel/duniverse/mirage-tcpip/test/low_level.ml
Normal file
|
|
@ -0,0 +1,149 @@
|
|||
open Lwt.Infix
|
||||
|
||||
(*
|
||||
* Connects two stacks to the same backend.
|
||||
* One is a complete v4 stack (the system under test, referred to as [sut]).
|
||||
* The other gives us low level access to inject crafted TCP packets,
|
||||
* and sends and receives crafted packets to check the [sut] behavior.
|
||||
*)
|
||||
module VNETIF_STACK = Vnetif_common.VNETIF_STACK(Vnetif_backends.Basic)
|
||||
|
||||
module V = Vnetif.Make(Vnetif_backends.Basic)
|
||||
module E = Ethernet.Make(V)
|
||||
module A = Arp.Make(E)
|
||||
module I = Static_ipv4.Make(E)(A)
|
||||
module Wire = Tcp.Wire
|
||||
module WIRE = Wire.Make(I)
|
||||
module Tcp_wire = Tcp.Tcp_wire
|
||||
module Tcp_unmarshal = Tcp.Tcp_packet.Unmarshal
|
||||
module Sequence = Tcp.Sequence
|
||||
|
||||
let sut_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.101/24"
|
||||
let server_ip = Ipaddr.V4.of_string_exn "10.0.0.100"
|
||||
let server_cidr = Ipaddr.V4.Prefix.make 24 server_ip
|
||||
let gateway = Ipaddr.V4.of_string_exn "10.0.0.1"
|
||||
|
||||
let header_size = Ethernet.Packet.sizeof_ethernet
|
||||
|
||||
|
||||
|
||||
(* defaults when injecting packets *)
|
||||
let options = []
|
||||
let window = 5120
|
||||
|
||||
(* Helper functions *)
|
||||
let reply_id_from ~src ~dst data =
|
||||
let sport = Tcp_wire.get_src_port data in
|
||||
let dport = Tcp_wire.get_dst_port data in
|
||||
WIRE.v ~dst_port:sport ~dst:src ~src_port:dport ~src:dst
|
||||
|
||||
let ack_for data =
|
||||
match Tcp_unmarshal.of_cstruct data with
|
||||
| Error s -> Alcotest.fail ("attempting to ack data: " ^ s)
|
||||
| Ok (packet, data) ->
|
||||
let open Tcp.Tcp_packet in
|
||||
let data_len =
|
||||
Sequence.of_int ((Cstruct.length data) +
|
||||
(if packet.fin then 1 else 0) +
|
||||
(if packet.syn then 1 else 0)) in
|
||||
let sequence = packet.sequence in
|
||||
let ack_n = Sequence.(add sequence data_len) in
|
||||
ack_n
|
||||
|
||||
let ack data =
|
||||
Some(ack_for data)
|
||||
|
||||
let ack_in_future data off =
|
||||
Some Sequence.(add (ack_for data) (of_int off))
|
||||
|
||||
let ack_from_past data off =
|
||||
Some Sequence.(sub (ack_for data) (of_int off))
|
||||
|
||||
let fail_result_not_expected fail = function
|
||||
| Error _err ->
|
||||
fail "error not expected"
|
||||
| Ok `Eof ->
|
||||
fail "eof"
|
||||
| Ok (`Data data) ->
|
||||
Alcotest.fail (Format.asprintf "data not expected but received: %a"
|
||||
Cstruct.hexdump_pp data)
|
||||
|
||||
|
||||
|
||||
let create_sut_stack backend =
|
||||
VNETIF_STACK.create_stack ~cidr:sut_cidr ~gateway backend
|
||||
|
||||
let create_raw_stack backend =
|
||||
V.connect backend >>= fun netif ->
|
||||
E.connect netif >>= fun ethif ->
|
||||
A.connect ethif >>= fun arpv4 ->
|
||||
I.connect ~cidr:server_cidr ~gateway ethif arpv4 >>= fun ip ->
|
||||
Lwt.return (netif, ethif, arpv4, ip)
|
||||
|
||||
type 'state fsm_result =
|
||||
| Fsm_next of 'state
|
||||
| Fsm_done
|
||||
| Fsm_error of string
|
||||
|
||||
(* This could be moved to a common module and reused for other low level tcp tests *)
|
||||
|
||||
(* setups network and run a given sut and raw fsm *)
|
||||
let run backend fsm sut () =
|
||||
let initial_state, fsm_handler = fsm in
|
||||
create_sut_stack backend >>= fun stack ->
|
||||
create_raw_stack backend >>= fun (netif, ethif, arp, rawip) ->
|
||||
let error_mbox = Lwt_mvar.create_empty () in
|
||||
let stream, pushf = Lwt_stream.create () in
|
||||
Lwt.pick [
|
||||
VNETIF_STACK.Stack.listen stack;
|
||||
|
||||
(* Consume TCP packets one by one, in sequence *)
|
||||
let rec fsm_thread state =
|
||||
Lwt_stream.next stream >>= fun (src, dst, data) ->
|
||||
fsm_handler rawip state ~src ~dst data >>= function
|
||||
| Fsm_next s ->
|
||||
fsm_thread s
|
||||
| Fsm_done ->
|
||||
Lwt.return_unit
|
||||
| Fsm_error err ->
|
||||
Lwt_mvar.put error_mbox err >>= fun () ->
|
||||
(* it will be terminated anyway when the error is picked up *)
|
||||
fsm_thread state in
|
||||
|
||||
Lwt.async (fun () ->
|
||||
(V.listen netif ~header_size
|
||||
(E.input
|
||||
~arpv4:(A.input arp)
|
||||
~ipv4:(I.input
|
||||
~tcp: (fun ~src ~dst data -> pushf (Some(src,dst,data)); Lwt.return_unit)
|
||||
~udp:(fun ~src:_ ~dst:_ _data -> Lwt.return_unit)
|
||||
~default:(fun ~proto ~src ~dst _data ->
|
||||
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)
|
||||
rawip
|
||||
)
|
||||
~ipv6:(fun _buf ->
|
||||
Logs.debug (fun f -> f "IPv6 packet -- dropping");
|
||||
Lwt.return_unit)
|
||||
ethif) ) >|= fun _ -> ());
|
||||
|
||||
(* Either both fsm and the sut terminates, or a timeout occurs, or one of the sut/fsm informs an error *)
|
||||
Lwt.pick [
|
||||
(Mirage_sleep.ns (Duration.of_sec 5) >>= fun () ->
|
||||
Lwt.return_some "timed out");
|
||||
|
||||
(Lwt.join [
|
||||
(fsm_thread initial_state);
|
||||
|
||||
(* time to let the other end connects to the network and listen.
|
||||
* Otherwise initial syn might need to be repeated slowing down the test *)
|
||||
(Mirage_sleep.ns (Duration.of_ms 100) >>= fun () ->
|
||||
sut stack (Lwt_mvar.put error_mbox) >>= fun _ ->
|
||||
Mirage_sleep.ns (Duration.of_ms 100));
|
||||
] >>= fun () -> Lwt.return_none);
|
||||
|
||||
(Lwt_mvar.take error_mbox >>= fun cause ->
|
||||
Lwt.return_some cause);
|
||||
] >|= function
|
||||
| None -> ()
|
||||
| Some err -> Alcotest.fail err
|
||||
]
|
||||
6
unikernel/duniverse/mirage-tcpip/test/mock-clock/dune
Normal file
6
unikernel/duniverse/mirage-tcpip/test/mock-clock/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(test
|
||||
(name test_tcp_window)
|
||||
(libraries alcotest mirage-crypto-rng mirage-crypto-rng.unix lwt.unix logs logs.fmt
|
||||
mirage-mtime.mock tcpip.tcp)
|
||||
(action
|
||||
(run %{test} -q -e --color=always)))
|
||||
|
|
@ -0,0 +1,126 @@
|
|||
let default_window () =
|
||||
Tcp.Window.t ~tx_wnd_scale:2 ~rx_wnd_scale:2 ~rx_wnd:65535 ~tx_wnd:65535 ~rx_isn:Tcp.Sequence.zero ~tx_mss:1460 ~tx_isn:Tcp.Sequence.zero
|
||||
|
||||
let fresh_window () =
|
||||
let window = default_window () in
|
||||
Alcotest.(check bool) "should be no data in flight" false @@ Tcp.Window.tx_inflight window;
|
||||
Alcotest.(check bool) "no rexmits yet" false @@ Tcp.Window.max_rexmits_done window;
|
||||
Alcotest.(check int) "no traffic transferred yet" 0 @@ Tcp.Window.tx_totalbytes window;
|
||||
Alcotest.(check int) "no traffic received yet" 0 @@ Tcp.Window.rx_totalbytes window;
|
||||
Alcotest.(check int32) "should be able to send 65535 <<= 2 bytes" Int32.(mul 65535l 4l) @@ Tcp.Window.tx_wnd window;
|
||||
Alcotest.(check int32) "should be able to receive 65535 <<= 2 bytes" Int32.(mul 65535l 4l) @@ Tcp.Window.rx_wnd window;
|
||||
Alcotest.(check int64) "initial rto is 2/3 second" (Duration.of_ms 667) @@ Tcp.Window.rto window;
|
||||
Lwt.return_unit
|
||||
|
||||
let increase_congestion_window window goal =
|
||||
(* simulate a successful slow start, which primes the congestion window to be relatively large *)
|
||||
let receive_window = Tcp.Window.ack_win window in
|
||||
let rec successful_transmission goal =
|
||||
let max_send = Tcp.Window.tx_available window |> Tcp.Sequence.of_int32 in
|
||||
match Tcp.Sequence.geq max_send goal with
|
||||
| true -> max_send
|
||||
| false ->
|
||||
let sz = Tcp.Sequence.add max_send @@ Tcp.Window.tx_nxt window in
|
||||
Mirage_mtime_set.tick ();
|
||||
Tcp.Window.tx_advance window @@ Tcp.Window.tx_nxt window;
|
||||
Mirage_mtime_set.tick ();
|
||||
(* need to acknowledge the full size of the data *)
|
||||
Tcp.Window.tx_ack window sz receive_window;
|
||||
successful_transmission goal
|
||||
in
|
||||
successful_transmission goal
|
||||
|
||||
let n_segments window n =
|
||||
Int32.mul n @@ Int32.of_int @@ Tcp.Window.tx_mss window |> Tcp.Sequence.of_int32
|
||||
|
||||
(* attempt to ensure that fast recovery is working as described in rfc5681 *)
|
||||
let recover_fast () =
|
||||
let window = default_window () in
|
||||
let receive_window = Tcp.Window.ack_win window in
|
||||
Alcotest.(check bool) "don't start in fast recovery" false @@ Tcp.Window.fast_rec window;
|
||||
|
||||
(* get a large congestion window to avoid confounding factors *)
|
||||
let cwnd_goal = 262140l in
|
||||
let _ = increase_congestion_window window (Tcp.Sequence.of_int32 cwnd_goal) in
|
||||
let available_to_send = Tcp.Window.tx_available window in
|
||||
let big_enough x = Int32.compare x cwnd_goal > 0 in
|
||||
Alcotest.(check bool) "congestion window is big enough" true @@ big_enough available_to_send;
|
||||
|
||||
(* get ready to send another burst of data *)
|
||||
let seq = Tcp.Window.tx_nxt window in
|
||||
Mirage_mtime_set.tick ();
|
||||
(* say that we sent the full amount of data *)
|
||||
let sz = Tcp.Sequence.(add (of_int32 available_to_send) seq) in
|
||||
Tcp.Window.tx_advance window sz;
|
||||
(* but receive an ack indicating that we missed a segment *)
|
||||
let nonfull_ack = Tcp.Sequence.add seq @@ n_segments window 4l in
|
||||
(* 1st ack *)
|
||||
Mirage_mtime_set.tick ();
|
||||
Tcp.Window.tx_ack window nonfull_ack receive_window;
|
||||
(* 1st duplicate ack *)
|
||||
Mirage_mtime_set.tick ();
|
||||
Tcp.Window.tx_ack window nonfull_ack receive_window;
|
||||
(* 2nd duplicate ack *)
|
||||
Mirage_mtime_set.tick ();
|
||||
Tcp.Window.tx_ack window nonfull_ack receive_window;
|
||||
(* 3rd duplicate ack *)
|
||||
Mirage_mtime_set.tick ();
|
||||
Tcp.Window.tx_ack window nonfull_ack receive_window;
|
||||
(* request that we go into fast retransmission *)
|
||||
Tcp.Window.alert_fast_rexmit window @@ n_segments window 4l;
|
||||
|
||||
Alcotest.(check bool) "fast retransmit when we wanted it" true @@ Tcp.Window.fast_rec window;
|
||||
|
||||
Alcotest.(check bool) "once entering fast recovery, we can send >0 packets" true ((Int32.compare (Tcp.Window.tx_available window) 0l) > 0);
|
||||
|
||||
Lwt.return_unit
|
||||
|
||||
let rto_calculation () =
|
||||
let window = default_window () in
|
||||
(* RFC 2988 2.1 *)
|
||||
Alcotest.(check int64) "initial rto is 2/3 second" (Duration.of_ms 667) @@ Tcp.Window.rto window;
|
||||
let receive_window = Tcp.Window.ack_win window in
|
||||
Tcp.Window.tx_advance window (Tcp.Window.tx_nxt window);
|
||||
Mirage_mtime_set.tick_for (Duration.of_ms 400);
|
||||
let max_size = Tcp.Window.tx_available window |> Tcp.Sequence.of_int32 in
|
||||
let sz = Tcp.Sequence.add max_size @@ (Tcp.Window.tx_nxt window) in
|
||||
Tcp.Window.tx_ack window sz receive_window;
|
||||
(* RFC 2988 2.2 *)
|
||||
Alcotest.(check int64) "After one RTT measurement, the calculated rto is 400 + (4 * 200) = 1200ms" (Duration.of_ms 1200) @@ Tcp.Window.rto window;
|
||||
|
||||
(* RFC 2988 2.3 *)
|
||||
Tcp.Window.tx_advance window (Tcp.Window.tx_nxt window);
|
||||
let receive_window = Tcp.Window.ack_win window in
|
||||
Mirage_mtime_set.tick_for (Duration.of_ms 300);
|
||||
let max_size = Tcp.Window.tx_available window |> Tcp.Sequence.of_int32 in
|
||||
let sz = Tcp.Sequence.add max_size @@ (Tcp.Window.tx_nxt window) in
|
||||
Tcp.Window.tx_ack window sz receive_window;
|
||||
Alcotest.(check int64) "After subsequent RTT measurement, the calculated rto is 1087.5ms" (Duration.of_us 1087500) @@ Tcp.Window.rto window;
|
||||
|
||||
Lwt.return_unit
|
||||
|
||||
|
||||
let suite = [
|
||||
"fresh window is sensible", `Quick, fresh_window;
|
||||
"fast recovery recovers fast", `Quick, recover_fast;
|
||||
"smoothed rtt, rtt variation and retransmission timer are calculated according to RFC2988", `Quick, rto_calculation;
|
||||
]
|
||||
|
||||
let suite = [
|
||||
"tcp_window" , suite ;
|
||||
]
|
||||
|
||||
let run test () =
|
||||
Lwt_main.run (test ())
|
||||
|
||||
let () =
|
||||
Printexc.record_backtrace true;
|
||||
Mirage_crypto_rng_unix.use_default ();
|
||||
(* enable logging to stdout for all modules *)
|
||||
Logs.set_reporter (Logs_fmt.reporter ());
|
||||
Logs.set_level ~all:true (Some Logs.Debug);
|
||||
let suite = List.map (fun (n, s) ->
|
||||
n, List.map (fun (d, s, f) -> d, s, run f) s
|
||||
) suite
|
||||
in
|
||||
Alcotest.run "tcpip" suite
|
||||
48
unikernel/duniverse/mirage-tcpip/test/static_arp.ml
Normal file
48
unikernel/duniverse/mirage-tcpip/test/static_arp.ml
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
open Lwt.Infix
|
||||
|
||||
module Make(E : Ethernet.S) = struct
|
||||
module A = Arp.Make(E)
|
||||
(* generally repurpose A, but substitute input and query, and add functions
|
||||
for adding/deleting entries *)
|
||||
type error = A.error
|
||||
|
||||
type t = {
|
||||
base : A.t;
|
||||
table : (Ipaddr.V4.t, Macaddr.t) Hashtbl.t;
|
||||
}
|
||||
|
||||
let pp_error = A.pp_error
|
||||
let add_ip t = A.add_ip t.base
|
||||
let remove_ip t = A.remove_ip t.base
|
||||
let set_ips t = A.set_ips t.base
|
||||
let get_ips t = A.get_ips t.base
|
||||
|
||||
let pp ppf t =
|
||||
let print ip entry =
|
||||
Fmt.pf ppf "IP %a : MAC %a" Ipaddr.V4.pp ip Macaddr.pp entry
|
||||
in
|
||||
Hashtbl.iter print t.table
|
||||
|
||||
let connect e = A.connect e >>= fun base ->
|
||||
Lwt.return ({ base; table = (Hashtbl.create 7) })
|
||||
|
||||
let disconnect t = A.disconnect t.base
|
||||
|
||||
let query t ip =
|
||||
match Hashtbl.mem t.table ip with
|
||||
| false -> Lwt.return @@ Error `Timeout
|
||||
| true -> Lwt.return (Ok (Hashtbl.find t.table ip))
|
||||
|
||||
let input t buffer =
|
||||
(* disregard responses, but reply to queries *)
|
||||
let open Arp_packet in
|
||||
match decode buffer with
|
||||
| Ok arp when arp.operation = Request -> A.input t.base buffer
|
||||
| Ok _ -> Lwt.return_unit
|
||||
| Error e ->
|
||||
Format.printf "Arp decoding failed %a" pp_error e ;
|
||||
Lwt.return_unit
|
||||
|
||||
let add_entry t ip mac =
|
||||
Hashtbl.add t.table ip mac
|
||||
end
|
||||
62
unikernel/duniverse/mirage-tcpip/test/test.ml
Normal file
62
unikernel/duniverse/mirage-tcpip/test/test.ml
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
(*
|
||||
* Copyright (c) 2013 Thomas Gazagnaire <thomas@gazagnaire.org>
|
||||
*
|
||||
* 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 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 suite = [
|
||||
"checksums" , Test_checksums.suite ;
|
||||
"ipv4" , Test_ipv4.suite ;
|
||||
"ipv6" , Test_ipv6.suite ;
|
||||
"icmpv4" , Test_icmpv4.suite ;
|
||||
"udp" , Test_udp.suite ;
|
||||
"tcp_options" , Test_tcp_options.suite ;
|
||||
"mtu+tcp" , Test_mtus.suite ;
|
||||
"rfc5961" , Test_rfc5961.suite ;
|
||||
"socket" , Test_socket.suite ;
|
||||
"connect" , Test_connect.suite ;
|
||||
"connect_ipv6" , Test_connect_ipv6.suite ;
|
||||
"deadlock" , Test_deadlock.suite ;
|
||||
"iperf" , Test_iperf.suite ;
|
||||
"iperf_ipv6" , Test_iperf_ipv6.suite ;
|
||||
"keepalive" , Test_keepalive.suite ;
|
||||
"simultaneous_close", Test_simulatenous_close.suite
|
||||
]
|
||||
|
||||
let run test () =
|
||||
Lwt_main.run (test ())
|
||||
|
||||
let () =
|
||||
Printexc.record_backtrace true;
|
||||
Mirage_crypto_rng_unix.use_default ();
|
||||
(* enable logging to stdout for all modules *)
|
||||
Logs.set_reporter (Logs_fmt.reporter ());
|
||||
Logs.set_level ~all:true (Some Logs.Debug);
|
||||
let suite = List.map (fun (n, s) ->
|
||||
n, List.map (fun (d, s, f) -> d, s, run f) s
|
||||
) suite
|
||||
in
|
||||
let filter ~name ~index =
|
||||
(* Lwt_bytes (as of 5.5.0) on Windows doesn't support UDP. *)
|
||||
let skip = [
|
||||
3 (* no_leak_fds_in_udpv4 *);
|
||||
5 (* no_leak_fds_in_udpv6 *);
|
||||
7 (* no_leak_fds_in_udpv4v6 *);
|
||||
9 (* no_leak_fds_in_udpv4v6_2 *);
|
||||
11 (* no_leak_fds_in_udpv4v6_3 *);
|
||||
13 (* no_leak_fds_in_udpv4v6_4 *);
|
||||
15 (* no_leak_fds_in_udpv4v6_5 *);
|
||||
] in
|
||||
if Sys.win32 && name = "socket" && List.mem index skip then `Skip else `Run
|
||||
in
|
||||
Alcotest.run "tcpip" suite ~filter
|
||||
98
unikernel/duniverse/mirage-tcpip/test/test_checksums.ml
Normal file
98
unikernel/duniverse/mirage-tcpip/test/test_checksums.ml
Normal file
|
|
@ -0,0 +1,98 @@
|
|||
let unwrap_ipv4 buf = Ipv4_packet.Unmarshal.of_cstruct buf |> Result.get_ok
|
||||
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.length 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_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 udp_ipv4_zero_checksum () =
|
||||
let src = Ipaddr.V4.make 127 0 0 1 in
|
||||
let dst = src in
|
||||
let proto = `UDP in
|
||||
let ttl = 38 in
|
||||
let options = Cstruct.empty in
|
||||
let payload = Cstruct.of_hex "01 84" in
|
||||
let payload_len = Cstruct.length payload in
|
||||
let ipv4_header = Ipv4_packet.{
|
||||
src; dst;
|
||||
proto = Ipv4_packet.Marshal.protocol_to_int proto;
|
||||
ttl; id = 0 ; off = 0 ; options } in
|
||||
let pseudoheader = Ipv4_packet.Marshal.pseudoheader
|
||||
~src
|
||||
~dst
|
||||
~proto
|
||||
(payload_len + 8) in
|
||||
let packet = Cstruct.concat [
|
||||
Ipv4_packet.Marshal.make_cstruct ~payload_len:(payload_len + 8) ipv4_header;
|
||||
Udp_packet.Marshal.make_cstruct ~pseudoheader ~payload
|
||||
{ src_port = 42; dst_port = 42 };
|
||||
payload] in
|
||||
let (_ipv4_header', transport_packet) = unwrap_ipv4 packet in
|
||||
|
||||
Alcotest.(check bool) "UDP packets with zero checksums pass verification"
|
||||
true @@ verify_ipv4_udp ~ipv4_header ~transport_packet;
|
||||
|
||||
Cstruct.set_char transport_packet (Cstruct.length transport_packet - 1) '\000';
|
||||
Alcotest.(check bool) "Corrupted UDP packets with zero checksum fail verification"
|
||||
false @@ 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.length 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 but zero UDP IPV4 checksums are recognized", `Quick, udp_ipv4_zero_checksum;
|
||||
"correct TCP IPV4 checksums are recognized", `Quick, tcp_ipv4_correct_positive;
|
||||
"incorrect TCP IPV4 checksums are recognized", `Quick, tcp_ipv4_correct_negative;
|
||||
]
|
||||
128
unikernel/duniverse/mirage-tcpip/test/test_connect.ml
Normal file
128
unikernel/duniverse/mirage-tcpip/test/test_connect.ml
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
(*
|
||||
* Copyright (c) 2015 Magnus Skjegstad <magnus@skjegstad.com>
|
||||
*
|
||||
* 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 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.
|
||||
*)
|
||||
|
||||
open Common
|
||||
open Vnetif_common
|
||||
|
||||
let (>>=) = Lwt.(>>=)
|
||||
|
||||
let src = Logs.Src.create "test_connect" ~doc:"connect tests"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
module Test_connect (B : Vnetif_backends.Backend) = struct
|
||||
module V = VNETIF_STACK (B)
|
||||
|
||||
let gateway = Ipaddr.V4.of_string_exn "10.0.0.1"
|
||||
let client_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.101/24"
|
||||
let server_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.100/24"
|
||||
let test_string = "Hello world from Mirage 123456789...."
|
||||
let backend = V.create_backend ()
|
||||
|
||||
let err_read_eof () = failf "accept got EOF while reading"
|
||||
let err_write_eof () = failf "client tried to write, got EOF"
|
||||
|
||||
let err_read e =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_error e in
|
||||
failf "Error while reading: %s" err
|
||||
|
||||
let err_write e =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_write_error e in
|
||||
failf "client tried to write, got %s" err
|
||||
|
||||
let accept flow expected =
|
||||
let ip, port = V.Stack.TCP.dst flow in
|
||||
Log.debug (fun f -> f "Accepted connection from %s:%d" (Ipaddr.to_string ip) port);
|
||||
V.Stack.TCP.read flow >>= function
|
||||
| Error e -> err_read e
|
||||
| Ok `Eof -> err_read_eof ()
|
||||
| Ok (`Data b) ->
|
||||
Lwt_unix.sleep 0.1 >>= fun () ->
|
||||
(* sleep first to capture data in pcap *)
|
||||
Alcotest.(check string) "accept" expected (Cstruct.to_string b);
|
||||
Log.debug (fun f -> f "Connection closed");
|
||||
Lwt.return_unit
|
||||
|
||||
let test_tcp_connect_two_stacks () =
|
||||
let timeout = 15.0 in
|
||||
Lwt.pick [
|
||||
(Lwt_unix.sleep timeout >>= fun () ->
|
||||
failf "connect test timedout after %f seconds" timeout) ;
|
||||
|
||||
(V.create_stack ~cidr:server_cidr ~gateway backend >>= fun s1 ->
|
||||
V.Stack.TCP.listen (V.Stack.tcp s1) ~port:80 (fun f -> accept f test_string);
|
||||
V.Stack.listen s1) ;
|
||||
|
||||
(Lwt_unix.sleep 0.1 >>= fun () ->
|
||||
V.create_stack ~cidr:client_cidr ~gateway backend >>= fun s2 ->
|
||||
Lwt.pick [
|
||||
V.Stack.listen s2;
|
||||
(let conn = V.Stack.TCP.create_connection (V.Stack.tcp s2) in
|
||||
or_error "connect" conn (Ipaddr.V4 (Ipaddr.V4.Prefix.address server_cidr), 80) >>= fun flow ->
|
||||
Log.debug (fun f -> f "Connected to other end...");
|
||||
|
||||
V.Stack.TCP.write flow (Cstruct.of_string test_string) >>= function
|
||||
| Error `Closed -> err_write_eof ()
|
||||
| Error e -> err_write e
|
||||
| Ok () ->
|
||||
Log.debug (fun f -> f "wrote hello world");
|
||||
V.Stack.TCP.close flow >>= fun () ->
|
||||
Lwt_unix.sleep 1.0 >>= fun () -> (* record some traffic after close *)
|
||||
Lwt.return_unit)]) ] >>= fun () ->
|
||||
|
||||
Lwt.return_unit
|
||||
|
||||
let record_pcap =
|
||||
V.record_pcap backend
|
||||
|
||||
end
|
||||
|
||||
let test_tcp_connect_two_stacks_basic () =
|
||||
let module Test = Test_connect(Vnetif_backends.Basic) in
|
||||
Test.record_pcap
|
||||
"tcp_connect_two_stacks_basic.pcap"
|
||||
Test.test_tcp_connect_two_stacks
|
||||
|
||||
let test_tcp_connect_two_stacks_x100_uniform_no_payload_packet_loss () =
|
||||
let rec loop = function
|
||||
| 0 -> Lwt.return_unit
|
||||
| n -> Log.info (fun f -> f "%d/100" (101-n));
|
||||
let module Test = Test_connect(Vnetif_backends.Uniform_no_payload_packet_loss) in
|
||||
Test.record_pcap
|
||||
(Printf.sprintf
|
||||
"tcp_connect_two_stacks_no_payload_packet_loss_%d_of_100.pcap" n)
|
||||
Test.test_tcp_connect_two_stacks >>= fun () ->
|
||||
loop (n - 1)
|
||||
in
|
||||
loop 100
|
||||
|
||||
let test_tcp_connect_two_stacks_trailing_bytes () =
|
||||
let module Test = Test_connect(Vnetif_backends.Trailing_bytes) in
|
||||
Test.record_pcap
|
||||
"tcp_connect_two_stacks_trailing_bytes.pcap"
|
||||
Test.test_tcp_connect_two_stacks
|
||||
|
||||
let suite = [
|
||||
|
||||
"connect two stacks, basic test", `Quick,
|
||||
test_tcp_connect_two_stacks_basic;
|
||||
|
||||
"connect two stacks, uniform packet loss of packets with no payload x 100", `Slow,
|
||||
test_tcp_connect_two_stacks_x100_uniform_no_payload_packet_loss;
|
||||
|
||||
"connect two stacks, with trailing bytes", `Quick,
|
||||
test_tcp_connect_two_stacks_trailing_bytes;
|
||||
|
||||
]
|
||||
131
unikernel/duniverse/mirage-tcpip/test/test_connect_ipv6.ml
Normal file
131
unikernel/duniverse/mirage-tcpip/test/test_connect_ipv6.ml
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
(*
|
||||
* Copyright (c) 2015 Magnus Skjegstad <magnus@skjegstad.com>
|
||||
*
|
||||
* 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 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.
|
||||
*)
|
||||
|
||||
open Common
|
||||
open Vnetif_common
|
||||
|
||||
let (>>=) = Lwt.(>>=)
|
||||
|
||||
let src = Logs.Src.create "test_connect" ~doc:"connect tests"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
module Test_connect_ipv6 (B : Vnetif_backends.Backend) = struct
|
||||
module V = VNETIF_STACK (B)
|
||||
|
||||
let client_address = Ipaddr.V6.of_string_exn "fc00::23"
|
||||
let client_cidr = Ipaddr.V6.Prefix.make 64 client_address
|
||||
let server_address = Ipaddr.V6.of_string_exn "fc00::45"
|
||||
let server_cidr = Ipaddr.V6.Prefix.make 64 server_address
|
||||
let test_string = "Hello world from Mirage 123456789...."
|
||||
let backend = V.create_backend ()
|
||||
|
||||
let err_read_eof () = failf "accept got EOF while reading"
|
||||
let err_write_eof () = failf "client tried to write, got EOF"
|
||||
|
||||
let err_read e =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_error e in
|
||||
failf "Error while reading: %s" err
|
||||
|
||||
let err_write e =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_write_error e in
|
||||
failf "client tried to write, got %s" err
|
||||
|
||||
let accept flow expected =
|
||||
let ip, port = V.Stack.TCP.dst flow in
|
||||
Log.debug (fun f -> f "Accepted connection from %s:%d" (Ipaddr.to_string ip) port);
|
||||
V.Stack.TCP.read flow >>= function
|
||||
| Error e -> err_read e
|
||||
| Ok `Eof -> err_read_eof ()
|
||||
| Ok (`Data b) ->
|
||||
Lwt_unix.sleep 0.1 >>= fun () ->
|
||||
(* sleep first to capture data in pcap *)
|
||||
Alcotest.(check string) "accept" expected (Cstruct.to_string b);
|
||||
Log.debug (fun f -> f "Connection closed");
|
||||
Lwt.return_unit
|
||||
|
||||
let cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.2/24"
|
||||
|
||||
let test_tcp_connect_two_stacks () =
|
||||
let timeout = 15.0 in
|
||||
Lwt.pick [
|
||||
(Lwt_unix.sleep timeout >>= fun () ->
|
||||
failf "connect test timedout after %f seconds" timeout) ;
|
||||
|
||||
(V.create_stack ~cidr ~cidr6:server_cidr backend >>= fun s1 ->
|
||||
V.Stack.TCP.listen (V.Stack.tcp s1) ~port:80 (fun f -> accept f test_string);
|
||||
V.Stack.listen s1) ;
|
||||
|
||||
(Lwt_unix.sleep 0.1 >>= fun () ->
|
||||
V.create_stack ~cidr ~cidr6:client_cidr backend >>= fun s2 ->
|
||||
Lwt.pick [
|
||||
V.Stack.listen s2;
|
||||
(let conn = V.Stack.TCP.create_connection (V.Stack.tcp s2) in
|
||||
or_error "connect" conn (Ipaddr.V6 server_address, 80) >>= fun flow ->
|
||||
Log.debug (fun f -> f "Connected to other end...");
|
||||
|
||||
V.Stack.TCP.write flow (Cstruct.of_string test_string) >>= function
|
||||
| Error `Closed -> err_write_eof ()
|
||||
| Error e -> err_write e
|
||||
| Ok () ->
|
||||
Log.debug (fun f -> f "wrote hello world");
|
||||
V.Stack.TCP.close flow >>= fun () ->
|
||||
Lwt_unix.sleep 1.0 >>= fun () -> (* record some traffic after close *)
|
||||
Lwt.return_unit)]) ] >>= fun () ->
|
||||
|
||||
Lwt.return_unit
|
||||
|
||||
let record_pcap =
|
||||
V.record_pcap backend
|
||||
|
||||
end
|
||||
|
||||
let test_tcp_connect_two_stacks_basic () =
|
||||
let module Test = Test_connect_ipv6(Vnetif_backends.Basic) in
|
||||
Test.record_pcap
|
||||
"tcp_connect_ipv6_two_stacks_basic.pcap"
|
||||
Test.test_tcp_connect_two_stacks
|
||||
|
||||
let test_tcp_connect_two_stacks_x100_uniform_no_payload_packet_loss () =
|
||||
let rec loop = function
|
||||
| 0 -> Lwt.return_unit
|
||||
| n -> Log.info (fun f -> f "%d/100" (101-n));
|
||||
let module Test = Test_connect_ipv6(Vnetif_backends.Uniform_no_payload_packet_loss) in
|
||||
Test.record_pcap
|
||||
(Printf.sprintf
|
||||
"tcp_connect_ipv6_two_stacks_no_payload_packet_loss_%d_of_100.pcap" n)
|
||||
Test.test_tcp_connect_two_stacks >>= fun () ->
|
||||
loop (n - 1)
|
||||
in
|
||||
loop 100
|
||||
|
||||
let test_tcp_connect_two_stacks_trailing_bytes () =
|
||||
let module Test = Test_connect_ipv6(Vnetif_backends.Trailing_bytes) in
|
||||
Test.record_pcap
|
||||
"tcp_connect_ipv6_two_stacks_trailing_bytes.pcap"
|
||||
Test.test_tcp_connect_two_stacks
|
||||
|
||||
let suite = [
|
||||
|
||||
"connect two stacks, basic test", `Quick,
|
||||
test_tcp_connect_two_stacks_basic;
|
||||
|
||||
"connect two stacks, uniform packet loss of packets with no payload x 100", `Slow,
|
||||
test_tcp_connect_two_stacks_x100_uniform_no_payload_packet_loss;
|
||||
|
||||
"connect two stacks, with trailing bytes", `Quick,
|
||||
test_tcp_connect_two_stacks_trailing_bytes;
|
||||
|
||||
]
|
||||
149
unikernel/duniverse/mirage-tcpip/test/test_deadlock.ml
Normal file
149
unikernel/duniverse/mirage-tcpip/test/test_deadlock.ml
Normal file
|
|
@ -0,0 +1,149 @@
|
|||
open Lwt.Infix
|
||||
|
||||
let mtu = 4000
|
||||
|
||||
let server_log = Logs.Src.create "test_deadlock_server" ~doc:"tcp deadlock tests: server"
|
||||
module Server_log = (val Logs.src_log server_log : Logs.LOG)
|
||||
|
||||
let client_log = Logs.Src.create "test_deadlock_client" ~doc:"tcp deadlock tests: client"
|
||||
module Client_log = (val Logs.src_log client_log : Logs.LOG)
|
||||
|
||||
module TCPIP =
|
||||
struct
|
||||
module RANDOM = Mirage_crypto_rng
|
||||
|
||||
module M =
|
||||
struct
|
||||
module B = Basic_backend.Make
|
||||
module NETIF = Vnetif.Make(B)
|
||||
module ETHIF = Ethernet.Make(NETIF)
|
||||
module ARPV4 = Arp.Make(ETHIF)
|
||||
module IPV4 = Static_ipv4.Make(ETHIF)(ARPV4)
|
||||
module IPV6 = Ipv6.Make(NETIF)(ETHIF)
|
||||
module IP = Tcpip_stack_direct.IPV4V6(IPV4)(IPV6)
|
||||
module ICMPV4 = Icmpv4.Make(IPV4)
|
||||
module UDP = Udp.Make(IP)
|
||||
module TCP = Tcp.Flow.Make(IP)
|
||||
module TCPIP = Tcpip_stack_direct.MakeV4V6(NETIF)(ETHIF)(ARPV4)(IP)(ICMPV4)(UDP)(TCP)
|
||||
end
|
||||
open M
|
||||
|
||||
type stack = TCPIP.t
|
||||
|
||||
let server_ip = Ipaddr.V4.of_string_exn "192.168.10.10"
|
||||
let server_cidr = Ipaddr.V4.Prefix.make 24 server_ip
|
||||
let client_ip = Ipaddr.V4.of_string_exn "192.168.10.20"
|
||||
let client_cidr = Ipaddr.V4.Prefix.make 24 client_ip
|
||||
|
||||
let make ~cidr ?gateway netif =
|
||||
ETHIF.connect netif >>= fun ethif ->
|
||||
ARPV4.connect ethif >>= fun arpv4 ->
|
||||
IPV4.connect ~cidr ?gateway ethif arpv4 >>= fun ipv4 ->
|
||||
IPV6.connect netif ethif >>= fun ipv6 ->
|
||||
IP.connect ~ipv4_only:false ~ipv6_only:false ipv4 ipv6 >>= fun ip ->
|
||||
ICMPV4.connect ipv4 >>= fun icmpv4 ->
|
||||
UDP.connect ip >>= fun udp ->
|
||||
TCP.connect ip >>= fun tcp ->
|
||||
TCPIP.connect netif ethif arpv4 ip icmpv4 udp tcp >>= fun tcpip ->
|
||||
Lwt.return tcpip
|
||||
|
||||
include TCPIP
|
||||
|
||||
let tcpip t = t
|
||||
|
||||
let make role netif = match role with
|
||||
| `Server -> make ~cidr:server_cidr netif
|
||||
| `Client -> make ~cidr:client_cidr netif
|
||||
|
||||
type conn = M.NETIF.t
|
||||
|
||||
let get_stats _t =
|
||||
{ Mirage_net.rx_pkts = 0l; rx_bytes = 0L;
|
||||
tx_pkts = 0l; tx_bytes = 0L;
|
||||
}
|
||||
|
||||
let reset_stats _t = ()
|
||||
end
|
||||
|
||||
let port = 10000
|
||||
|
||||
let test_digest netif1 netif2 =
|
||||
TCPIP.make `Client netif1 >>= fun client_stack ->
|
||||
TCPIP.make `Server netif2 >>= fun server_stack ->
|
||||
|
||||
let send_data () =
|
||||
let data = Mirage_crypto_rng.generate 100_000_000 in
|
||||
let t0 = Unix.gettimeofday () in
|
||||
TCPIP.TCP.create_connection
|
||||
TCPIP.(tcp @@ tcpip server_stack) (Ipaddr.V4 TCPIP.client_ip, port) >>= function
|
||||
| Error _ -> failwith "could not establish tunneled connection"
|
||||
| Ok flow ->
|
||||
Server_log.debug (fun f -> f "established conn");
|
||||
let rec read_digest chunks =
|
||||
TCPIP.TCP.read flow >>= function
|
||||
| Error _ -> failwith "read error"
|
||||
| Ok (`Data data) -> read_digest (data :: chunks)
|
||||
| Ok `Eof ->
|
||||
Server_log.debug (fun f -> f "EOF");
|
||||
let dt = Unix.gettimeofday () -. t0 in
|
||||
Server_log.warn (fun f -> f "!!!!!!!!!! XXXX needed %.2fs (%.1f MB/s)"
|
||||
dt (float (String.length data) /. dt /. 1024. ** 2.));
|
||||
Lwt.return_unit
|
||||
in
|
||||
Lwt.pick
|
||||
[ read_digest [];
|
||||
begin
|
||||
let rec send_data data =
|
||||
if Cstruct.length data < mtu then
|
||||
(TCPIP.TCP.write flow data >>= fun _ -> Lwt.return_unit)
|
||||
else
|
||||
let sub, data = Cstruct.split data mtu in
|
||||
Lwt.pick
|
||||
[
|
||||
(TCPIP.TCP.write flow sub >>= fun _ -> Lwt.return_unit);
|
||||
(Lwt_unix.sleep 5. >>= fun () ->
|
||||
Common.failf "=========== DEADLOCK!!! =============");
|
||||
]
|
||||
>>= fun () ->
|
||||
send_data data in
|
||||
send_data @@ Cstruct.of_string data >>= fun () ->
|
||||
Server_log.debug (fun f -> f "wrote data");
|
||||
TCPIP.TCP.close flow
|
||||
end
|
||||
]
|
||||
in
|
||||
TCPIP.TCP.listen TCPIP.(tcp (tcpip client_stack)) ~port
|
||||
(fun flow ->
|
||||
Client_log.debug (fun f -> f "client got conn");
|
||||
let rec consume () =
|
||||
TCPIP.TCP.read flow >>= function
|
||||
| Error _ ->
|
||||
Client_log.debug (fun f -> f "XXXX client read error");
|
||||
TCPIP.TCP.close flow
|
||||
| Ok `Eof ->
|
||||
TCPIP.TCP.write flow @@ Cstruct.of_string "thanks for all the fish"
|
||||
>>= fun _ ->
|
||||
TCPIP.TCP.close flow
|
||||
| Ok (`Data _data) ->
|
||||
(if Random.float 1.0 < 0.01 then Lwt_unix.sleep 0.01
|
||||
else Lwt.return_unit) >>= fun () ->
|
||||
consume ()
|
||||
in
|
||||
consume ());
|
||||
Lwt.pick
|
||||
[
|
||||
send_data ();
|
||||
TCPIP.listen @@ TCPIP.tcpip server_stack;
|
||||
TCPIP.listen @@ TCPIP.tcpip client_stack;
|
||||
]
|
||||
|
||||
let run_vnetif () =
|
||||
let backend = Basic_backend.Make.create
|
||||
~use_async_readers:true ~yield:Lwt.pause () in
|
||||
TCPIP.M.NETIF.connect ~size_limit:mtu backend >>= fun c1 ->
|
||||
TCPIP.M.NETIF.connect ~size_limit:mtu backend >>= fun c2 ->
|
||||
test_digest c1 c2
|
||||
|
||||
let suite = [
|
||||
"test tcp deadlock with slow receiver", `Slow, run_vnetif
|
||||
]
|
||||
227
unikernel/duniverse/mirage-tcpip/test/test_icmpv4.ml
Normal file
227
unikernel/duniverse/mirage-tcpip/test/test_icmpv4.ml
Normal file
|
|
@ -0,0 +1,227 @@
|
|||
open Common
|
||||
|
||||
let src = Logs.Src.create "test_icmpv4" ~doc:"ICMP tests"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
module B = Basic_backend.Make
|
||||
module V = Vnetif.Make(B)
|
||||
module E = Ethernet.Make(V)
|
||||
module Static_arp = Static_arp.Make(E)
|
||||
|
||||
open Lwt.Infix
|
||||
|
||||
type decomposed = {
|
||||
ipv4_payload : Cstruct.t;
|
||||
ipv4_header : Ipv4_packet.t;
|
||||
ethernet_payload : Cstruct.t;
|
||||
ethernet_header : Ethernet.Packet.t;
|
||||
}
|
||||
|
||||
module Ip = Static_ipv4.Make(E)(Static_arp)
|
||||
module Icmp = Icmpv4.Make(Ip)
|
||||
|
||||
module Udp = Udp.Make(Ip)
|
||||
|
||||
type stack = {
|
||||
backend : B.t;
|
||||
netif : V.t;
|
||||
ethif : E.t;
|
||||
arp : Static_arp.t;
|
||||
ip : Ip.t;
|
||||
icmp : Icmp.t;
|
||||
udp : Udp.t;
|
||||
}
|
||||
|
||||
let testbind x y =
|
||||
match x with
|
||||
| Ok p -> y p
|
||||
| Error s -> Alcotest.fail s
|
||||
let (>>=?) = testbind
|
||||
|
||||
(* some default addresses which will be on the same class C *)
|
||||
let listener_address = Ipaddr.V4.of_string_exn "192.168.222.1"
|
||||
let speaker_address = Ipaddr.V4.of_string_exn "192.168.222.10"
|
||||
|
||||
let header_size = Ethernet.Packet.sizeof_ethernet
|
||||
|
||||
let get_stack ?(backend = B.create ~use_async_readers:true
|
||||
~yield:(fun() -> Lwt.pause ()) ())
|
||||
ip =
|
||||
let cidr = Ipaddr.V4.Prefix.make 24 ip in
|
||||
V.connect backend >>= fun netif ->
|
||||
E.connect netif >>= fun ethif ->
|
||||
Static_arp.connect ethif >>= fun arp ->
|
||||
Ip.connect ~cidr ethif arp >>= fun ip ->
|
||||
Icmp.connect ip >>= fun icmp ->
|
||||
Udp.connect ip >>= fun udp ->
|
||||
Lwt.return { backend; netif; ethif; arp; ip; icmp; udp }
|
||||
|
||||
let icmp_listen stack fn =
|
||||
let noop = fun ~src:_ ~dst:_ _buf -> Lwt.return_unit in
|
||||
V.listen stack.netif ~header_size (* some buffer -> (unit, error) result io *)
|
||||
( E.input stack.ethif ~arpv4:(Static_arp.input stack.arp)
|
||||
~ipv6:(fun _ -> Lwt.return_unit)
|
||||
~ipv4:
|
||||
( Ip.input stack.ip
|
||||
~tcp:noop ~udp:noop
|
||||
~default:(fun ~proto -> match proto with | 1 -> fn | _ -> noop))) >|= fun _ -> ()
|
||||
|
||||
|
||||
let inform_arp stack = Static_arp.add_entry stack.arp
|
||||
let mac_of_stack stack = E.mac stack.ethif
|
||||
|
||||
let short_read () =
|
||||
let too_short = Cstruct.create 4 in
|
||||
match Icmpv4_packet.Unmarshal.of_cstruct too_short with
|
||||
| Ok (icmp, _) ->
|
||||
Alcotest.fail (Format.asprintf "processed something too short to be real: %a produced %a"
|
||||
Cstruct.hexdump_pp too_short Icmpv4_packet.pp icmp)
|
||||
| Error str -> Printf.printf "short packet rejected successfully! msg: %s\n" str;
|
||||
Lwt.return_unit
|
||||
|
||||
let echo_request () =
|
||||
let seq_no = 0x01 in
|
||||
let id_no = 0x1234 in
|
||||
let request_payload = Cstruct.of_string "plz reply i'm so lonely" in
|
||||
get_stack speaker_address >>= fun speaker ->
|
||||
get_stack ~backend:speaker.backend listener_address >>= fun listener ->
|
||||
inform_arp speaker listener_address (mac_of_stack listener);
|
||||
inform_arp listener speaker_address (mac_of_stack speaker);
|
||||
let req = Icmpv4_packet.({code = 0x00; ty = Icmpv4_wire.Echo_request;
|
||||
subheader = Id_and_seq (id_no, seq_no)}) in
|
||||
let echo_request = Cstruct.create 2048 in
|
||||
Icmpv4_packet.Marshal.into_cstruct req echo_request ~payload:request_payload >>=? fun () ->
|
||||
Cstruct.blit request_payload 0 echo_request (Icmpv4_wire.sizeof_icmpv4) (Cstruct.length request_payload);
|
||||
let echo_request = Cstruct.sub echo_request 0 (Icmpv4_wire.sizeof_icmpv4 + Cstruct.length request_payload) in
|
||||
let check buf =
|
||||
let open Icmpv4_packet in
|
||||
Log.debug (fun f -> f "Incoming ICMP message: %a" Cstruct.hexdump_pp buf);
|
||||
Cstruct.hexdump buf;
|
||||
Unmarshal.of_cstruct buf >>=? fun (reply, payload) ->
|
||||
match reply.subheader with
|
||||
| Next_hop_mtu _ | Pointer _ | Address _ | Unused ->
|
||||
Alcotest.fail "received an ICMP message which wasn't an echo-request or reply"
|
||||
| Id_and_seq (id, seq) ->
|
||||
Alcotest.(check int) "icmp response type" 0x00 (Icmpv4_wire.ty_to_int reply.ty); (* expect an icmp echo reply *)
|
||||
Alcotest.(check int) "icmp echo-reply code" 0x00 reply.code; (* should be code 0 *)
|
||||
Alcotest.(check int) "icmp echo-reply id" id_no id;
|
||||
Alcotest.(check int) "icmp echo-reply seq" seq_no seq;
|
||||
Alcotest.(check cstruct) "icmp echo-reply payload" payload request_payload;
|
||||
Lwt.return_unit
|
||||
in
|
||||
Lwt.async (fun () -> Lwt.pick [
|
||||
icmp_listen listener (fun ~src ~dst buf ->
|
||||
Logs.debug (fun f -> f "listener's ICMP listener invoked");
|
||||
Icmp.input listener.icmp ~src ~dst buf);
|
||||
icmp_listen speaker (fun ~src:_ ~dst:_ -> check)
|
||||
]);
|
||||
Icmp.write speaker.icmp ~dst:listener_address echo_request >>= function
|
||||
| Error e -> Alcotest.failf "ICMP echo request write: %a" Icmp.pp_error e
|
||||
| Ok () -> Lwt.return_unit
|
||||
|
||||
let echo_silent () =
|
||||
let open Icmpv4_packet in
|
||||
get_stack speaker_address >>= fun speaker ->
|
||||
get_stack ~backend:speaker.backend listener_address >>= fun listener ->
|
||||
let req = ({code = 0x00; ty = Icmpv4_wire.Echo_request;
|
||||
subheader = Id_and_seq (0xff, 0x4341)}) in
|
||||
let echo_request = Marshal.make_cstruct req ~payload:Cstruct.(create 0) in
|
||||
let check buf =
|
||||
Unmarshal.of_cstruct buf >>=? fun (message, _) ->
|
||||
match message.ty with
|
||||
| Icmpv4_wire.Echo_reply ->
|
||||
Alcotest.fail "received an ICMP echo reply even though we shouldn't have"
|
||||
| msg_ty ->
|
||||
Printf.printf "received an unexpected ICMP message (type %s); ignoring it"
|
||||
(Icmpv4_wire.ty_to_string msg_ty);
|
||||
Lwt.return_unit
|
||||
in
|
||||
let nobody_home = Ipaddr.V4.of_string_exn "192.168.222.90" in
|
||||
inform_arp speaker listener_address (mac_of_stack listener);
|
||||
inform_arp listener speaker_address (mac_of_stack speaker);
|
||||
(* set up an ARP mapping so the listener is more likely to see the echo-request *)
|
||||
inform_arp speaker nobody_home (mac_of_stack listener);
|
||||
Lwt.async (fun () ->
|
||||
Lwt.pick [
|
||||
icmp_listen listener (fun ~src ~dst buf -> Icmp.input listener.icmp ~src ~dst buf);
|
||||
icmp_listen speaker (fun ~src:_ ~dst:_ -> check);
|
||||
]);
|
||||
Icmp.write speaker.icmp ~dst:nobody_home echo_request >>= function
|
||||
| Error e -> Alcotest.failf "ICMP echo request write: %a" Icmp.pp_error e
|
||||
| Ok () -> Lwt.return_unit
|
||||
|
||||
let write_errors () =
|
||||
let decompose buf =
|
||||
let open Ethernet.Packet in
|
||||
let* ethernet_header, ethernet_payload = of_cstruct buf in
|
||||
match ethernet_header.ethertype with
|
||||
| `IPv6 | `ARP -> Error "not an ipv4 packet"
|
||||
| `IPv4 ->
|
||||
let* ipv4_header, ipv4_payload =
|
||||
Ipv4_packet.Unmarshal.of_cstruct ethernet_payload
|
||||
in
|
||||
Ok { ethernet_header; ethernet_payload; ipv4_header; ipv4_payload }
|
||||
in
|
||||
(* for any incoming packet, reject it with would_fragment *)
|
||||
let reject_all stack =
|
||||
let reject buf =
|
||||
match decompose buf with
|
||||
| Error s -> Alcotest.fail s
|
||||
| Ok decomposed ->
|
||||
let reply = Icmpv4_packet.({
|
||||
ty = Icmpv4_wire.Destination_unreachable;
|
||||
code = Icmpv4_wire.(unreachable_reason_to_int Would_fragment);
|
||||
subheader = Next_hop_mtu 576;
|
||||
}) in
|
||||
let header = Icmpv4_packet.Marshal.make_cstruct reply
|
||||
~payload:decomposed.ethernet_payload in
|
||||
let header_and_payload = Cstruct.concat ([header ; decomposed.ethernet_payload]) in
|
||||
let open Ipv4_packet in
|
||||
Icmp.write stack.icmp ~dst:decomposed.ipv4_header.src header_and_payload >|= Result.get_ok
|
||||
in
|
||||
V.listen stack.netif ~header_size reject >|= fun _ -> ()
|
||||
in
|
||||
let check_packet buf : unit Lwt.t =
|
||||
let aux buf =
|
||||
let open Icmpv4_packet in
|
||||
let* icmp, icmp_payload = Unmarshal.of_cstruct buf in
|
||||
Alcotest.check Alcotest.int "ICMP message type" 0x03 (Icmpv4_wire.ty_to_int icmp.ty);
|
||||
Alcotest.check Alcotest.int "ICMP message code" 0x04 icmp.code;
|
||||
match Cstruct.length icmp_payload with
|
||||
| 0 -> Alcotest.fail "Error message should've had a payload"
|
||||
| _n ->
|
||||
(* TODO: packet should have an IP header in it *)
|
||||
Alcotest.(check int) "Payload first byte" 0x45 (Cstruct.get_uint8 icmp_payload 0);
|
||||
Ok ()
|
||||
in
|
||||
match aux buf with
|
||||
| Error s -> Alcotest.fail s
|
||||
| Ok () -> Lwt.return_unit
|
||||
in
|
||||
let check_rejection stack dst =
|
||||
let payload = Cstruct.of_string "!@#$" in
|
||||
Lwt.pick [
|
||||
icmp_listen stack (fun ~src:_ ~dst:_ buf -> check_packet buf >>= fun () ->
|
||||
V.disconnect stack.netif);
|
||||
Mirage_sleep.ns (Duration.of_ms 500) >>= fun () ->
|
||||
Udp.write stack.udp ~dst ~src_port:1212 ~dst_port:123 payload
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Mirage_sleep.ns (Duration.of_sec 1) >>= fun () ->
|
||||
Alcotest.fail "writing thread completed first";
|
||||
]
|
||||
in
|
||||
get_stack speaker_address >>= fun speaker ->
|
||||
get_stack ~backend:speaker.backend listener_address >>= fun listener ->
|
||||
inform_arp speaker listener_address (mac_of_stack listener);
|
||||
inform_arp listener speaker_address (mac_of_stack speaker);
|
||||
Lwt.pick [
|
||||
reject_all listener;
|
||||
check_rejection speaker listener_address;
|
||||
]
|
||||
|
||||
let suite = [
|
||||
"short read", `Quick, short_read;
|
||||
"echo requests elicit an echo reply", `Quick, echo_request;
|
||||
"echo requests for other ips don't elicit an echo reply", `Quick, echo_silent;
|
||||
"error messages are written", `Quick, write_errors;
|
||||
]
|
||||
273
unikernel/duniverse/mirage-tcpip/test/test_iperf.ml
Normal file
273
unikernel/duniverse/mirage-tcpip/test/test_iperf.ml
Normal file
|
|
@ -0,0 +1,273 @@
|
|||
(*
|
||||
* Copyright (c) 2011 Richard Mortier <mort@cantab.net>
|
||||
* Copyright (c) 2012 Balraj Singh <balraj.singh@cl.cam.ac.uk>
|
||||
* Copyright (c) 2015 Magnus Skjegstad <magnus@skjegstad.com>
|
||||
*
|
||||
* 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 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.
|
||||
*)
|
||||
|
||||
open Common
|
||||
open Vnetif_common
|
||||
open Lwt.Infix
|
||||
|
||||
module Test_iperf (B : Vnetif_backends.Backend) = struct
|
||||
|
||||
module V = VNETIF_STACK (B)
|
||||
|
||||
let gateway = Ipaddr.V4.of_string_exn "10.0.0.1"
|
||||
let client_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.101/24"
|
||||
let server_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.100/24"
|
||||
|
||||
type stats = {
|
||||
mutable bytes: int64;
|
||||
mutable packets: int64;
|
||||
mutable bin_bytes:int64;
|
||||
mutable bin_packets: int64;
|
||||
mutable start_time: int64;
|
||||
mutable last_time: int64;
|
||||
}
|
||||
|
||||
type network = {
|
||||
backend : B.t;
|
||||
server : V.Stack.t;
|
||||
client : V.Stack.t;
|
||||
}
|
||||
|
||||
let default_network ?mtu ?(backend = B.create ()) () =
|
||||
V.create_stack ?mtu ~cidr:client_cidr ~gateway backend >>= fun client ->
|
||||
V.create_stack ?mtu ~cidr:server_cidr ~gateway backend >>= fun server ->
|
||||
Lwt.return {backend; server; client}
|
||||
|
||||
let msg =
|
||||
let m = "01234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" in
|
||||
let rec build l = function
|
||||
| 0 -> l
|
||||
| n -> build (m :: l) (n - 1)
|
||||
in
|
||||
String.concat "" @@ build [] 60
|
||||
|
||||
let mlen = String.length msg
|
||||
|
||||
let err_eof () = failf "EOF while writing to TCP flow"
|
||||
|
||||
let err_connect e ip port () =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_error e in
|
||||
let ip = Ipaddr.to_string ip in
|
||||
failf "Unable to connect to %s:%d: %s" ip port err
|
||||
|
||||
let err_write e () =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_write_error e in
|
||||
failf "Error while writing to TCP flow: %s" err
|
||||
|
||||
let err_read e () =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_error e in
|
||||
failf "Error in server while reading: %s" err
|
||||
|
||||
let write_and_check flow buf =
|
||||
V.Stack.TCP.write flow buf >>= function
|
||||
| Ok () -> Lwt.return_unit
|
||||
| Error `Closed -> V.Stack.TCP.close flow >>= err_eof
|
||||
| Error e -> V.Stack.TCP.close flow >>= err_write e
|
||||
|
||||
let tcp_connect t (ip, port) =
|
||||
V.Stack.TCP.create_connection t (ip, port) >>= function
|
||||
| Error e -> err_connect e ip port ()
|
||||
| Ok f -> Lwt.return f
|
||||
|
||||
let iperfclient s amt dest_ip dport =
|
||||
let iperftx flow =
|
||||
Logs.info (fun f -> f "Iperf client: Made connection to server.");
|
||||
let a = Cstruct.create mlen in
|
||||
Cstruct.blit_from_string msg 0 a 0 mlen;
|
||||
let rec loop = function
|
||||
| 0 -> Lwt.return_unit
|
||||
| n -> write_and_check flow a >>= fun () -> loop (n-1)
|
||||
in
|
||||
loop (amt / mlen) >>= fun () ->
|
||||
let a = Cstruct.sub a 0 (amt - (mlen * (amt/mlen))) in
|
||||
write_and_check flow a >>= fun () ->
|
||||
V.Stack.TCP.close flow
|
||||
in
|
||||
Logs.info (fun f -> f "Iperf client: Attempting connection.");
|
||||
tcp_connect (V.Stack.tcp s) (dest_ip, dport) >>= fun flow ->
|
||||
iperftx flow >>= fun () ->
|
||||
Logs.debug (fun f -> f "Iperf client: Done.");
|
||||
Lwt.return_unit
|
||||
|
||||
let print_data st ts_now =
|
||||
let server = Int64.sub ts_now st.start_time in
|
||||
let rate_in_mbps =
|
||||
let t_in_s = Int64.(to_float (sub ts_now st.last_time)) /. 1_000_000_000. in
|
||||
(Int64.to_float st.bin_bytes) /. t_in_s /. 125000.
|
||||
in
|
||||
let live_words = Gc.((stat()).live_words) in
|
||||
Logs.info (fun f -> f "Iperf server: t = %.0Lu, avg_rate = %0.2f MBits/s, totbytes = %Ld, \
|
||||
live_words = %d" server rate_in_mbps st.bytes live_words);
|
||||
st.last_time <- ts_now;
|
||||
st.bin_bytes <- 0L;
|
||||
st.bin_packets <- 0L;
|
||||
Lwt.return_unit
|
||||
|
||||
let iperf _s server_done_u flow =
|
||||
(* debug is too much for us here *)
|
||||
Logs.set_level ~all:true (Some Logs.Info);
|
||||
Logs.info (fun f -> f "Iperf server: Received connection.");
|
||||
let t0 = Mirage_mtime.elapsed_ns () in
|
||||
let st = {
|
||||
bytes=0L; packets=0L; bin_bytes=0L; bin_packets=0L; start_time = t0;
|
||||
last_time = t0
|
||||
} in
|
||||
let rec iperf_h flow =
|
||||
V.Stack.TCP.read flow >|= Result.get_ok >>= function
|
||||
| `Eof ->
|
||||
let ts_now = Mirage_mtime.elapsed_ns () in
|
||||
st.bin_bytes <- st.bytes;
|
||||
st.bin_packets <- st.packets;
|
||||
st.last_time <- st.start_time;
|
||||
print_data st ts_now >>= fun () ->
|
||||
V.Stack.TCP.close flow >>= fun () ->
|
||||
Logs.info (fun f -> f "Iperf server: Done - closed connection.");
|
||||
Lwt.return_unit
|
||||
| `Data data ->
|
||||
begin
|
||||
let l = Cstruct.length data in
|
||||
st.bytes <- (Int64.add st.bytes (Int64.of_int l));
|
||||
st.packets <- (Int64.add st.packets 1L);
|
||||
st.bin_bytes <- (Int64.add st.bin_bytes (Int64.of_int l));
|
||||
st.bin_packets <- (Int64.add st.bin_packets 1L);
|
||||
let ts_now = Mirage_mtime.elapsed_ns () in
|
||||
(if (Int64.sub ts_now st.last_time >= 1_000_000_000L) then
|
||||
print_data st ts_now
|
||||
else
|
||||
Lwt.return_unit) >>= fun () ->
|
||||
iperf_h flow
|
||||
end
|
||||
in
|
||||
iperf_h flow >>= fun () ->
|
||||
Lwt.wakeup server_done_u ();
|
||||
Lwt.return_unit
|
||||
|
||||
let tcp_iperf ~server ~client amt timeout () =
|
||||
let port = 5001 in
|
||||
|
||||
let server_ready, server_ready_u = Lwt.wait () in
|
||||
let server_done, server_done_u = Lwt.wait () in
|
||||
let server_s, client_s = server, client in
|
||||
|
||||
let ip_of s =
|
||||
V.Stack.ip s |> V.Stack.IP.configured_ips |>
|
||||
List.filter (function Ipaddr.V4 _ -> true | Ipaddr.V6 _ -> false) |>
|
||||
List.hd |> Ipaddr.Prefix.address
|
||||
in
|
||||
|
||||
Lwt.pick [
|
||||
(Lwt_unix.sleep timeout >>= fun () -> (* timeout *)
|
||||
failf "iperf test timed out after %f seconds" timeout);
|
||||
|
||||
(server_ready >>= fun () ->
|
||||
Lwt_unix.sleep 0.1 >>= fun () -> (* Give server 0.1 s to call listen *)
|
||||
Logs.info (fun f -> f "I am client with IP %a, trying to connect to server @ %a:%d"
|
||||
Ipaddr.pp (ip_of client_s) Ipaddr.pp (ip_of server_s) port);
|
||||
Lwt.async (fun () -> V.Stack.listen client_s);
|
||||
iperfclient client_s amt (ip_of server) port);
|
||||
|
||||
(Logs.info (fun f -> f "I am server with IP %a, expecting connections on port %d"
|
||||
V.Stack.IP.pp_prefix (V.Stack.IP.configured_ips (V.Stack.ip server_s) |> List.hd)
|
||||
port);
|
||||
V.Stack.TCP.listen (V.Stack.tcp server_s) ~port (iperf server_s server_done_u);
|
||||
Lwt.wakeup server_ready_u ();
|
||||
V.Stack.listen server_s) ] >>= fun () ->
|
||||
|
||||
Logs.info (fun f -> f "Waiting for server_done...");
|
||||
server_done >>= fun () ->
|
||||
Lwt.return_unit (* exit cleanly *)
|
||||
end
|
||||
|
||||
let test_tcp_iperf_two_stacks_basic amt timeout () =
|
||||
let module Test = Test_iperf (Vnetif_backends.Basic) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_two_stacks_basic_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_two_stacks_mtu amt timeout () =
|
||||
let mtu = 1500 in
|
||||
let module Test = Test_iperf (Vnetif_backends.Frame_size_enforced) in
|
||||
let backend = Vnetif_backends.Frame_size_enforced.create () in
|
||||
Vnetif_backends.Frame_size_enforced.set_max_ip_mtu backend mtu;
|
||||
Test.default_network ?mtu:(Some mtu) ?backend:(Some backend) () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_two_stacks_mtu_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_two_stacks_trailing_bytes amt timeout () =
|
||||
let module Test = Test_iperf (Vnetif_backends.Trailing_bytes) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_two_stacks_trailing_bytes_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_two_stacks_uniform_packet_loss amt timeout () =
|
||||
let module Test = Test_iperf (Vnetif_backends.Uniform_packet_loss) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_two_stacks_uniform_packet_loss_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_two_stacks_uniform_packet_loss_no_payload amt timeout () =
|
||||
let module Test = Test_iperf (Vnetif_backends.Uniform_no_payload_packet_loss) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_two_stacks_uniform_packet_loss_no_payload_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_two_stacks_drop_1sec_after_1mb amt timeout () =
|
||||
let module Test = Test_iperf (Vnetif_backends.Drop_1_second_after_1_megabyte) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
"tcp_iperf_two_stacks_drop_1sec_after_1mb.pcap"
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let amt_quick = 100_000
|
||||
let amt_slow = amt_quick * 1000
|
||||
|
||||
let suite = [
|
||||
|
||||
"iperf with two stacks, basic tests", `Quick,
|
||||
test_tcp_iperf_two_stacks_basic amt_quick 120.0;
|
||||
|
||||
"iperf with two stacks, over an MTU-enforcing backend", `Quick,
|
||||
test_tcp_iperf_two_stacks_mtu amt_quick 120.0;
|
||||
|
||||
"iperf with two stacks, testing trailing_bytes", `Quick,
|
||||
test_tcp_iperf_two_stacks_trailing_bytes amt_quick 120.0;
|
||||
|
||||
"iperf with two stacks and uniform packet loss", `Quick,
|
||||
test_tcp_iperf_two_stacks_uniform_packet_loss amt_quick 120.0;
|
||||
|
||||
"iperf with two stacks and uniform packet loss of packets with no payload", `Quick,
|
||||
test_tcp_iperf_two_stacks_uniform_packet_loss_no_payload amt_quick 240.0;
|
||||
|
||||
"iperf with two stacks and uniform packet loss of packets with no payload, longer", `Slow,
|
||||
test_tcp_iperf_two_stacks_uniform_packet_loss_no_payload amt_slow 240.0;
|
||||
|
||||
"iperf with two stacks, basic tests, longer", `Slow,
|
||||
test_tcp_iperf_two_stacks_basic amt_slow 240.0;
|
||||
|
||||
"iperf with two stacks and uniform packet loss, longer", `Slow,
|
||||
test_tcp_iperf_two_stacks_uniform_packet_loss amt_slow 240.0;
|
||||
|
||||
"iperf with two stacks drop 1 sec after 1 mb", `Quick,
|
||||
test_tcp_iperf_two_stacks_drop_1sec_after_1mb amt_quick 120.0;
|
||||
|
||||
]
|
||||
276
unikernel/duniverse/mirage-tcpip/test/test_iperf_ipv6.ml
Normal file
276
unikernel/duniverse/mirage-tcpip/test/test_iperf_ipv6.ml
Normal file
|
|
@ -0,0 +1,276 @@
|
|||
(*
|
||||
* Copyright (c) 2011 Richard Mortier <mort@cantab.net>
|
||||
* Copyright (c) 2012 Balraj Singh <balraj.singh@cl.cam.ac.uk>
|
||||
* Copyright (c) 2015 Magnus Skjegstad <magnus@skjegstad.com>
|
||||
*
|
||||
* 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 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.
|
||||
*)
|
||||
|
||||
open Common
|
||||
open Vnetif_common
|
||||
open Lwt.Infix
|
||||
|
||||
module Test_iperf_ipv6 (B : Vnetif_backends.Backend) = struct
|
||||
|
||||
module V = VNETIF_STACK (B)
|
||||
|
||||
let client_ip = Ipaddr.V6.of_string_exn "fc00::23"
|
||||
let client_cidr = Ipaddr.V6.Prefix.make 64 client_ip
|
||||
let server_ip = Ipaddr.V6.of_string_exn "fc00::45"
|
||||
let server_cidr = Ipaddr.V6.Prefix.make 64 server_ip
|
||||
|
||||
type stats = {
|
||||
mutable bytes: int64;
|
||||
mutable packets: int64;
|
||||
mutable bin_bytes:int64;
|
||||
mutable bin_packets: int64;
|
||||
mutable start_time: int64;
|
||||
mutable last_time: int64;
|
||||
}
|
||||
|
||||
type network = {
|
||||
backend : B.t;
|
||||
server : V.Stack.t;
|
||||
client : V.Stack.t;
|
||||
}
|
||||
|
||||
let cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.2/24"
|
||||
|
||||
let default_network ?mtu ?(backend = B.create ()) () =
|
||||
V.create_stack ?mtu ~cidr ~cidr6:client_cidr backend >>= fun client ->
|
||||
V.create_stack ?mtu ~cidr ~cidr6:server_cidr backend >>= fun server ->
|
||||
Lwt.return {backend; server; client}
|
||||
|
||||
let msg =
|
||||
let m = "01234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" in
|
||||
let rec build l = function
|
||||
| 0 -> l
|
||||
| n -> build (m :: l) (n - 1)
|
||||
in
|
||||
String.concat "" @@ build [] 60
|
||||
|
||||
let mlen = String.length msg
|
||||
|
||||
let err_eof () = failf "EOF while writing to TCP flow"
|
||||
|
||||
let err_connect e ip port () =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_error e in
|
||||
let ip = Ipaddr.to_string ip in
|
||||
failf "Unable to connect to %s:%d: %s" ip port err
|
||||
|
||||
let err_write e () =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_write_error e in
|
||||
failf "Error while writing to TCP flow: %s" err
|
||||
|
||||
let err_read e () =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_error e in
|
||||
failf "Error in server while reading: %s" err
|
||||
|
||||
let write_and_check flow buf =
|
||||
V.Stack.TCP.write flow buf >>= function
|
||||
| Ok () -> Lwt.return_unit
|
||||
| Error `Closed -> V.Stack.TCP.close flow >>= err_eof
|
||||
| Error e -> V.Stack.TCP.close flow >>= err_write e
|
||||
|
||||
let tcp_connect t (ip, port) =
|
||||
V.Stack.TCP.create_connection t (ip, port) >>= function
|
||||
| Error e -> err_connect e ip port ()
|
||||
| Ok f -> Lwt.return f
|
||||
|
||||
let iperfclient s amt dest_ip dport =
|
||||
let iperftx flow =
|
||||
Logs.info (fun f -> f "Iperf client: Made connection to server.");
|
||||
let a = Cstruct.create mlen in
|
||||
Cstruct.blit_from_string msg 0 a 0 mlen;
|
||||
let rec loop = function
|
||||
| 0 -> Lwt.return_unit
|
||||
| n -> write_and_check flow a >>= fun () -> loop (n-1)
|
||||
in
|
||||
loop (amt / mlen) >>= fun () ->
|
||||
let a = Cstruct.sub a 0 (amt - (mlen * (amt/mlen))) in
|
||||
write_and_check flow a >>= fun () ->
|
||||
V.Stack.TCP.close flow
|
||||
in
|
||||
Logs.info (fun f -> f "Iperf client: Attempting connection.");
|
||||
tcp_connect (V.Stack.tcp s) (dest_ip, dport) >>= fun flow ->
|
||||
iperftx flow >>= fun () ->
|
||||
Logs.debug (fun f -> f "Iperf client: Done.");
|
||||
Lwt.return_unit
|
||||
|
||||
let print_data st ts_now =
|
||||
let server = Int64.sub ts_now st.start_time in
|
||||
let rate_in_mbps =
|
||||
let t_in_s = Int64.(to_float (sub ts_now st.last_time)) /. 1_000_000_000. in
|
||||
(Int64.to_float st.bin_bytes) /. t_in_s /. 125000.
|
||||
in
|
||||
let live_words = Gc.((stat()).live_words) in
|
||||
Logs.info (fun f -> f "Iperf server: t = %.0Lu, avg_rate = %0.2f MBits/s, totbytes = %Ld, \
|
||||
live_words = %d" server rate_in_mbps st.bytes live_words);
|
||||
st.last_time <- ts_now;
|
||||
st.bin_bytes <- 0L;
|
||||
st.bin_packets <- 0L;
|
||||
Lwt.return_unit
|
||||
|
||||
let iperf _s server_done_u flow =
|
||||
(* debug is too much for us here *)
|
||||
Logs.set_level ~all:true (Some Logs.Info);
|
||||
Logs.info (fun f -> f "Iperf server: Received connection.");
|
||||
let t0 = Mirage_mtime.elapsed_ns () in
|
||||
let st = {
|
||||
bytes=0L; packets=0L; bin_bytes=0L; bin_packets=0L; start_time = t0;
|
||||
last_time = t0
|
||||
} in
|
||||
let rec iperf_h flow =
|
||||
V.Stack.TCP.read flow >|= Result.get_ok >>= function
|
||||
| `Eof ->
|
||||
let ts_now = Mirage_mtime.elapsed_ns () in
|
||||
st.bin_bytes <- st.bytes;
|
||||
st.bin_packets <- st.packets;
|
||||
st.last_time <- st.start_time;
|
||||
print_data st ts_now >>= fun () ->
|
||||
V.Stack.TCP.close flow >>= fun () ->
|
||||
Logs.info (fun f -> f "Iperf server: Done - closed connection.");
|
||||
Lwt.return_unit
|
||||
| `Data data ->
|
||||
begin
|
||||
let l = Cstruct.length data in
|
||||
st.bytes <- (Int64.add st.bytes (Int64.of_int l));
|
||||
st.packets <- (Int64.add st.packets 1L);
|
||||
st.bin_bytes <- (Int64.add st.bin_bytes (Int64.of_int l));
|
||||
st.bin_packets <- (Int64.add st.bin_packets 1L);
|
||||
let ts_now = Mirage_mtime.elapsed_ns () in
|
||||
(if (Int64.sub ts_now st.last_time >= 1_000_000_000L) then
|
||||
print_data st ts_now
|
||||
else
|
||||
Lwt.return_unit) >>= fun () ->
|
||||
iperf_h flow
|
||||
end
|
||||
in
|
||||
iperf_h flow >>= fun () ->
|
||||
Lwt.wakeup server_done_u ();
|
||||
Lwt.return_unit
|
||||
|
||||
let tcp_iperf ~server ~client amt timeout () =
|
||||
let port = 5001 in
|
||||
|
||||
let server_ready, server_ready_u = Lwt.wait () in
|
||||
let server_done, server_done_u = Lwt.wait () in
|
||||
let server_s, client_s = server, client in
|
||||
|
||||
let ip_of s =
|
||||
V.Stack.ip s |> V.Stack.IP.configured_ips |>
|
||||
List.filter (function Ipaddr.V4 _ -> false | Ipaddr.V6 _ -> true) |>
|
||||
List.rev |> List.hd |> Ipaddr.Prefix.address
|
||||
in
|
||||
|
||||
Lwt.pick [
|
||||
(Lwt_unix.sleep timeout >>= fun () -> (* timeout *)
|
||||
failf "iperf test timed out after %f seconds" timeout);
|
||||
|
||||
(server_ready >>= fun () ->
|
||||
Lwt_unix.sleep 0.1 >>= fun () -> (* Give server 0.1 s to call listen *)
|
||||
Logs.info (fun f -> f "I am client with IP %a, trying to connect to server @ %a:%d"
|
||||
Ipaddr.pp (ip_of client_s) Ipaddr.pp (ip_of server_s) port);
|
||||
Lwt.async (fun () -> V.Stack.listen client_s);
|
||||
iperfclient client_s amt (ip_of server) port);
|
||||
|
||||
(Logs.info (fun f -> f "I am server with IP %a, expecting connections on port %d"
|
||||
V.Stack.IP.pp_prefix (V.Stack.IP.configured_ips (V.Stack.ip server_s) |> List.hd)
|
||||
port);
|
||||
V.Stack.TCP.listen (V.Stack.tcp server_s) ~port (iperf server_s server_done_u);
|
||||
Lwt.wakeup server_ready_u ();
|
||||
V.Stack.listen server_s) ] >>= fun () ->
|
||||
|
||||
Logs.info (fun f -> f "Waiting for server_done...");
|
||||
server_done >>= fun () ->
|
||||
Lwt.return_unit (* exit cleanly *)
|
||||
end
|
||||
|
||||
let test_tcp_iperf_ipv6_two_stacks_basic amt timeout () =
|
||||
let module Test = Test_iperf_ipv6 (Vnetif_backends.Basic) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_ipv6_two_stacks_basic_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_ipv6_two_stacks_mtu amt timeout () =
|
||||
let mtu = 1500 in
|
||||
let module Test = Test_iperf_ipv6 (Vnetif_backends.Frame_size_enforced) in
|
||||
let backend = Vnetif_backends.Frame_size_enforced.create () in
|
||||
Vnetif_backends.Frame_size_enforced.set_max_ip_mtu backend mtu;
|
||||
Test.default_network ?mtu:(Some mtu) ?backend:(Some backend) () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_ipv6_two_stacks_mtu_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_ipv6_two_stacks_trailing_bytes amt timeout () =
|
||||
let module Test = Test_iperf_ipv6 (Vnetif_backends.Trailing_bytes) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_ipv6_two_stacks_trailing_bytes_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_ipv6_two_stacks_uniform_packet_loss amt timeout () =
|
||||
let module Test = Test_iperf_ipv6 (Vnetif_backends.Uniform_packet_loss) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_ipv6_two_stacks_uniform_packet_loss_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_ipv6_two_stacks_uniform_packet_loss_no_payload amt timeout () =
|
||||
let module Test = Test_iperf_ipv6 (Vnetif_backends.Uniform_no_payload_packet_loss) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_iperf_ipv6_two_stacks_uniform_packet_loss_no_payload_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let test_tcp_iperf_ipv6_two_stacks_drop_1sec_after_1mb amt timeout () =
|
||||
let module Test = Test_iperf_ipv6 (Vnetif_backends.Drop_1_second_after_1_megabyte) in
|
||||
Test.default_network () >>= fun { backend; Test.client; Test.server } ->
|
||||
Test.V.record_pcap backend
|
||||
"tcp_iperf_ipv6_two_stacks_drop_1sec_after_1mb.pcap"
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let amt_quick = 100_000
|
||||
let amt_slow = amt_quick * 1000
|
||||
|
||||
let suite = [
|
||||
|
||||
"iperf with two stacks, basic tests", `Quick,
|
||||
test_tcp_iperf_ipv6_two_stacks_basic amt_quick 120.0;
|
||||
|
||||
"iperf with two stacks, over an MTU-enforcing backend", `Quick,
|
||||
test_tcp_iperf_ipv6_two_stacks_mtu amt_quick 120.0;
|
||||
|
||||
"iperf with two stacks, testing trailing_bytes", `Quick,
|
||||
test_tcp_iperf_ipv6_two_stacks_trailing_bytes amt_quick 120.0;
|
||||
|
||||
"iperf with two stacks and uniform packet loss", `Quick,
|
||||
test_tcp_iperf_ipv6_two_stacks_uniform_packet_loss amt_quick 120.0;
|
||||
|
||||
"iperf with two stacks and uniform packet loss of packets with no payload", `Slow,
|
||||
test_tcp_iperf_ipv6_two_stacks_uniform_packet_loss_no_payload amt_quick 240.0;
|
||||
|
||||
"iperf with two stacks and uniform packet loss of packets with no payload, longer", `Slow,
|
||||
test_tcp_iperf_ipv6_two_stacks_uniform_packet_loss_no_payload amt_slow 240.0;
|
||||
|
||||
"iperf with two stacks, basic tests, longer", `Slow,
|
||||
test_tcp_iperf_ipv6_two_stacks_basic amt_slow 240.0;
|
||||
|
||||
"iperf with two stacks and uniform packet loss, longer", `Slow,
|
||||
test_tcp_iperf_ipv6_two_stacks_uniform_packet_loss amt_slow 240.0;
|
||||
|
||||
"iperf with two stacks drop 1 sec after 1 mb", `Quick,
|
||||
test_tcp_iperf_ipv6_two_stacks_drop_1sec_after_1mb amt_quick 120.0;
|
||||
|
||||
]
|
||||
303
unikernel/duniverse/mirage-tcpip/test/test_ipv4.ml
Normal file
303
unikernel/duniverse/mirage-tcpip/test/test_ipv4.ml
Normal file
|
|
@ -0,0 +1,303 @@
|
|||
open Common
|
||||
|
||||
let test_unmarshal_with_options () =
|
||||
let datagram = Cstruct.create 40 in
|
||||
Cstruct.blit_from_string ("\x46\xc0\x00\x28\x00\x00\x40\x00\x01\x02" ^
|
||||
"\x42\x49\xc0\xa8\x01\x08\xe0\x00\x00\x16\x94\x04\x00\x00\x22" ^
|
||||
"\x00\xfa\x02\x00\x00\x00\x01\x03\x00\x00\x00\xe0\x00\x00\xfb") 0 datagram 0 40;
|
||||
match Ipv4_packet.Unmarshal.of_cstruct datagram with
|
||||
| Ok ({Ipv4_packet.options ; _}, payload) ->
|
||||
Alcotest.(check int) "options" (Cstruct.length options) 4;
|
||||
Alcotest.(check int) "payload" (Cstruct.length payload) 16;
|
||||
Lwt.return_unit
|
||||
| _ ->
|
||||
Alcotest.fail "Fail to parse ip packet with options"
|
||||
|
||||
|
||||
let test_unmarshal_without_options () =
|
||||
let datagram = Cstruct.create 40 in
|
||||
Cstruct.blit_from_string ("\x45\x00\x00\x28\x19\x29\x40\x00\x34\x06\x98\x75\x36\xb7" ^
|
||||
"\x9c\xca\xc0\xa8\x01\x08\x00\x50\xca\xa6\x6f\x19\xf4\x76" ^
|
||||
"\x00\x00\x00\x00\x50\x04\x00\x00\xec\x27\x00\x00") 0 datagram 0 40;
|
||||
match Ipv4_packet.Unmarshal.of_cstruct datagram with
|
||||
| Ok ({Ipv4_packet.options ; _}, payload) ->
|
||||
Alcotest.(check int) "options" (Cstruct.length options) 0;
|
||||
Alcotest.(check int) "payload" (Cstruct.length payload) 20;
|
||||
Lwt.return_unit
|
||||
| _ ->
|
||||
Alcotest.fail "Fail to parse ip packet with options"
|
||||
|
||||
let test_unmarshal_regression () =
|
||||
let p = Cstruct.of_string "\x49\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30" in
|
||||
Alcotest.(check (result reject pass))
|
||||
"correctly return error for bad packet"
|
||||
(Error "any") (Ipv4_packet.Unmarshal.of_cstruct p);
|
||||
Lwt.return_unit
|
||||
|
||||
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; 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.length payload) ip in
|
||||
let tmp = Cstruct.concat [tmp; payload] in
|
||||
Ipv4_packet.Unmarshal.of_cstruct tmp
|
||||
|> 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 mf = 0x2000
|
||||
|
||||
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 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 = mf } in
|
||||
let cache, res = Fragments.process empty_cache 0L more_frags black 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 black white))
|
||||
(snd @@ Fragments.process cache 0L off_packet white)) ;
|
||||
Lwt.return_unit
|
||||
|
||||
let basic_reassembly_timeout () =
|
||||
let more_frags = { test_packet with off = mf } in
|
||||
let cache, res = Fragments.process empty_cache 0L more_frags black 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 black white))
|
||||
(snd @@ Fragments.process cache below_max off_packet white)) ;
|
||||
Alcotest.(check (option (pair ipv4_packet cstruct)) "none after max duration"
|
||||
None
|
||||
(snd @@ Fragments.process cache Fragments.max_duration off_packet white)) ;
|
||||
let more_off_packet = { test_packet with off = mf lor 2 } in
|
||||
let cache, res = Fragments.process cache below_max more_off_packet gray 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 [ black; gray; white]))
|
||||
(snd @@ Fragments.process cache below_max final_packet white)) ;
|
||||
Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__
|
||||
None
|
||||
(snd @@ Fragments.process cache Fragments.max_duration off_packet white)) ;
|
||||
Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ;
|
||||
Lwt.return_unit
|
||||
|
||||
let reassembly_out_of_order () =
|
||||
let more_frags = { test_packet with off = mf } in
|
||||
let off_packet = { test_packet with off = 2 } in
|
||||
let cache, res = Fragments.process empty_cache 0L off_packet gray 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 black gray))
|
||||
(snd @@ Fragments.process cache 0L more_frags black)) ;
|
||||
Lwt.return_unit
|
||||
|
||||
let reassembly_multiple_out_of_order 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 = mf } in
|
||||
let off_packet = { test_packet with off = 1 } in
|
||||
let cache, res = Fragments.process empty_cache 0L off_packet black 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 white)) ;
|
||||
Lwt.return_unit
|
||||
|
||||
let basic_other_ip_flow () =
|
||||
let more_frags = { test_packet with off = mf } in
|
||||
let cache, res = Fragments.process empty_cache 0L more_frags black 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 white)) ;
|
||||
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' white)) ;
|
||||
Lwt.return_unit
|
||||
|
||||
let max_fragment () =
|
||||
let all_16 = [ white; gray; black; white;
|
||||
white; gray; black; white;
|
||||
white; gray; black; white;
|
||||
white; gray; black ; gray ]
|
||||
in
|
||||
let (cache, res), off =
|
||||
List.fold_left (fun ((cache, res), off) payload ->
|
||||
Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ;
|
||||
let r = Fragments.process cache 0L { test_packet with off = off lor mf } payload in
|
||||
(r, Cstruct.length payload / 8 + off))
|
||||
((empty_cache, None), 0)
|
||||
all_16
|
||||
in
|
||||
Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__ None res) ;
|
||||
Alcotest.(check (option (pair ipv4_packet cstruct)) __LOC__
|
||||
(Some (test_packet, Cstruct.concat (all_16 @ [white ])))
|
||||
(snd @@ Fragments.process cache 0L { test_packet with off } white)) ;
|
||||
let cache, res = Fragments.process cache 0L { test_packet with off = off lor mf } white 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 { test_packet with off = off + 2 } black)) ;
|
||||
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 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 fragment_simple () =
|
||||
let hdr =
|
||||
{ Ipv4_packet.src = Ipaddr.V4.localhost ; dst = Ipaddr.V4.localhost ;
|
||||
id = 0x42 ; off = 0 ; ttl = 10 ; proto = 10 ; options = Cstruct.empty }
|
||||
in
|
||||
let payload = Cstruct.create 1030 in
|
||||
let fs = Fragments.fragment ~mtu:36 hdr payload in
|
||||
(* 16 byte per packet -> 64 fragments (a 16 byte) + 1 (6 byte) *)
|
||||
Alcotest.(check int __LOC__ 65 (List.length fs));
|
||||
let second, last = List.hd fs, List.(hd (rev fs)) in
|
||||
Alcotest.(check int __LOC__ 26 (Cstruct.length last));
|
||||
match
|
||||
Ipv4_packet.Unmarshal.of_cstruct second,
|
||||
Ipv4_packet.Unmarshal.of_cstruct last
|
||||
with
|
||||
| Error e, _ -> Alcotest.fail ("failed to decode second fragment " ^ e)
|
||||
| _, Error e -> Alcotest.fail ("failed to decode last fragment " ^ e)
|
||||
| Ok (hdr, _payload), Ok (hdr', _payload') ->
|
||||
Alcotest.(check int __LOC__ (0x2000 lor 2) hdr.Ipv4_packet.off);
|
||||
Alcotest.(check int __LOC__ 0x42 hdr.Ipv4_packet.id);
|
||||
Alcotest.(check int __LOC__ 130 hdr'.Ipv4_packet.off);
|
||||
Alcotest.(check int __LOC__ 0x42 hdr'.Ipv4_packet.id);
|
||||
let fs' = Fragments.fragment ~mtu:36 hdr (Cstruct.sub payload 0 1024) in
|
||||
(* 16 byte per packet -> 64 fragments (a 16 byte) *)
|
||||
Alcotest.(check int __LOC__ 64 (List.length fs'));
|
||||
let second', last' = List.hd fs', List.(hd (rev fs')) in
|
||||
Alcotest.(check int __LOC__ 36 (Cstruct.length last'));
|
||||
match
|
||||
Ipv4_packet.Unmarshal.of_cstruct second',
|
||||
Ipv4_packet.Unmarshal.of_cstruct last'
|
||||
with
|
||||
| Error e, _ -> Alcotest.fail ("failed to decode second fragment' " ^ e)
|
||||
| _, Error e -> Alcotest.fail ("failed to decode last fragment' " ^ e)
|
||||
| Ok (hdr'', _payload''), Ok (hdr''', _payload''') ->
|
||||
Alcotest.(check int __LOC__ (0x2000 lor 2) hdr''.Ipv4_packet.off);
|
||||
Alcotest.(check int __LOC__ 0x42 hdr''.Ipv4_packet.id);
|
||||
Alcotest.(check int __LOC__ 128 hdr'''.Ipv4_packet.off);
|
||||
Alcotest.(check int __LOC__ 0x42 hdr'''.Ipv4_packet.id)
|
||||
|
||||
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 ] @
|
||||
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_order ;
|
||||
"other ip flow", `Quick, basic_other_ip_flow ;
|
||||
"maximum amount of fragments", `Quick, max_fragment ] @
|
||||
List.mapi (fun i (packets, final) ->
|
||||
Printf.sprintf "reassembly multiple %d" i, `Quick,
|
||||
reassembly_multiple_out_of_order 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)]
|
||||
) @ [
|
||||
"simple fragment", `Quick, (fun () -> Lwt.return (fragment_simple ()))
|
||||
]
|
||||
221
unikernel/duniverse/mirage-tcpip/test/test_ipv6.ml
Normal file
221
unikernel/duniverse/mirage-tcpip/test/test_ipv6.ml
Normal file
|
|
@ -0,0 +1,221 @@
|
|||
open Common
|
||||
module B = Vnetif_backends.Basic
|
||||
module V = Vnetif.Make(B)
|
||||
module E = Ethernet.Make(V)
|
||||
|
||||
module Ipv6 = Ipv6.Make(V)(E)
|
||||
module Udp = Udp.Make(Ipv6)
|
||||
open Lwt.Infix
|
||||
|
||||
let ip =
|
||||
let module M = struct
|
||||
type t = Ipaddr.V6.t
|
||||
let pp = Ipaddr.V6.pp
|
||||
let equal p q = (Ipaddr.V6.compare p q) = 0
|
||||
end in
|
||||
(module M : Alcotest.TESTABLE with type t = M.t)
|
||||
|
||||
type stack = {
|
||||
backend : B.t;
|
||||
netif : V.t;
|
||||
ethif : E.t;
|
||||
ip : Ipv6.t;
|
||||
udp : Udp.t
|
||||
}
|
||||
|
||||
let get_stack backend address =
|
||||
let cidr = Ipaddr.V6.Prefix.make 64 address in
|
||||
V.connect backend >>= fun netif ->
|
||||
E.connect netif >>= fun ethif ->
|
||||
Ipv6.connect ~cidr netif ethif >>= fun ip ->
|
||||
Udp.connect ip >>= fun udp ->
|
||||
Lwt.return { backend; netif; ethif; ip; udp }
|
||||
|
||||
let noop = fun ~src:_ ~dst:_ _ -> Lwt.return_unit
|
||||
|
||||
let listen ?(tcp = noop) ?(udp = noop) ?(default = noop) stack =
|
||||
V.listen stack.netif ~header_size:Ethernet.Packet.sizeof_ethernet
|
||||
( E.input stack.ethif
|
||||
~arpv4:(fun _ -> Lwt.return_unit)
|
||||
~ipv4:(fun _ -> Lwt.return_unit)
|
||||
~ipv6:(
|
||||
Ipv6.input stack.ip
|
||||
~tcp:tcp
|
||||
~udp:udp
|
||||
~default:(fun ~proto:_ -> default))) >>= fun _ -> Lwt.return_unit
|
||||
|
||||
let udp_message = Cstruct.of_string "hello on UDP over IPv6"
|
||||
|
||||
let check_for_one_udp_packet on_received_one ~src ~dst buf =
|
||||
(match Udp_packet.Unmarshal.of_cstruct buf with
|
||||
| Ok (_, payload) ->
|
||||
Alcotest.(check ip) "sender address" (Ipaddr.V6.of_string_exn "fc00::23") src;
|
||||
Alcotest.(check ip) "receiver address" (Ipaddr.V6.of_string_exn "fc00::45") dst;
|
||||
Alcotest.(check cstruct) "payload is correct" udp_message payload
|
||||
| Error m -> Alcotest.fail m);
|
||||
(try Lwt.wakeup_later on_received_one () with _ -> () (* the first succeeds, the rest raise *));
|
||||
Lwt.return_unit
|
||||
|
||||
let send_forever sender receiver_address udp_message =
|
||||
let rec loop () =
|
||||
Udp.write sender.udp ~dst:receiver_address ~dst_port:1234 udp_message
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Mirage_sleep.ns (Duration.of_ms 50) >>= fun () ->
|
||||
loop () in
|
||||
loop ()
|
||||
|
||||
let pass_udp_traffic () =
|
||||
let sender_address = Ipaddr.V6.of_string_exn "fc00::23" in
|
||||
let receiver_address = Ipaddr.V6.of_string_exn "fc00::45" in
|
||||
let backend = B.create () in
|
||||
get_stack backend sender_address >>= fun sender ->
|
||||
get_stack backend receiver_address >>= fun receiver ->
|
||||
let received_one, on_received_one = Lwt.task () in
|
||||
Lwt.pick [
|
||||
listen receiver ~udp:(check_for_one_udp_packet on_received_one);
|
||||
listen sender;
|
||||
send_forever sender receiver_address udp_message;
|
||||
received_one; (* stop on the first packet *)
|
||||
Mirage_sleep.ns (Duration.of_ms 3000) >>= fun () ->
|
||||
Alcotest.fail "UDP packet should have been received";
|
||||
]
|
||||
|
||||
let create_ethernet backend =
|
||||
V.connect backend >>= fun netif ->
|
||||
E.connect netif >|= fun ethif ->
|
||||
(fun ipv6 ->
|
||||
V.listen netif ~header_size:Ethernet.Packet.sizeof_ethernet
|
||||
(E.input ethif
|
||||
~arpv4:(fun _ -> Lwt.return_unit)
|
||||
~ipv4:(fun _ -> Lwt.return_unit)
|
||||
~ipv6) >|= fun _ -> ()),
|
||||
(fun dst ?size f -> E.write ethif dst `IPv6 ?size f),
|
||||
E.mac ethif
|
||||
|
||||
let solicited_node_prefix =
|
||||
Ipaddr.V6.(Prefix.make 104 (of_int16 (0xff02, 0, 0, 0, 0, 1, 0xff00, 0)))
|
||||
|
||||
let dad_na_is_sent () =
|
||||
let address = Ipaddr.V6.of_string_exn "fc00::23" in
|
||||
let backend = B.create () in
|
||||
get_stack backend address >>= fun stack ->
|
||||
create_ethernet backend >>= fun (listen_raw, write_raw, _) ->
|
||||
let received_one, on_received_one = Lwt.task () in
|
||||
let nd_size = Ipv6_wire.sizeof_ipv6 + Ipv6_wire.Ns.sizeof_ns in
|
||||
let nd buf =
|
||||
Ipv6_wire.set_version_flow buf 0x60000000l; (* IPv6 *)
|
||||
Ipv6_wire.set_len buf Ipv6_wire.Ns.sizeof_ns;
|
||||
Ipaddr_cstruct.V6.write_cstruct_exn Ipaddr.V6.unspecified (Cstruct.shift buf 8);
|
||||
Ipaddr_cstruct.V6.write_cstruct_exn (Ipaddr.V6.Prefix.network_address solicited_node_prefix address) (Cstruct.shift buf 24);
|
||||
Ipv6_wire.set_hlim buf 255;
|
||||
Ipv6_wire.set_nhdr buf (Ipv6_wire.protocol_to_int `ICMP);
|
||||
let hdr, icmpbuf = Cstruct.split buf Ipv6_wire.sizeof_ipv6 in
|
||||
Ipv6_wire.set_ty icmpbuf 135; (* NS *)
|
||||
Ipv6_wire.set_code icmpbuf 0;
|
||||
Ipv6_wire.Ns.set_reserved icmpbuf 0l;
|
||||
Ipaddr_cstruct.V6.write_cstruct_exn address (Cstruct.shift icmpbuf 8);
|
||||
Ipv6_wire.Icmpv6.set_checksum icmpbuf 0;
|
||||
Ipv6_wire.Icmpv6.set_checksum icmpbuf @@ Ndpv6.checksum hdr [icmpbuf];
|
||||
nd_size
|
||||
and is_na buf =
|
||||
let icmpbuf = Cstruct.shift buf Ipv6_wire.sizeof_ipv6 in
|
||||
Ipv6_wire.get_version_flow buf = 0x60000000l && (* IPv6 *)
|
||||
Ipaddr.V6.compare
|
||||
(Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift buf 8))
|
||||
address = 0 &&
|
||||
Ipaddr.V6.compare
|
||||
(Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift buf 24))
|
||||
Ipaddr.V6.link_nodes = 0 &&
|
||||
Ipv6_wire.get_hlim buf = 255 &&
|
||||
Ipv6_wire.get_nhdr buf = Ipv6_wire.protocol_to_int `ICMP &&
|
||||
Ipv6_wire.get_ty icmpbuf = 136 &&
|
||||
Ipv6_wire.get_code icmpbuf = 0 &&
|
||||
Ipaddr.V6.compare
|
||||
(Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift icmpbuf 8))
|
||||
address = 0
|
||||
in
|
||||
Lwt.pick [
|
||||
listen stack;
|
||||
listen_raw (fun buf ->
|
||||
if is_na buf then
|
||||
Lwt.wakeup_later on_received_one ();
|
||||
Lwt.return_unit);
|
||||
(write_raw (E.mac stack.ethif) ~size:nd_size nd >|= fun _ -> ());
|
||||
received_one;
|
||||
(Mirage_sleep.ns (Duration.of_ms 1000) >>= fun () ->
|
||||
Alcotest.fail "NA packet should have been received")
|
||||
]
|
||||
|
||||
let multicast_mac =
|
||||
let pbuf = Cstruct.create 6 in
|
||||
Cstruct.BE.set_uint16 pbuf 0 0x3333;
|
||||
fun ip ->
|
||||
let _, _, _, n = Ipaddr.V6.to_int32 ip in
|
||||
Cstruct.BE.set_uint32 pbuf 2 n;
|
||||
Macaddr_cstruct.of_cstruct_exn pbuf
|
||||
|
||||
let dad_na_is_received () =
|
||||
let address = Ipaddr.V6.of_string_exn "fc00::23" in
|
||||
let backend = B.create () in
|
||||
create_ethernet backend >>= fun (listen_raw, write_raw, mac) ->
|
||||
let na_size = Ipv6_wire.sizeof_ipv6 + Ipv6_wire.Na.sizeof_na + Ipv6_wire.Llopt.sizeof_llopt in
|
||||
let is_ns buf =
|
||||
let icmpbuf = Cstruct.shift buf Ipv6_wire.sizeof_ipv6 in
|
||||
if
|
||||
Ipv6_wire.get_version_flow buf = 0x60000000l && (* IPv6 *)
|
||||
Ipaddr.V6.compare
|
||||
(Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift buf 8))
|
||||
Ipaddr.V6.unspecified = 0 &&
|
||||
Ipaddr.V6.Prefix.mem
|
||||
(Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift buf 24))
|
||||
solicited_node_prefix &&
|
||||
Ipv6_wire.get_hlim buf = 255 &&
|
||||
Ipv6_wire.get_nhdr buf = Ipv6_wire.protocol_to_int `ICMP &&
|
||||
Ipv6_wire.get_ty icmpbuf = 135 &&
|
||||
Ipv6_wire.get_code icmpbuf = 0
|
||||
then
|
||||
Some (Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.shift icmpbuf 8))
|
||||
else
|
||||
None
|
||||
in
|
||||
let na addr buf =
|
||||
Ipv6_wire.set_version_flow buf 0x60000000l; (* IPv6 *)
|
||||
Ipv6_wire.set_len buf (Ipv6_wire.Na.sizeof_na + Ipv6_wire.Llopt.sizeof_llopt);
|
||||
Ipaddr_cstruct.V6.write_cstruct_exn addr (Cstruct.shift buf 8);
|
||||
Ipaddr_cstruct.V6.write_cstruct_exn Ipaddr.V6.link_nodes (Cstruct.shift buf 24);
|
||||
Ipv6_wire.set_hlim buf 255;
|
||||
Ipv6_wire.set_nhdr buf (Ipv6_wire.protocol_to_int `ICMP);
|
||||
let hdr, icmpbuf = Cstruct.split buf Ipv6_wire.sizeof_ipv6 in
|
||||
Ipv6_wire.set_ty icmpbuf 136; (* NA *)
|
||||
Ipv6_wire.set_code icmpbuf 0;
|
||||
Ipv6_wire.Na.set_reserved icmpbuf 0x20000000l;
|
||||
Ipaddr_cstruct.V6.write_cstruct_exn addr (Cstruct.shift icmpbuf 8);
|
||||
let optbuf = Cstruct.shift icmpbuf Ipv6_wire.Na.sizeof_na in
|
||||
Ipv6_wire.set_ty optbuf 2;
|
||||
Ipv6_wire.Llopt.set_len optbuf 1;
|
||||
Macaddr_cstruct.write_cstruct_exn mac (Cstruct.shift optbuf 2);
|
||||
Ipv6_wire.Icmpv6.set_checksum icmpbuf 0;
|
||||
Ipv6_wire.Icmpv6.set_checksum icmpbuf @@ Ndpv6.checksum hdr [icmpbuf];
|
||||
na_size
|
||||
in
|
||||
Lwt.pick [
|
||||
(listen_raw (fun buf ->
|
||||
match is_ns buf with
|
||||
| None -> Lwt.return_unit
|
||||
| Some addr ->
|
||||
let dst = multicast_mac Ipaddr.V6.link_nodes in
|
||||
write_raw dst ~size:na_size (na addr) >|= fun _ -> ()));
|
||||
(Lwt.catch
|
||||
(fun () -> get_stack backend address >|= fun _ -> Error ())
|
||||
(fun _ -> Lwt.return (Ok ())) >|= function
|
||||
| Ok () -> ()
|
||||
| Error () -> Alcotest.fail "Expected stack initialization failure");
|
||||
(Mirage_sleep.ns (Duration.of_ms 5000) >>= fun () ->
|
||||
Alcotest.fail "stack initialization should have failed")
|
||||
]
|
||||
|
||||
let suite = [
|
||||
"Send a UDP packet from one IPV6 stack and check it is received by another", `Quick, pass_udp_traffic;
|
||||
"NA is sent when a ND is received", `Quick, dad_na_is_sent;
|
||||
"NA is received, stack fails to initialise", `Quick, dad_na_is_received;
|
||||
]
|
||||
142
unikernel/duniverse/mirage-tcpip/test/test_keepalive.ml
Normal file
142
unikernel/duniverse/mirage-tcpip/test/test_keepalive.ml
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
(* Test the functional part *)
|
||||
|
||||
(* Linux default *)
|
||||
let default = Tcpip.Tcp.Keepalive.({
|
||||
after = Duration.of_sec 7200; (* 2 hours *)
|
||||
interval = Duration.of_sec 75; (* 75 seconds *)
|
||||
probes = 9;
|
||||
})
|
||||
|
||||
let simulate configuration iterations nprobes ns state =
|
||||
let rec loop iterations nprobes ns state =
|
||||
if iterations > 3 * configuration.Tcpip.Tcp.Keepalive.probes
|
||||
then Alcotest.fail (Printf.sprintf "too many iteractions: loop in keep-alive test? iterations = %d nprobes = %d ns=%Ld" iterations nprobes ns);
|
||||
let action, state' = Tcp.Keepalive.next ~configuration ~ns state in
|
||||
match action with
|
||||
| `SendProbe ->
|
||||
Logs.info (fun f -> f "iteration %d, ns %Ld: SendProbe" iterations ns);
|
||||
loop (iterations + 1) (nprobes + 1) ns state'
|
||||
| `Wait ns' ->
|
||||
Logs.info (fun f -> f "iteration %d, ns %Ld: Wait %Ld" iterations ns ns');
|
||||
loop (iterations + 1) nprobes (Int64.add ns ns') state'
|
||||
| `Close ->
|
||||
Logs.info (fun f -> f "iteration %d, ns %Ld: Close" iterations ns);
|
||||
nprobes in
|
||||
loop iterations nprobes ns state
|
||||
|
||||
(* check we send the expected number of probes if everything does as expected *)
|
||||
let test_keepalive_sequence () =
|
||||
let configuration = default in
|
||||
let state = Tcp.Keepalive.alive in
|
||||
let nprobes = simulate configuration 0 0 0L state in
|
||||
Alcotest.(check int) "number of probes" (configuration.probes) nprobes
|
||||
|
||||
(* check what happens if we miss a probe *)
|
||||
let test_keepalive_miss_probes () =
|
||||
let configuration = default in
|
||||
let state = Tcp.Keepalive.alive in
|
||||
(* skip sending the first 1 or 2 probes *)
|
||||
let ns = Int64.(add configuration.Tcpip.Tcp.Keepalive.after (mul 2L configuration.Tcpip.Tcp.Keepalive.interval)) in
|
||||
let nprobes = simulate configuration 0 0 ns state in
|
||||
if nprobes >= configuration.Tcpip.Tcp.Keepalive.probes
|
||||
then Alcotest.fail (Printf.sprintf "too many probes: max was %d but we sent %d and we should have skipped the first 1 or 2" configuration.probes nprobes)
|
||||
|
||||
(* check what happens if we exceed the maximum timeout *)
|
||||
let test_keepalive_miss_everything () =
|
||||
let configuration = default in
|
||||
let state = Tcp.Keepalive.alive in
|
||||
(* massive delay *)
|
||||
let ns = Int64.(add configuration.Tcpip.Tcp.Keepalive.after (mul 2L (mul (of_int configuration.Tcpip.Tcp.Keepalive.probes) configuration.Tcpip.Tcp.Keepalive.interval))) in
|
||||
let nprobes = simulate configuration 0 0 ns state in
|
||||
if nprobes <> 0
|
||||
then Alcotest.fail (Printf.sprintf "too many probes: max was %d but we sent %d and we should have skipped all" configuration.probes nprobes)
|
||||
|
||||
let suite_1 = [
|
||||
"correct number of keepalives", `Quick, test_keepalive_sequence;
|
||||
"we don't try to send old keepalives", `Quick, test_keepalive_miss_probes;
|
||||
"check we close if we miss all probes", `Slow, test_keepalive_miss_everything;
|
||||
]
|
||||
|
||||
let suite_1 =
|
||||
List.map (fun (n, s, f) -> n, s, (fun () -> Lwt.return (f ()))) suite_1
|
||||
|
||||
(* Test the end-to-end protocol behaviour *)
|
||||
open Common
|
||||
open Vnetif_common
|
||||
|
||||
let (>>=) = Lwt.(>>=)
|
||||
|
||||
let src = Logs.Src.create "test_keepalive" ~doc:"keepalive tests"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
(* Establish a TCP connection, enable keepalives on the connection, tell the network
|
||||
to drop all packets and check that the keep-alives detect the failure. *)
|
||||
module Test_connect = struct
|
||||
module V = VNETIF_STACK (Vnetif_backends.On_off_switch)
|
||||
|
||||
let gateway = Ipaddr.V4.of_string_exn "10.0.0.1"
|
||||
let client_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.101/24"
|
||||
let server_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.100/24"
|
||||
let backend = V.create_backend ()
|
||||
|
||||
let err_read_eof () = failf "accept got EOF while reading"
|
||||
let err_write_eof () = failf "client tried to write, got EOF"
|
||||
|
||||
let err_read e =
|
||||
let err = Format.asprintf "%a" V.Stack.TCP.pp_error e in
|
||||
failf "Error while reading: %s" err
|
||||
|
||||
let accept flow =
|
||||
let ip, port = V.Stack.TCP.dst flow in
|
||||
Logs.debug (fun f -> f "Accepted connection from %s:%d" (Ipaddr.to_string ip) port);
|
||||
V.Stack.TCP.read flow >>= function
|
||||
| Error e -> err_read e
|
||||
| Ok `Eof -> Lwt.return_unit
|
||||
| Ok (`Data _) -> failf "accept: expected to get EOF in read, but got data"
|
||||
|
||||
let test_tcp_keepalive_timeout () =
|
||||
let timeout = 15.0 in
|
||||
Lwt.pick [
|
||||
(Lwt_unix.sleep timeout >>= fun () ->
|
||||
failf "connect test timedout after %f seconds" timeout) ;
|
||||
|
||||
(V.create_stack ~cidr:server_cidr ~gateway backend >>= fun s1 ->
|
||||
V.Stack.TCP.listen (V.Stack.tcp s1) ~port:80 (fun f -> accept f);
|
||||
V.Stack.listen s1) ;
|
||||
|
||||
(Lwt_unix.sleep 0.1 >>= fun () ->
|
||||
V.create_stack ~cidr:client_cidr ~gateway backend >>= fun s2 ->
|
||||
Lwt.pick [
|
||||
V.Stack.listen s2;
|
||||
let keepalive = { Tcpip.Tcp.Keepalive.after = 0L; interval = Duration.of_sec 1; probes = 3 } in
|
||||
(let conn = V.Stack.TCP.create_connection ~keepalive (V.Stack.tcp s2) in
|
||||
or_error "connect" conn (Ipaddr.V4 (Ipaddr.V4.Prefix.address server_cidr), 80) >>= fun flow ->
|
||||
Logs.debug (fun f -> f "Connected to other end...");
|
||||
Vnetif_backends.On_off_switch.send_packets := false;
|
||||
V.Stack.TCP.read flow >>= function
|
||||
| Error e -> err_read e
|
||||
| Ok (`Data _) -> failf "read: expected to get EOF, but got data"
|
||||
| Ok `Eof ->
|
||||
Logs.debug (fun f -> f "connection read EOF as expected");
|
||||
V.Stack.TCP.close flow >>= fun () ->
|
||||
Lwt_unix.sleep 1.0 >>= fun () -> (* record some traffic after close *)
|
||||
Lwt.return_unit)]) ] >>= fun () ->
|
||||
|
||||
Lwt.return_unit
|
||||
|
||||
let record_pcap =
|
||||
V.record_pcap backend
|
||||
|
||||
end
|
||||
|
||||
let test_tcp_keepalive_timeout () =
|
||||
Test_connect.record_pcap
|
||||
"test_tcp_keepalive_timeout.pcap"
|
||||
Test_connect.test_tcp_keepalive_timeout
|
||||
|
||||
let suite_2 = [
|
||||
"check that TCP keepalives detect a network failure", `Slow,
|
||||
test_tcp_keepalive_timeout;
|
||||
]
|
||||
|
||||
let suite = suite_1 @ suite_2
|
||||
120
unikernel/duniverse/mirage-tcpip/test/test_mtus.ml
Normal file
120
unikernel/duniverse/mirage-tcpip/test/test_mtus.ml
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
open Lwt.Infix
|
||||
|
||||
let server_cidr = Ipaddr.V4.Prefix.of_string_exn "192.168.1.254/24"
|
||||
let client_cidr = Ipaddr.V4.Prefix.of_string_exn "192.168.1.10/24"
|
||||
|
||||
let server_port = 7
|
||||
|
||||
module Backend = Vnetif_backends.Frame_size_enforced
|
||||
module Stack = Vnetif_common.VNETIF_STACK(Backend)
|
||||
|
||||
let default_mtu = 1500
|
||||
|
||||
let err_fail e =
|
||||
let err = Format.asprintf "%a" Stack.Stack.TCP.pp_error e in
|
||||
Alcotest.fail err
|
||||
|
||||
let write_err_fail e =
|
||||
let err = Format.asprintf "%a" Stack.Stack.TCP.pp_write_error e in
|
||||
Alcotest.fail err
|
||||
|
||||
let rec read_all flow so_far =
|
||||
Stack.Stack.TCP.read flow >>= function
|
||||
| Error e -> err_fail e
|
||||
| Ok `Eof -> Lwt.return @@ List.rev so_far
|
||||
| Ok (`Data s) -> read_all flow (s :: so_far)
|
||||
|
||||
let read_one flow =
|
||||
Stack.Stack.TCP.read flow >>= function
|
||||
| Error e -> err_fail e
|
||||
| Ok `Eof -> Alcotest.fail "received EOF when we expected at least some data from read"
|
||||
| Ok (`Data s) -> Lwt.return s
|
||||
|
||||
let get_stacks ?client_mtu ?server_mtu backend =
|
||||
let or_default = function | None -> default_mtu | Some n -> n in
|
||||
let client_mtu, server_mtu = or_default client_mtu, or_default server_mtu in
|
||||
Stack.create_stack ~cidr:client_cidr ~mtu:client_mtu backend >>= fun client ->
|
||||
Stack.create_stack ~cidr:server_cidr ~mtu:server_mtu backend >>= fun server ->
|
||||
let max_mtu = max client_mtu server_mtu in
|
||||
Backend.set_max_ip_mtu backend max_mtu;
|
||||
Lwt.return (server, client)
|
||||
|
||||
let start_server ~f server =
|
||||
Stack.Stack.TCP.listen (Stack.Stack.tcp server) ~port:server_port f;
|
||||
Stack.Stack.listen server
|
||||
|
||||
let start_client client =
|
||||
Stack.Stack.TCP.create_connection (Stack.Stack.tcp client) (Ipaddr.V4 (Ipaddr.V4.Prefix.address server_cidr), server_port) >>= function
|
||||
| Ok connection -> Lwt.return connection
|
||||
| Error e -> err_fail e
|
||||
|
||||
let connect () =
|
||||
let backend = Backend.create () in
|
||||
get_stacks ~server_mtu:9000 backend >>= fun (server, client) ->
|
||||
Lwt.async (fun () -> start_server ~f:(fun _ -> Lwt.return_unit) server);
|
||||
start_client client >>= fun flow ->
|
||||
Stack.Stack.TCP.close flow
|
||||
|
||||
let big_server_response () =
|
||||
let response = Cstruct.create 7000 in
|
||||
Cstruct.memset response 255;
|
||||
let backend = Backend.create () in
|
||||
get_stacks ~client_mtu:1500 ~server_mtu:9000 backend >>= fun (server, client) ->
|
||||
let f flow =
|
||||
Stack.Stack.TCP.write flow response >>= function
|
||||
| Error e -> write_err_fail e
|
||||
| Ok () -> Stack.Stack.TCP.close flow
|
||||
in
|
||||
Lwt.async (fun () -> start_server ~f server);
|
||||
start_client client >>= fun flow -> read_all flow [] >>= fun l ->
|
||||
Alcotest.(check int) "received size matches sent size" (Cstruct.length response) (Cstruct.length (Cstruct.concat l));
|
||||
Stack.Stack.TCP.close flow
|
||||
|
||||
let big_client_request_chunked () =
|
||||
let request = Cstruct.create 3750 in
|
||||
Cstruct.memset request 255;
|
||||
let backend = Backend.create () in
|
||||
get_stacks ~client_mtu:1500 ~server_mtu:9000 backend >>= fun (server, client) ->
|
||||
let f flow =
|
||||
Stack.Stack.TCP.write flow request >>= function
|
||||
| Error e -> write_err_fail e
|
||||
| Ok () -> Stack.Stack.TCP.close flow
|
||||
in
|
||||
Lwt.async (fun () -> start_server ~f:(fun _flow -> Lwt.return_unit) server);
|
||||
start_client client >>= f
|
||||
|
||||
let big_server_response_not_chunked () =
|
||||
let response = Cstruct.create 7000 in
|
||||
Cstruct.memset response 255;
|
||||
let backend = Backend.create () in
|
||||
get_stacks ~client_mtu:9000 ~server_mtu:9000 backend >>= fun (server, client) ->
|
||||
let f flow =
|
||||
Stack.Stack.TCP.write flow response >>= function
|
||||
| Error e -> write_err_fail e
|
||||
| Ok () -> Stack.Stack.TCP.close flow
|
||||
in
|
||||
Lwt.async (fun () -> start_server ~f server);
|
||||
start_client client >>= fun flow -> read_one flow >>= fun buf ->
|
||||
Alcotest.(check int) "received size matches sent size" (Cstruct.length response) (Cstruct.length buf);
|
||||
Stack.Stack.TCP.close flow
|
||||
|
||||
let long_comms amt timeout () =
|
||||
(* use the iperf tests to test long-running communication between
|
||||
* the two stacks with their different link settings.
|
||||
* this helps us find bugs in situations like the TCP window expanding
|
||||
* to be larger than the MTU, and the implementation failing to
|
||||
* limit the size of the sent packet in that case. *)
|
||||
let module Test = Test_iperf.Test_iperf(Backend) in
|
||||
let backend = Backend.create () in
|
||||
get_stacks ~client_mtu:1500 ~server_mtu:9000 backend >>= fun (server, client) ->
|
||||
Test.V.record_pcap backend
|
||||
(Printf.sprintf "tcp_mtus_long_comms_%d.pcap" amt)
|
||||
(Test.tcp_iperf ~server ~client amt timeout)
|
||||
|
||||
let suite = [
|
||||
"connections work", `Quick, connect;
|
||||
"large server responses are received", `Quick, big_server_response;
|
||||
"large client requests are chunked properly", `Quick, big_client_request_chunked;
|
||||
"large messages aren't unnecessarily segmented", `Quick, big_server_response_not_chunked;
|
||||
"iperf test doesn't crash", `Quick, long_comms Test_iperf.amt_quick 120.0;
|
||||
]
|
||||
286
unikernel/duniverse/mirage-tcpip/test/test_rfc5961.ml
Normal file
286
unikernel/duniverse/mirage-tcpip/test/test_rfc5961.ml
Normal file
|
|
@ -0,0 +1,286 @@
|
|||
(*
|
||||
* Copyright (c) 2016 Pablo Polvorin <pablo.polvorin@gmail.com>
|
||||
*
|
||||
* 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 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.
|
||||
*)
|
||||
open Common
|
||||
open Lwt.Infix
|
||||
|
||||
open Low_level
|
||||
|
||||
(* Test scenarios *)
|
||||
|
||||
|
||||
(* Common sut: able to connect, connection not reset, no data received *)
|
||||
let sut_connects_and_remains_connected stack fail_callback =
|
||||
let conn = VNETIF_STACK.Stack.TCP.create_connection (VNETIF_STACK.Stack.tcp stack) in
|
||||
or_error "connect" conn (Ipaddr.V4 server_ip, 80) >>= fun flow ->
|
||||
(* We must remain blocked on read, connection shouldn't be terminated.
|
||||
* If after half second that remains true, assume test succeeds *)
|
||||
Lwt.pick [
|
||||
(VNETIF_STACK.Stack.TCP.read flow >>= fail_result_not_expected fail_callback);
|
||||
Mirage_sleep.ns (Duration.of_ms 500) ]
|
||||
|
||||
|
||||
let blind_rst_on_syn_scenario =
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
(* This -blind- reset must be ignored because of invalid ack. *)
|
||||
WIRE.xmit ~ip id ~rst:true ~rx_ack:(ack_from_past data 1)
|
||||
~seq:(Sequence.of_int32 0l) ~window ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
(* The syn-ack must be received and connection established *)
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:(ack data) ~seq:(Sequence.of_int32 0l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request")
|
||||
| `WAIT_FOR_ACK ->
|
||||
if Tcp_wire.get_ack data then (
|
||||
Lwt.return Fsm_done
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected final ack of three step dance")
|
||||
| `END ->
|
||||
Lwt.return (Fsm_error "nothing expected") in
|
||||
(`WAIT_FOR_SYN, fsm), sut_connects_and_remains_connected
|
||||
|
||||
let connection_refused_scenario =
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
(* refused *)
|
||||
WIRE.xmit ~ip id ~rst:true ~rx_ack:(ack data) ~seq:(Sequence.of_int32 0l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return Fsm_done
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request") in
|
||||
let sut stack _fail =
|
||||
let conn = VNETIF_STACK.Stack.TCP.create_connection (VNETIF_STACK.Stack.tcp stack) in
|
||||
(* connection must be rejected *)
|
||||
expect_error `Refused "connect" conn (Ipaddr.V4 server_ip, 80) in
|
||||
(`WAIT_FOR_SYN, fsm), sut
|
||||
|
||||
|
||||
let blind_rst_on_established_scenario =
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:(ack data) ~seq:(Sequence.of_int32 0l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request")
|
||||
| `WAIT_FOR_ACK ->
|
||||
if Tcp_wire.get_ack data then (
|
||||
(* This -blind- reset is acceptable, but don't exactly match the next sequence (we started at 0, this is 10).
|
||||
* Must trigger a challenge ack and not tear down the connection *)
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~rst:true ~rx_ack:None ~seq:(Sequence.of_int32 10l)
|
||||
~window ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_CHALLENGE)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected final ack of three way handshake")
|
||||
| `WAIT_FOR_CHALLENGE ->
|
||||
if (Tcp_wire.get_ack data) && (Tcp_wire.get_ack_number data = 1l) then
|
||||
Lwt.return Fsm_done
|
||||
else
|
||||
Lwt.return (Fsm_error "Challenge ack expected") in
|
||||
(`WAIT_FOR_SYN, fsm), sut_connects_and_remains_connected
|
||||
|
||||
let rst_on_established_scenario =
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:(ack data)
|
||||
~seq:(Sequence.of_int32 0l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request")
|
||||
| `WAIT_FOR_ACK ->
|
||||
if Tcp_wire.get_ack data then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
(* This reset is acceptable and exactly in sequence. Must trigger a reset on the other end *)
|
||||
WIRE.xmit ~ip id ~rst:true ~rx_ack:None ~seq:(Sequence.of_int32 1l)
|
||||
~window ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return Fsm_done
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected final ack of three step dance") in
|
||||
|
||||
let sut stack fail_callback =
|
||||
let conn = VNETIF_STACK.Stack.TCP.create_connection (VNETIF_STACK.Stack.tcp stack) in
|
||||
or_error "connect" conn (Ipaddr.V4 server_ip, 80) >>= fun flow ->
|
||||
VNETIF_STACK.Stack.TCP.read flow >>= function
|
||||
| Ok `Eof ->
|
||||
(* This is the expected when the other end resets *)
|
||||
Lwt.return_unit
|
||||
| other ->
|
||||
fail_result_not_expected fail_callback other in
|
||||
(`WAIT_FOR_SYN, fsm), sut
|
||||
|
||||
let blind_syn_on_established_scenario =
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:(ack data)
|
||||
~seq:(Sequence.of_int32 0l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request")
|
||||
| `WAIT_FOR_ACK ->
|
||||
if Tcp_wire.get_ack data then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
|
||||
(* This -blind- syn should trigger a challenge ack and not
|
||||
tear down the connection *)
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:None ~seq:(Sequence.of_int32 10l)
|
||||
~window ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_CHALLENGE)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected final ack of three step dance")
|
||||
| `WAIT_FOR_CHALLENGE ->
|
||||
if (Tcp_wire.get_ack data) && (Tcp_wire.get_ack_number data = 1l) then (
|
||||
Lwt.return Fsm_done
|
||||
) else
|
||||
Lwt.return (Fsm_error "Challenge ack expected") in
|
||||
(`WAIT_FOR_SYN, fsm), sut_connects_and_remains_connected
|
||||
|
||||
let blind_data_injection_scenario =
|
||||
let page = Cstruct.create 512 in
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:(ack data)
|
||||
~seq:(Sequence.of_int32 1000000l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request")
|
||||
| `WAIT_FOR_ACK ->
|
||||
if Tcp_wire.get_ack data then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
(* This -blind- data should trigger a challenge ack and not
|
||||
tear down the connection *)
|
||||
let invalid_ack = ack_from_past data (window +100) in
|
||||
WIRE.xmit ~ip id ~rx_ack:invalid_ack ~seq:(Sequence.of_int32 1000001l)
|
||||
~window ~options page
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_CHALLENGE)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected final ack of three step dance")
|
||||
| `WAIT_FOR_CHALLENGE ->
|
||||
if (Tcp_wire.get_ack data) && (Tcp_wire.get_ack_number data = 1000001l) then
|
||||
Lwt.return Fsm_done
|
||||
else
|
||||
Lwt.return (Fsm_error "Challenge ack expected")
|
||||
in
|
||||
(`WAIT_FOR_SYN, fsm), sut_connects_and_remains_connected
|
||||
|
||||
let data_repeated_ack_scenario =
|
||||
(* This is the just data transmission with ack in the past but within the acceptable window *)
|
||||
let page = Cstruct.create 512 in
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:(ack data)
|
||||
~seq:(Sequence.of_int32 1000000l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request")
|
||||
| `WAIT_FOR_ACK ->
|
||||
if Tcp_wire.get_ack data then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
(* Ack is old but within the acceptable window. *)
|
||||
let valid_ack = ack_from_past data (window -100) in
|
||||
WIRE.xmit ~ip id ~rx_ack:valid_ack ~seq:(Sequence.of_int32 1000001l)
|
||||
~window ~options page
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_DATA_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected final ack of three step dance")
|
||||
| `WAIT_FOR_DATA_ACK ->
|
||||
if (Tcp_wire.get_ack data) && (Tcp_wire.get_ack_number data = Int32.(add 1000001l (of_int (Cstruct.length page)))) then
|
||||
Lwt.return Fsm_done
|
||||
else
|
||||
Lwt.return (Fsm_error "Ack for data expected") in
|
||||
|
||||
let sut stack fail_callback =
|
||||
let conn = VNETIF_STACK.Stack.TCP.create_connection (VNETIF_STACK.Stack.tcp stack) in
|
||||
or_error "connect" conn (Ipaddr.V4 server_ip, 80) >>= fun flow ->
|
||||
(* We should receive the data *)
|
||||
VNETIF_STACK.Stack.TCP.read flow >>= function
|
||||
| Ok _ -> Lwt.return_unit
|
||||
| other -> fail_result_not_expected fail_callback other in
|
||||
(`WAIT_FOR_SYN, fsm), sut
|
||||
|
||||
|
||||
let run_test pcap_file ((initial_state, fsm), sut) () =
|
||||
let backend = VNETIF_STACK.create_backend () in
|
||||
VNETIF_STACK.record_pcap backend pcap_file (run backend (initial_state, fsm) sut)
|
||||
|
||||
let suite = [
|
||||
"blind rst to syn_sent", `Quick,
|
||||
run_test "tcp_blind_rst_on_syn.pcap" blind_rst_on_syn_scenario ;
|
||||
|
||||
"connection refused", `Quick,
|
||||
run_test "tcp_connection_refused.pcap" connection_refused_scenario;
|
||||
|
||||
"blind rst on established", `Quick,
|
||||
run_test "tcp_blind_rst_on_established.pcap" blind_rst_on_established_scenario;
|
||||
|
||||
"rst on established", `Quick,
|
||||
run_test "tcp_rst_on_established.pcap" rst_on_established_scenario;
|
||||
|
||||
"blind syn on established", `Quick,
|
||||
run_test "tcp_blind_syn_on_established.pcap" blind_syn_on_established_scenario;
|
||||
|
||||
"blind data injection", `Quick,
|
||||
run_test "tcp_blind_data_injection.pcap" blind_data_injection_scenario;
|
||||
|
||||
"data repeated ack", `Quick,
|
||||
run_test "tcp_data_repeated_ack.pcap" data_repeated_ack_scenario;
|
||||
]
|
||||
111
unikernel/duniverse/mirage-tcpip/test/test_simulatenous_close.ml
Normal file
111
unikernel/duniverse/mirage-tcpip/test/test_simulatenous_close.ml
Normal file
|
|
@ -0,0 +1,111 @@
|
|||
open Common
|
||||
|
||||
open Low_level
|
||||
open Lwt.Infix
|
||||
|
||||
let close_ack_scenario =
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:(ack data)
|
||||
~seq:(Sequence.of_int32 1000000l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request")
|
||||
| `WAIT_FOR_ACK ->
|
||||
if Tcp_wire.get_ack data then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~rx_ack:(ack data) ~fin:true ~seq:(Sequence.of_int32 1000001l)
|
||||
~window ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_FIN)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected final ack of three step dance")
|
||||
| `WAIT_FOR_FIN ->
|
||||
if (Tcp_wire.get_fin data) then
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~rx_ack:(ack data) ~seq:(Sequence.of_int32 1000002l)
|
||||
~window:0 ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return Fsm_done
|
||||
else
|
||||
Lwt.return (Fsm_error "Fin expected") in
|
||||
|
||||
let sut stack _fail_callback =
|
||||
let conn = VNETIF_STACK.Stack.TCP.create_connection (VNETIF_STACK.Stack.tcp stack) in
|
||||
or_error "connect" conn (Ipaddr.V4 server_ip, 80) >>= fun flow ->
|
||||
(* We should receive the data *)
|
||||
VNETIF_STACK.Stack.TCP.close flow >>= fun () ->
|
||||
Lwt_unix.sleep 4.0 >>= fun () ->
|
||||
Alcotest.(check int) "connection is cleaned" 0 (VNETIF_STACK.T.num_open_channels ((VNETIF_STACK.Stack.tcp stack)));
|
||||
Lwt.return_unit
|
||||
in
|
||||
(`WAIT_FOR_SYN, fsm), sut
|
||||
|
||||
let close_reset_scenario =
|
||||
let fsm ip state ~src ~dst data =
|
||||
match state with
|
||||
| `WAIT_FOR_SYN ->
|
||||
let syn = Tcp_wire.get_syn data in
|
||||
if syn then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~syn:true ~rx_ack:(ack data)
|
||||
~seq:(Sequence.of_int32 1000000l) ~window
|
||||
~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_ACK)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected initial syn request")
|
||||
| `WAIT_FOR_ACK ->
|
||||
if Tcp_wire.get_ack data then (
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~rx_ack:(ack data) ~fin:true ~seq:(Sequence.of_int32 1000001l)
|
||||
~window ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_FIN)
|
||||
) else
|
||||
Lwt.return (Fsm_error "Expected final ack of three step dance")
|
||||
| `WAIT_FOR_FIN ->
|
||||
if (Tcp_wire.get_fin data) then
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~rx_ack:None ~rst:true ~seq:(Sequence.of_int32 1000001l)
|
||||
~window:0 ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_next `WAIT_FOR_CHALLENGE_ACK)
|
||||
else
|
||||
Lwt.return (Fsm_error "Expected fin")
|
||||
| `WAIT_FOR_CHALLENGE_ACK ->
|
||||
if (Tcp_wire.get_ack data) then
|
||||
let id = reply_id_from ~src ~dst data in
|
||||
WIRE.xmit ~ip id ~rx_ack:None ~rst:true ~seq:(Sequence.of_int32 1000002l)
|
||||
~window:0 ~options (Cstruct.create 0)
|
||||
>|= Result.get_ok >>= fun () ->
|
||||
Lwt.return (Fsm_done)
|
||||
else
|
||||
Lwt.return (Fsm_error "Expected challenge ack")
|
||||
in
|
||||
|
||||
let sut stack _fail_callback =
|
||||
let conn = VNETIF_STACK.Stack.TCP.create_connection (VNETIF_STACK.Stack.tcp stack) in
|
||||
or_error "connect" conn (Ipaddr.V4 server_ip, 80) >>= fun flow ->
|
||||
(* We should receive the data *)
|
||||
VNETIF_STACK.Stack.TCP.close flow >>= fun () ->
|
||||
Lwt_unix.sleep 4.0 >>= fun () ->
|
||||
Alcotest.(check int) "connection is cleaned" 0 (VNETIF_STACK.T.num_open_channels ((VNETIF_STACK.Stack.tcp stack)));
|
||||
Lwt.return_unit
|
||||
in
|
||||
(`WAIT_FOR_SYN, fsm), sut
|
||||
|
||||
let run_test pcap_file ((initial_state, fsm), sut) () =
|
||||
let backend = VNETIF_STACK.create_backend () in
|
||||
VNETIF_STACK.record_pcap backend pcap_file (run backend (initial_state, fsm) sut)
|
||||
|
||||
let suite = [
|
||||
"close with ack", `Slow, run_test "close_ack.pcap" close_ack_scenario;
|
||||
"close with reset, challenge ack ok", `Slow, run_test "close_reset.pcap" close_reset_scenario;
|
||||
]
|
||||
167
unikernel/duniverse/mirage-tcpip/test/test_socket.ml
Normal file
167
unikernel/duniverse/mirage-tcpip/test/test_socket.ml
Normal file
|
|
@ -0,0 +1,167 @@
|
|||
open Lwt.Infix
|
||||
|
||||
let or_fail_str ~str f args =
|
||||
f args >>= function
|
||||
| `Ok p -> Lwt.return p
|
||||
| `Error _ -> Alcotest.fail str
|
||||
|
||||
let localhost = Ipaddr.V4.of_string_exn "127.0.0.1"
|
||||
let localhost_cidr = Ipaddr.V4.Prefix.make 32 localhost
|
||||
|
||||
module Stackv4v6 = Tcpip_stack_socket.V4V6
|
||||
|
||||
let make_v4v6_stack ipv4_only ipv6_only ipv4 ipv6 =
|
||||
Tcpv4v6_socket.connect ~ipv4_only ~ipv6_only ipv4 ipv6 >>= fun tcp ->
|
||||
Udpv4v6_socket.connect ~ipv4_only ~ipv6_only ipv4 ipv6 >>= fun udp ->
|
||||
Stackv4v6.connect udp tcp >|= fun stack ->
|
||||
stack
|
||||
|
||||
let ip4_any = Ipaddr.V4.Prefix.global (* 0.0.0.0/0 *)
|
||||
|
||||
let two_connect_tcp () =
|
||||
let announce flow =
|
||||
Tcpv4v6_socket.read flow >>= function
|
||||
| Error _ -> Printf.printf "Error reading!"; Alcotest.fail "Error reading TCP flow"
|
||||
| Ok `Eof -> Printf.printf "EOF!"; Lwt.return_unit
|
||||
| Ok (`Data buf) -> Printf.printf "Buffer received: %s\n%!" (Cstruct.to_string buf);
|
||||
Lwt.return_unit
|
||||
in
|
||||
let server_port = 14041 in
|
||||
make_v4v6_stack true false localhost_cidr None >>= fun server ->
|
||||
make_v4v6_stack true false localhost_cidr None >>= fun client ->
|
||||
let teardown () =
|
||||
Stackv4v6.disconnect server >>= fun () ->
|
||||
Stackv4v6.disconnect client
|
||||
in
|
||||
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp server) ~port:server_port announce;
|
||||
Lwt.pick [
|
||||
Stackv4v6.listen server;
|
||||
Stackv4v6.TCP.create_connection (Stackv4v6.tcp client) (Ipaddr.V4 localhost, server_port) >|= Result.get_ok >>= fun flow ->
|
||||
Stackv4v6.TCP.write flow (Cstruct.of_string "test!") >>= function
|
||||
| Ok () -> Stackv4v6.TCP.close flow >>= fun () -> teardown ()
|
||||
| Error _ -> teardown () >>= fun () -> Alcotest.fail "Error writing to socket for TCP test"
|
||||
]
|
||||
|
||||
let icmp_echo_request () =
|
||||
Icmpv4_socket.connect () >>= fun server ->
|
||||
Icmpv4_socket.connect () >>= fun client ->
|
||||
let echo_request = Icmpv4_packet.(Marshal.make_cstruct
|
||||
~payload:(Cstruct.create 0)
|
||||
{ ty = Icmpv4_wire.Echo_request;
|
||||
code = 0x00;
|
||||
subheader = Id_and_seq (0x1dea, 0x0001)
|
||||
}) in
|
||||
let received_icmp = ref 0 in
|
||||
let log_and_count buf =
|
||||
received_icmp := !received_icmp + 1;
|
||||
Logs.debug (fun f -> f "received ICMP packet number %d: %a" !received_icmp Cstruct.hexdump_pp buf);
|
||||
Lwt.return_unit
|
||||
in
|
||||
Lwt.pick [
|
||||
Icmpv4_socket.listen server localhost log_and_count;
|
||||
Mirage_sleep.ns (Duration.of_ms 500) >>= fun () ->
|
||||
Icmpv4_socket.write client ~dst:localhost echo_request >|= Result.get_ok >>= fun () ->
|
||||
Mirage_sleep.ns (Duration.of_sec 10);
|
||||
] >>= fun () ->
|
||||
Icmpv4_socket.disconnect server >>= fun () ->
|
||||
Icmpv4_socket.disconnect client >|= fun () ->
|
||||
Alcotest.(check int) "number of ICMP packets received by listener"
|
||||
1 !received_icmp
|
||||
|
||||
let no_leak_fds_in_tcpv4v6 () =
|
||||
make_v4v6_stack false false ip4_any None >>= fun stack1 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack1) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack false false ip4_any None >>= fun stack2 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack2) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let no_leak_fds_in_udpv4v6 () =
|
||||
make_v4v6_stack false false ip4_any None >>= fun stack1 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack1) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack false false ip4_any None >>= fun stack2 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack2) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let no_leak_fds_in_tcpv4v6_2 () =
|
||||
make_v4v6_stack false false localhost_cidr None >>= fun stack1 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack1) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack false false localhost_cidr None >>= fun stack2 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack2) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let no_leak_fds_in_udpv4v6_2 () =
|
||||
make_v4v6_stack false false localhost_cidr None >>= fun stack1 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack1) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack false false localhost_cidr None >>= fun stack2 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack2) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let ip6_local = Some Ipaddr.V6.(Prefix.of_addr localhost)
|
||||
|
||||
let no_leak_fds_in_tcpv4v6_3 () =
|
||||
make_v4v6_stack false false localhost_cidr ip6_local >>= fun stack1 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack1) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack false false localhost_cidr ip6_local >>= fun stack2 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack2) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let no_leak_fds_in_udpv4v6_3 () =
|
||||
make_v4v6_stack false false localhost_cidr ip6_local >>= fun stack1 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack1) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack false false localhost_cidr ip6_local >>= fun stack2 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack2) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let no_leak_fds_in_tcpv4v6_4 () =
|
||||
make_v4v6_stack true false localhost_cidr ip6_local >>= fun stack1 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack1) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack true false localhost_cidr ip6_local >>= fun stack2 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack2) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let no_leak_fds_in_udpv4v6_4 () =
|
||||
make_v4v6_stack true false localhost_cidr ip6_local >>= fun stack1 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack1) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack true false localhost_cidr ip6_local >>= fun stack2 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack2) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let no_leak_fds_in_tcpv4v6_5 () =
|
||||
make_v4v6_stack false true localhost_cidr ip6_local >>= fun stack1 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack1) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack false true localhost_cidr ip6_local >>= fun stack2 ->
|
||||
Stackv4v6.TCP.listen (Stackv4v6.tcp stack2) ~port:1234 (fun _flow -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let no_leak_fds_in_udpv4v6_5 () =
|
||||
make_v4v6_stack false true localhost_cidr ip6_local >>= fun stack1 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack1) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack1 >>= fun () ->
|
||||
make_v4v6_stack false true localhost_cidr ip6_local >>= fun stack2 ->
|
||||
Stackv4v6.UDP.listen (Stackv4v6.udp stack2) ~port:1234 (fun ~src:_ ~dst:_ ~src_port:_ _cs -> Lwt.return_unit);
|
||||
Stackv4v6.disconnect stack2
|
||||
|
||||
let suite = [
|
||||
"two sockets connect via TCP", `Quick, two_connect_tcp;
|
||||
"icmp echo-requests are sent", `Slow, icmp_echo_request;
|
||||
"file descriptors are not leaked in tcpv4v6 (any)", `Quick, no_leak_fds_in_tcpv4v6;
|
||||
"file descriptors are not leaked in udpv4v6 (any)", `Quick, no_leak_fds_in_udpv4v6;
|
||||
"file descriptors are not leaked in tcpv4v6 (v4)", `Quick, no_leak_fds_in_tcpv4v6_2;
|
||||
"file descriptors are not leaked in udpv4v6 (v4)", `Quick, no_leak_fds_in_udpv4v6_2;
|
||||
"file descriptors are not leaked in tcpv4v6 (v4v6)", `Quick, no_leak_fds_in_tcpv4v6_3;
|
||||
"file descriptors are not leaked in udpv4v6 (v4v6)", `Quick, no_leak_fds_in_udpv4v6_3;
|
||||
"file descriptors are not leaked in tcpv4v6 (v4 only)", `Quick, no_leak_fds_in_tcpv4v6_4;
|
||||
"file descriptors are not leaked in udpv4v6 (v4 only)", `Quick, no_leak_fds_in_udpv4v6_4;
|
||||
"file descriptors are not leaked in tcpv4v6 (v6 only)", `Quick, no_leak_fds_in_tcpv4v6_5;
|
||||
"file descriptors are not leaked in udpv4v6 (v6 only)", `Quick, no_leak_fds_in_udpv4v6_5;
|
||||
]
|
||||
284
unikernel/duniverse/mirage-tcpip/test/test_tcp_options.ml
Normal file
284
unikernel/duniverse/mirage-tcpip/test/test_tcp_options.ml
Normal file
|
|
@ -0,0 +1,284 @@
|
|||
open Common
|
||||
|
||||
let check = Alcotest.(check @@ result (list options) string)
|
||||
|
||||
let errors ?(check_msg = false) exp = function
|
||||
| Ok opt -> failf "Ok %a when Error %s expected" Tcp.Options.pps opt exp
|
||||
| Error p -> if check_msg then
|
||||
Alcotest.(check string)
|
||||
"Error didn't give the expected error message" exp p
|
||||
else ()
|
||||
|
||||
let test_unmarshal_bad_mss () =
|
||||
let odd_sized_mss = Cstruct.create 3 in
|
||||
Cstruct.set_uint8 odd_sized_mss 0 2;
|
||||
Cstruct.set_uint8 odd_sized_mss 1 3;
|
||||
Cstruct.set_uint8 odd_sized_mss 2 255;
|
||||
errors "MSS size is unreasonable" (Tcp.Options.unmarshal odd_sized_mss)
|
||||
|
||||
let test_unmarshal_bogus_length () =
|
||||
let bogus = Cstruct.create (4*8-1) in
|
||||
Cstruct.memset bogus 0;
|
||||
Cstruct.blit_from_string "\x6e\x73\x73\x68\x2e\x63\x6f\x6d" 0 bogus 0 8;
|
||||
(* some unknown option (0x6e) with claimed length 0x73, longer than
|
||||
the buffer. This invalidates later results, but previous ones are
|
||||
still valid, if any *)
|
||||
check "length" (Ok []) (Tcp.Options.unmarshal bogus)
|
||||
|
||||
let test_unmarshal_zero_length () =
|
||||
let bogus = Cstruct.create 10 in
|
||||
Cstruct.memset bogus 1; (* noops *)
|
||||
Cstruct.set_uint8 bogus 0 64; (* arbitrary unknown option-kind *)
|
||||
Cstruct.set_uint8 bogus 1 0;
|
||||
(* this invalidates later results, but previous ones are still
|
||||
valid, if any *)
|
||||
check "zero" (Ok []) (Tcp.Options.unmarshal bogus)
|
||||
|
||||
let test_unmarshal_simple_options () =
|
||||
(* empty buffer should give empty list *)
|
||||
check "simple" (Ok []) (Tcp.Options.unmarshal (Cstruct.create 0));
|
||||
|
||||
(* buffer with just eof should give empty list *)
|
||||
let just_eof = Cstruct.create 1 in
|
||||
Cstruct.set_uint8 just_eof 0 0;
|
||||
check "eof" (Ok []) (Tcp.Options.unmarshal just_eof);
|
||||
|
||||
(* buffer with single noop should give a list with 1 noop *)
|
||||
let just_noop = Cstruct.create 1 in
|
||||
Cstruct.set_uint8 just_noop 0 1;
|
||||
check "noop" (Ok [ Tcp.Options.Noop ]) (Tcp.Options.unmarshal just_noop);
|
||||
|
||||
(* buffer with valid, but unknown, option should be correctly communicated *)
|
||||
let unknown = Cstruct.create 10 in
|
||||
let data = "hi mom!!" in
|
||||
let kind = 18 in (* TODO: more canonically unknown option-kind *)
|
||||
Cstruct.blit_from_string data 0 unknown 2 (String.length data);
|
||||
Cstruct.set_uint8 unknown 0 kind;
|
||||
Cstruct.set_uint8 unknown 1 (Cstruct.length unknown);
|
||||
check "more"
|
||||
(Ok [Tcp.Options.Unknown (kind, data)])
|
||||
(Tcp.Options.unmarshal unknown)
|
||||
|
||||
let test_unmarshal_stops_at_eof () =
|
||||
let buf = Cstruct.create 14 in
|
||||
let ts1 = 0xabad1deal in
|
||||
let ts2 = 0xc0ffee33l in
|
||||
Cstruct.memset buf 0;
|
||||
Cstruct.set_uint8 buf 0 4; (* sack_ok *)
|
||||
Cstruct.set_uint8 buf 1 2; (* length of two *)
|
||||
Cstruct.set_uint8 buf 2 1; (* noop *)
|
||||
Cstruct.set_uint8 buf 3 0; (* eof *)
|
||||
Cstruct.set_uint8 buf 4 8; (* timestamp *)
|
||||
Cstruct.set_uint8 buf 5 10; (* timestamps are 2 4-byte times *)
|
||||
Cstruct.BE.set_uint32 buf 6 ts1;
|
||||
Cstruct.BE.set_uint32 buf 10 ts2;
|
||||
(* correct parsing will ignore options from after eof, so we shouldn't see
|
||||
timestamp or noop *)
|
||||
match Tcp.Options.unmarshal buf with
|
||||
| Error s -> Alcotest.fail s
|
||||
| Ok result ->
|
||||
Alcotest.(check bool) "SACK_ok missing"
|
||||
true (List.mem Tcp.Options.SACK_ok result);
|
||||
Alcotest.(check bool) "noop missing"
|
||||
true (List.mem Tcp.Options.Noop result);
|
||||
Alcotest.(check bool) "timestamp present"
|
||||
false (List.mem (Tcp.Options.Timestamp (ts1, ts2)) result)
|
||||
|
||||
let test_unmarshal_ok_options () =
|
||||
let buf = Cstruct.create 8 in
|
||||
Cstruct.memset buf 0;
|
||||
let opts = [ Tcp.Options.MSS 536; Tcp.Options.SACK_ok; Tcp.Options.Noop;
|
||||
Tcp.Options.Noop ] in
|
||||
let marshalled = Tcp.Options.marshal buf opts in
|
||||
Alcotest.(check int) "marshalled" marshalled 8;
|
||||
(* order is reversed by the unmarshaller, which is fine but we need to
|
||||
account for that when making equality assertions *)
|
||||
match Tcp.Options.unmarshal buf with
|
||||
| Error s -> Alcotest.fail s
|
||||
| Ok l -> Alcotest.(check @@ list options) "l" l opts
|
||||
|
||||
let test_unmarshal_random_data () =
|
||||
let random = Cstruct.create 64 in
|
||||
let iterations = 100 in
|
||||
Random.self_init ();
|
||||
let set_random pos =
|
||||
let num = Random.int32 Int32.max_int in
|
||||
Cstruct.BE.set_uint32 random pos num;
|
||||
in
|
||||
let rec check = function
|
||||
| n when n <= 0 -> ()
|
||||
| n ->
|
||||
List.iter set_random [0;4;8;12;16;20;24;28;32;36;40;44;48;52;56;60];
|
||||
Cstruct.hexdump random;
|
||||
(* acceptable outcomes: some list of options or the expected exception *)
|
||||
match Tcp.Options.unmarshal random with
|
||||
| Error _ -> (* Errors are OK, just finish *) ()
|
||||
| Ok l ->
|
||||
Tcp.Options.pps Format.std_formatter l;
|
||||
(* a really basic truth: the longest list we can have is 64 noops *)
|
||||
Alcotest.(check bool) "random" true (List.length l < 65);
|
||||
check (n - 1)
|
||||
in
|
||||
check iterations
|
||||
|
||||
let test_marshal_unknown () =
|
||||
let buf = Cstruct.create 10 in
|
||||
Cstruct.memset buf 255;
|
||||
let unknown = [ Tcp.Options.Unknown (64, " ") ] in (* overall, length 4 *)
|
||||
Alcotest.(check int) "4 bytes"
|
||||
4 (Tcp.Options.marshal buf unknown); (* should have written 4 bytes *)
|
||||
Cstruct.hexdump buf;
|
||||
(* option-kind *)
|
||||
Alcotest.(check int) "option kind" 64 (Cstruct.get_uint8 buf 0);
|
||||
(* option-length *)
|
||||
Alcotest.(check int)"option length" 4 (Cstruct.get_uint8 buf 1);
|
||||
(* data *)
|
||||
Alcotest.(check int) "data 1" 0x20 (Cstruct.get_uint8 buf 2);
|
||||
(* moar data *)
|
||||
Alcotest.(check int) "data 2" 0x20 (Cstruct.get_uint8 buf 3);
|
||||
(* unwritten region *)
|
||||
Alcotest.(check int) "canary" 255 (Cstruct.get_uint8 buf 4)
|
||||
|
||||
let test_options_marshal_padding () =
|
||||
let buf = Cstruct.create 8 in
|
||||
Cstruct.memset buf 255;
|
||||
let extract = Cstruct.get_uint8 buf in
|
||||
let needs_padding = [ Tcp.Options.SACK_ok ] in
|
||||
Alcotest.(check int) "padding" 4 (Tcp.Options.marshal buf needs_padding);
|
||||
Alcotest.(check int) "extract 0" 4 (extract 0);
|
||||
Alcotest.(check int) "extract 1" 2 (extract 1);
|
||||
(* should pad out the rest of the buffer with 0 *)
|
||||
Alcotest.(check int) "extract 2" 0 (extract 2);
|
||||
Alcotest.(check int) "extract 3" 0 (extract 3);
|
||||
(* but not keep padding into random memory *)
|
||||
Alcotest.(check int) "extract 4" 255 (extract 4)
|
||||
|
||||
let test_marshal_empty () =
|
||||
let buf = Cstruct.create 4 in
|
||||
Cstruct.memset buf 255;
|
||||
Alcotest.(check int) "0" 0 (Tcp.Options.marshal buf []);
|
||||
Alcotest.(check int) "255" 255 (Cstruct.get_uint8 buf 0)
|
||||
|
||||
let test_marshal_into_cstruct () =
|
||||
let options = [
|
||||
Tcp.Options.MSS 1460;
|
||||
Tcp.Options.SACK_ok;
|
||||
Tcp.Options.Window_size_shift 2
|
||||
] in
|
||||
(* MSS is 4 bytes, SACK_OK is 4 bytes, window_size_shift is 3, plus
|
||||
1 for padding *)
|
||||
let options_size = 12 in
|
||||
let buf = Cstruct.create (Tcp.Tcp_wire.sizeof_tcp + options_size) in
|
||||
Cstruct.memset buf 255;
|
||||
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; id = 0 ; off = 0 ; options = Cstruct.create 0}
|
||||
in
|
||||
let payload = Cstruct.of_string "ab" in
|
||||
let pseudoheader =
|
||||
Ipv4_packet.Marshal.pseudoheader ~src ~dst ~proto:`TCP
|
||||
(Tcp.Tcp_wire.sizeof_tcp + options_size + Cstruct.length payload)
|
||||
in
|
||||
let packet =
|
||||
Tcp.Tcp_packet.{
|
||||
urg = false;
|
||||
ack = true;
|
||||
psh = false;
|
||||
rst = false;
|
||||
syn = true;
|
||||
fin = false;
|
||||
window = 0;
|
||||
options;
|
||||
sequence = Tcp.Sequence.of_int 255;
|
||||
ack_number = Tcp.Sequence.of_int 1024;
|
||||
src_port = 3000;
|
||||
dst_port = 6667;
|
||||
}
|
||||
in
|
||||
Tcp.Tcp_packet.Marshal.into_cstruct ~pseudoheader ~payload packet buf
|
||||
|> Alcotest.(check (result int string)) "correct size written"
|
||||
(Ok (Cstruct.length buf));
|
||||
let raw =Cstruct.concat [buf; payload] in
|
||||
Ipv4_packet.Unmarshal.verify_transport_checksum ~proto:`TCP ~ipv4_header
|
||||
~transport_packet:raw
|
||||
|> Alcotest.(check bool) "Checksum correct" true;
|
||||
Tcp.Tcp_packet.Unmarshal.of_cstruct raw
|
||||
|> Alcotest.(check (result (pair tcp_packet cstruct) string))
|
||||
"reload TCP packet" (Ok (packet, payload));
|
||||
let just_options = Cstruct.create options_size in
|
||||
let generated_options = Cstruct.shift buf Tcp.Tcp_wire.sizeof_tcp in
|
||||
Alcotest.(check int) "size of options buf" options_size @@
|
||||
Tcp.Options.marshal just_options options;
|
||||
(* expecting the result of Options.Marshal to be here *)
|
||||
Alcotest.check cstruct "marshalled options are as expected"
|
||||
just_options generated_options;
|
||||
(* Now try with make_cstruct *)
|
||||
let headers =
|
||||
Tcp.Tcp_packet.Marshal.make_cstruct ~pseudoheader ~payload packet
|
||||
in
|
||||
let raw =Cstruct.concat [headers; payload] in
|
||||
Ipv4_packet.Unmarshal.verify_transport_checksum ~proto:`TCP ~ipv4_header
|
||||
~transport_packet:raw
|
||||
|> Alcotest.(check bool) "Checksum correct" true
|
||||
|
||||
let test_marshal_without_padding () =
|
||||
let options = [ Tcp.Options.MSS 1460 ] in
|
||||
let options_size = 4 in (* MSS is 4 bytes *)
|
||||
let buf = Cstruct.create (Tcp.Tcp_wire.sizeof_tcp + options_size) in
|
||||
Cstruct.memset buf 255;
|
||||
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; id = 0 ; off = 0 ; options = Cstruct.create 0}
|
||||
in
|
||||
let payload = Cstruct.of_string "\x02\x04\x05\xb4" in
|
||||
let pseudoheader =
|
||||
Ipv4_packet.Marshal.pseudoheader ~src ~dst ~proto:`TCP
|
||||
(Tcp.Tcp_wire.sizeof_tcp + options_size + Cstruct.length payload)
|
||||
in
|
||||
let packet =
|
||||
Tcp.Tcp_packet.{
|
||||
urg = false;
|
||||
ack = true;
|
||||
psh = false;
|
||||
rst = false;
|
||||
syn = true;
|
||||
fin = false;
|
||||
window = 0;
|
||||
options;
|
||||
sequence = Tcp.Sequence.of_int 255;
|
||||
ack_number = Tcp.Sequence.of_int 1024;
|
||||
src_port = 3000;
|
||||
dst_port = 6667;
|
||||
}
|
||||
in
|
||||
Tcp.Tcp_packet.Marshal.into_cstruct ~pseudoheader ~payload packet buf
|
||||
|> Alcotest.(check (result int string)) "correct size written"
|
||||
(Ok (Cstruct.length buf));
|
||||
let raw =Cstruct.concat [buf; payload] in
|
||||
Ipv4_packet.Unmarshal.verify_transport_checksum ~proto:`TCP ~ipv4_header
|
||||
~transport_packet:raw
|
||||
|> Alcotest.(check bool) "Checksum correct" true;
|
||||
Tcp.Tcp_packet.Unmarshal.of_cstruct raw
|
||||
|> Alcotest.(check (result (pair tcp_packet cstruct) string))
|
||||
"reload TCP packet" (Ok (packet, payload))
|
||||
|
||||
let suite = [
|
||||
"unmarshal broken mss", `Quick, test_unmarshal_bad_mss;
|
||||
"unmarshal option with bogus length", `Quick, test_unmarshal_bogus_length;
|
||||
"unmarshal option with zero length", `Quick, test_unmarshal_zero_length;
|
||||
"unmarshal simple cases", `Quick, test_unmarshal_simple_options;
|
||||
"unmarshal stops at eof", `Quick, test_unmarshal_stops_at_eof;
|
||||
"unmarshal non-broken tcp options", `Quick, test_unmarshal_ok_options;
|
||||
"unmarshalling random data returns", `Quick, test_unmarshal_random_data;
|
||||
"test marshalling into a cstruct", `Quick, test_marshal_into_cstruct;
|
||||
"test marshalling without padding", `Quick, test_marshal_without_padding;
|
||||
"test marshalling an unknown value", `Quick, test_marshal_unknown;
|
||||
"test options marshalling when padding is needed", `Quick,
|
||||
test_options_marshal_padding;
|
||||
"test marshalling the empty list", `Quick, test_marshal_empty;
|
||||
]
|
||||
|
||||
let suite =
|
||||
List.map (fun (n, s, f) -> n, s, (fun () -> Lwt.return (f ()))) suite
|
||||
90
unikernel/duniverse/mirage-tcpip/test/test_udp.ml
Normal file
90
unikernel/duniverse/mirage-tcpip/test/test_udp.ml
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
open Common
|
||||
|
||||
module B = Basic_backend.Make
|
||||
module V = Vnetif.Make(B)
|
||||
module E = Ethernet.Make(V)
|
||||
module Static_arp = Static_arp.Make(E)
|
||||
module Ip = Static_ipv4.Make(E)(Static_arp)
|
||||
module Udp = Udp.Make(Ip)
|
||||
|
||||
type stack = {
|
||||
backend : B.t;
|
||||
netif : V.t;
|
||||
ethif : E.t;
|
||||
arp : Static_arp.t;
|
||||
ip : Ip.t;
|
||||
udp : Udp.t;
|
||||
}
|
||||
|
||||
let get_stack ?(backend = B.create ~use_async_readers:true
|
||||
~yield:(fun() -> Lwt.pause ()) ()) ip =
|
||||
let open Lwt.Infix in
|
||||
let cidr = Ipaddr.V4.Prefix.make 24 ip in
|
||||
V.connect backend >>= fun netif ->
|
||||
E.connect netif >>= fun ethif ->
|
||||
Static_arp.connect ethif >>= fun arp ->
|
||||
Ip.connect ~cidr ethif arp >>= fun ip ->
|
||||
Udp.connect ip >>= fun udp ->
|
||||
Lwt.return { backend; netif; ethif; arp; ip; udp }
|
||||
|
||||
let fails msg f args =
|
||||
match f args with
|
||||
| Ok _ -> Alcotest.fail msg
|
||||
| Error _ -> ()
|
||||
|
||||
let marshal_unmarshal () =
|
||||
let parse = Udp_packet.Unmarshal.of_cstruct in
|
||||
fails "unmarshal a 0-length packet" parse (Cstruct.create 0);
|
||||
fails "unmarshal a too-short packet" parse (Cstruct.create 2);
|
||||
let with_data = Cstruct.create 8 in
|
||||
Cstruct.memset with_data 0;
|
||||
Udp_wire.set_src_port with_data 2000;
|
||||
Udp_wire.set_dst_port with_data 21;
|
||||
Udp_wire.set_length with_data 20;
|
||||
let payload = Cstruct.of_string "abcdefgh1234" in
|
||||
let with_data = Cstruct.concat [with_data; payload] in
|
||||
match Udp_packet.Unmarshal.of_cstruct with_data with
|
||||
| Error s -> Alcotest.fail s
|
||||
| Ok (_header, data) ->
|
||||
Alcotest.(check cstruct) "unmarshalling gives expected data" payload data;
|
||||
Lwt.return_unit
|
||||
|
||||
let write () =
|
||||
let open Lwt.Infix in
|
||||
let dst = Ipaddr.V4.of_string_exn "192.168.4.20" in
|
||||
get_stack dst >>= fun stack ->
|
||||
Static_arp.add_entry stack.arp dst (Macaddr.of_string_exn "00:16:3e:ab:cd:ef");
|
||||
Udp.write ~src_port:1212 ~dst_port:21 ~dst stack.udp (Cstruct.of_string "MGET *") >|= Result.get_ok
|
||||
|
||||
let unmarshal_regression () =
|
||||
let i = Cstruct.create 1016 in
|
||||
Cstruct.memset i 30;
|
||||
Cstruct.set_char i 4 '\x04';
|
||||
Cstruct.set_char i 5 '\x00';
|
||||
Alcotest.(check (result reject pass)) "correctly return error for bad packet"
|
||||
(Error "parse failed") (Udp_packet.Unmarshal.of_cstruct i);
|
||||
Lwt.return_unit
|
||||
|
||||
|
||||
let marshal_marshal () =
|
||||
let error_str = Alcotest.result Alcotest.reject Alcotest.string in
|
||||
let udp = {Udp_packet.src_port = 1; dst_port = 2} in
|
||||
let payload = Cstruct.create 100 in
|
||||
let buffer = Cstruct.create Udp_wire.sizeof_udp in
|
||||
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 pseudoheader = Ipv4_packet.Marshal.pseudoheader ~src ~dst ~proto:`UDP (Cstruct.length buffer + Cstruct.length payload) in
|
||||
Udp_packet.Marshal.into_cstruct ~pseudoheader ~payload udp (Cstruct.shift buffer 1)
|
||||
|> Alcotest.check error_str "Buffer too short" (Error "Not enough space for a UDP header");
|
||||
Udp_packet.Marshal.into_cstruct ~pseudoheader ~payload udp buffer
|
||||
|> Alcotest.(check (result unit string)) "Buffer big enough for header" (Ok ());
|
||||
Udp_packet.Unmarshal.of_cstruct (Cstruct.concat [buffer; payload])
|
||||
|> Alcotest.(check (result (pair udp_packet cstruct) string)) "Save and reload" (Ok (udp, payload));
|
||||
Lwt.return_unit
|
||||
|
||||
let suite = [
|
||||
"unmarshal regression", `Quick, unmarshal_regression;
|
||||
"marshal/marshal", `Quick, marshal_marshal;
|
||||
"marshal/unmarshal", `Quick, marshal_unmarshal;
|
||||
"write packets", `Quick, write;
|
||||
]
|
||||
221
unikernel/duniverse/mirage-tcpip/test/vnetif_backends.ml
Normal file
221
unikernel/duniverse/mirage-tcpip/test/vnetif_backends.ml
Normal file
|
|
@ -0,0 +1,221 @@
|
|||
(*
|
||||
* Copyright (c) 2015-16 Magnus Skjegstad <magnus@skjegstad.com>
|
||||
*
|
||||
* 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 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 (>>=) = Lwt.(>>=)
|
||||
|
||||
module type Backend = sig
|
||||
include Vnetif.BACKEND
|
||||
val create : unit -> t
|
||||
end
|
||||
|
||||
(** This backend enforces an Ethernet frame size. *)
|
||||
module Frame_size_enforced = struct
|
||||
module X = Basic_backend.Make
|
||||
type t = {
|
||||
xt : X.t;
|
||||
mutable frame_size : int;
|
||||
}
|
||||
|
||||
let register t =
|
||||
X.register t.xt
|
||||
|
||||
let unregister t id =
|
||||
X.unregister t.xt id
|
||||
|
||||
let mac t id =
|
||||
X.mac t.xt id
|
||||
|
||||
let set_listen_fn t id buf =
|
||||
X.set_listen_fn t.xt id buf
|
||||
|
||||
let unregister_and_flush t id =
|
||||
X.unregister_and_flush t.xt id
|
||||
|
||||
let write t id ~size fill =
|
||||
if size > t.frame_size then
|
||||
Lwt.return (Error `Invalid_length)
|
||||
else
|
||||
X.write t.xt id ~size fill
|
||||
|
||||
let set_frame_size t m = t.frame_size <- m
|
||||
let set_max_ip_mtu t m = t.frame_size <- m + Ethernet.Packet.sizeof_ethernet
|
||||
|
||||
let create ~frame_size () =
|
||||
let xt = X.create ~use_async_readers:true ~yield:(fun() -> Lwt.pause () ) () in
|
||||
{ xt ; frame_size }
|
||||
|
||||
let create () =
|
||||
create ~frame_size:(1500 + Ethernet.Packet.sizeof_ethernet) ()
|
||||
|
||||
end
|
||||
|
||||
(** This backend adds a random number of trailing bytes to each frame *)
|
||||
module Trailing_bytes : Backend = struct
|
||||
module X = Basic_backend.Make
|
||||
include X
|
||||
|
||||
let max_bytes_to_add = 10
|
||||
|
||||
(* Just adds trailing bytes, doesn't store anything in them *)
|
||||
let add_random_bytes src =
|
||||
let bytes_to_add = Random.int max_bytes_to_add in
|
||||
let len = Cstruct.length src in
|
||||
let dst = Cstruct.create (len + bytes_to_add) in
|
||||
Cstruct.blit src 0 dst 0 len;
|
||||
dst
|
||||
|
||||
let set_listen_fn t id fn =
|
||||
(* Add random bytes before returning result to real listener *)
|
||||
X.set_listen_fn t id (fun buf ->
|
||||
fn (add_random_bytes buf))
|
||||
|
||||
let create () =
|
||||
X.create ~use_async_readers:true ~yield:(fun() -> Lwt.pause () ) ()
|
||||
|
||||
end
|
||||
|
||||
(** This backend drops packets *)
|
||||
module Uniform_packet_loss : Backend = struct
|
||||
module X = Basic_backend.Make
|
||||
include X
|
||||
|
||||
let drop_p = 0.01
|
||||
|
||||
let write t id ~size fill =
|
||||
if Random.float 1.0 < drop_p then
|
||||
Lwt.return (Ok ()) (* drop packet *)
|
||||
else
|
||||
X.write t id ~size fill (* pass to real write *)
|
||||
|
||||
let create () =
|
||||
X.create ~use_async_readers:true ~yield:(fun() -> Lwt.pause () ) ()
|
||||
|
||||
end
|
||||
|
||||
(** This backend uniformly drops packets with no payload *)
|
||||
module Uniform_no_payload_packet_loss : Backend = struct
|
||||
module X = Basic_backend.Make
|
||||
include X
|
||||
|
||||
(* We assume that packets with payload are usually filled. We could make the
|
||||
* payload check more accurate by parsing the packet properly. *)
|
||||
let no_payload_len = 100
|
||||
(* Drop probability, if no payload *)
|
||||
let drop_p = 0.10
|
||||
|
||||
let write t id ~size fill =
|
||||
if size <= no_payload_len && Random.float 1.0 < drop_p then
|
||||
Lwt.return (Ok ()) (* drop packet *)
|
||||
else
|
||||
X.write t id ~size fill (* pass to real write *)
|
||||
|
||||
let create () =
|
||||
X.create ~use_async_readers:true ~yield:(fun() -> Lwt.pause () ) ()
|
||||
end
|
||||
|
||||
(** This backend drops packets for 1 second after 1 megabyte has been
|
||||
* transferred *)
|
||||
module Drop_1_second_after_1_megabyte : Backend = struct
|
||||
module X = Basic_backend.Make
|
||||
type t = {
|
||||
xt : X.t;
|
||||
mutable sent_bytes : int;
|
||||
mutable is_dropping : bool;
|
||||
mutable done_dropping : bool;
|
||||
}
|
||||
|
||||
let byte_limit : int = 1_000_000
|
||||
let time_to_sleep : float = 1.0
|
||||
|
||||
let register t =
|
||||
X.register t.xt
|
||||
|
||||
let unregister t id =
|
||||
X.unregister t.xt id
|
||||
|
||||
let mac t id =
|
||||
X.mac t.xt id
|
||||
|
||||
let set_listen_fn t id buf =
|
||||
X.set_listen_fn t.xt id buf
|
||||
|
||||
let unregister_and_flush t id =
|
||||
X.unregister_and_flush t.xt id
|
||||
|
||||
let should_drop t =
|
||||
if (t.sent_bytes > byte_limit) &&
|
||||
(t.is_dropping = false) &&
|
||||
(t.done_dropping = false) then
|
||||
begin
|
||||
Logs.info (fun f -> f "Backend dropping packets for %f sec" time_to_sleep);
|
||||
t.is_dropping <- true;
|
||||
Lwt.async(fun () ->
|
||||
Lwt_unix.sleep time_to_sleep >>= fun () ->
|
||||
t.done_dropping <- true;
|
||||
t.is_dropping <- false;
|
||||
Logs.info (fun f -> f "Stopped dropping");
|
||||
Lwt.return_unit
|
||||
);
|
||||
true
|
||||
end else
|
||||
begin
|
||||
if t.is_dropping = true then
|
||||
true
|
||||
else
|
||||
false
|
||||
end
|
||||
|
||||
let write t id ~size fill =
|
||||
t.sent_bytes <- t.sent_bytes + size;
|
||||
if should_drop t then
|
||||
Lwt.return (Ok ())
|
||||
else
|
||||
X.write t.xt id ~size fill (* pass to real write *)
|
||||
|
||||
let create () =
|
||||
let xt = X.create ~use_async_readers:true ~yield:(fun() -> Lwt.pause ()) () in
|
||||
{ xt ; done_dropping = false; is_dropping = false; sent_bytes = 0 }
|
||||
|
||||
end
|
||||
|
||||
(** This backend has a global on/off switch which drops all the packets *)
|
||||
module On_off_switch = struct
|
||||
module X = Basic_backend.Make
|
||||
include X
|
||||
|
||||
let send_packets = ref true
|
||||
|
||||
let write t id ~size fill =
|
||||
if not !send_packets then
|
||||
begin
|
||||
Logs.info (fun f -> f "write dropping 1 packet");
|
||||
Lwt.return (Ok ()) (* drop packet *)
|
||||
end else
|
||||
X.write t id ~size fill (* pass to real write *)
|
||||
|
||||
let create () =
|
||||
X.create ~use_async_readers:true ~yield:(fun() -> Lwt.pause () ) ()
|
||||
|
||||
end
|
||||
|
||||
(** This backend delivers all packets unmodified *)
|
||||
module Basic : Backend = struct
|
||||
module X = Basic_backend.Make
|
||||
include X
|
||||
|
||||
let create () =
|
||||
X.create ~use_async_readers:true ~yield:(fun() -> Lwt.pause () ) ()
|
||||
end
|
||||
135
unikernel/duniverse/mirage-tcpip/test/vnetif_common.ml
Normal file
135
unikernel/duniverse/mirage-tcpip/test/vnetif_common.ml
Normal file
|
|
@ -0,0 +1,135 @@
|
|||
(*
|
||||
* Copyright (c) 2015 Magnus Skjegstad <magnus@skjegstad.com>
|
||||
*
|
||||
* 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 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.
|
||||
*)
|
||||
|
||||
open Common
|
||||
open Lwt.Infix
|
||||
|
||||
module type VNETIF_STACK =
|
||||
sig
|
||||
type backend
|
||||
module Stack : Tcpip.Stack.V4V6
|
||||
|
||||
(** Create a new backend *)
|
||||
val create_backend : unit -> backend
|
||||
|
||||
(** Create a new stack connected to an existing backend *)
|
||||
val create_stack : ?mtu:int -> cidr:Ipaddr.V4.Prefix.t ->
|
||||
?gateway:Ipaddr.V4.t -> ?cidr6:Ipaddr.V6.Prefix.t ->
|
||||
?gateway6:Ipaddr.V6.t -> backend -> Stack.t Lwt.t
|
||||
|
||||
val create_backend_listener : backend -> (Cstruct.t -> unit Lwt.t) -> int
|
||||
|
||||
(** Disable a listener function *)
|
||||
val disable_backend_listener : backend -> int -> unit Lwt.t
|
||||
|
||||
(** Records pcap data from the backend while running the specified
|
||||
function. Disables the pcap recorder when the function exits. *)
|
||||
val record_pcap : backend -> string -> (unit -> unit Lwt.t) -> unit Lwt.t
|
||||
end
|
||||
|
||||
module VNETIF_STACK (B: Vnetif_backends.Backend): sig
|
||||
include VNETIF_STACK with type backend = B.t
|
||||
|
||||
module T : sig
|
||||
val num_open_channels : Stack.TCP.t -> int
|
||||
end
|
||||
end
|
||||
= struct
|
||||
type backend = B.t
|
||||
module V = Vnetif.Make(B)
|
||||
module E = Ethernet.Make(V)
|
||||
|
||||
module A = Arp.Make(E)
|
||||
module Ip4 = Static_ipv4.Make(E)(A)
|
||||
module Icmp4 = Icmpv4.Make(Ip4)
|
||||
module Ip6 = Ipv6.Make(V)(E)
|
||||
module Ip46 = Tcpip_stack_direct.IPV4V6(Ip4)(Ip6)
|
||||
module U = Udp.Make(Ip46)
|
||||
module T = Tcp.Flow.Make(Ip46)
|
||||
|
||||
module Stack =
|
||||
Tcpip_stack_direct.MakeV4V6(V)(E)(A)(Ip46)(Icmp4)(U)(T)
|
||||
|
||||
let create_backend () =
|
||||
B.create ()
|
||||
|
||||
let create_stack ?mtu ~cidr ?gateway ?cidr6 ?gateway6 backend =
|
||||
let size_limit = match mtu with None -> None | Some x -> Some x in
|
||||
V.connect ?size_limit backend >>= fun netif ->
|
||||
E.connect netif >>= fun ethif ->
|
||||
A.connect ethif >>= fun arpv4 ->
|
||||
Ip4.connect ~cidr ?gateway ethif arpv4 >>= fun ipv4 ->
|
||||
Icmp4.connect ipv4 >>= fun icmpv4 ->
|
||||
Ip6.connect ?cidr:cidr6 ?gateway:gateway6 netif ethif >>= fun ipv6 ->
|
||||
Ip46.connect ~ipv4_only:false ~ipv6_only:false ipv4 ipv6 >>= fun ip ->
|
||||
U.connect ip >>= fun udp ->
|
||||
T.connect ip >>= fun tcp ->
|
||||
Stack.connect netif ethif arpv4 ip icmpv4 udp tcp
|
||||
|
||||
let create_backend_listener backend listenf =
|
||||
match (B.register backend) with
|
||||
| Error _ -> failf "Error occurred while registering to backend"
|
||||
| Ok id -> (B.set_listen_fn backend id listenf); id
|
||||
|
||||
let disable_backend_listener backend id =
|
||||
B.unregister_and_flush backend id
|
||||
|
||||
let create_pcap_recorder backend channel =
|
||||
let header_buf = Cstruct.create Pcap.sizeof_pcap_header in
|
||||
Pcap.LE.set_pcap_header_magic_number header_buf Pcap.magic_number;
|
||||
Pcap.LE.set_pcap_header_network header_buf Pcap.Network.(to_int32 Ethernet);
|
||||
Pcap.LE.set_pcap_header_sigfigs header_buf 0l;
|
||||
Pcap.LE.set_pcap_header_snaplen header_buf 0xffffl;
|
||||
Pcap.LE.set_pcap_header_thiszone header_buf 0l;
|
||||
Pcap.LE.set_pcap_header_version_major header_buf Pcap.major_version;
|
||||
Pcap.LE.set_pcap_header_version_minor header_buf Pcap.minor_version;
|
||||
Lwt_io.write channel (Cstruct.to_string header_buf) >>= fun () ->
|
||||
let pcap_record channel buffer =
|
||||
let pcap_buf = Cstruct.create Pcap.sizeof_pcap_packet in
|
||||
let time = Unix.gettimeofday () in
|
||||
Pcap.LE.set_pcap_packet_incl_len pcap_buf (Int32.of_int (Cstruct.length buffer));
|
||||
Pcap.LE.set_pcap_packet_orig_len pcap_buf (Int32.of_int (Cstruct.length buffer));
|
||||
Pcap.LE.set_pcap_packet_ts_sec pcap_buf (Int32.of_float time);
|
||||
let frac = (time -. (float_of_int (truncate time))) *. 1000000.0 in
|
||||
Pcap.LE.set_pcap_packet_ts_usec pcap_buf (Int32.of_float frac);
|
||||
(try
|
||||
Lwt_io.write channel ((Cstruct.to_string pcap_buf) ^ (Cstruct.to_string buffer))
|
||||
with
|
||||
Lwt_io.Channel_closed msg -> Printf.printf "Warning: Pcap output channel already closed: %s.\n" msg; Lwt.return_unit
|
||||
)
|
||||
>>= fun () ->
|
||||
Lwt.return_unit
|
||||
in
|
||||
let recorder_id = create_backend_listener backend (pcap_record channel) in
|
||||
Lwt.return recorder_id
|
||||
|
||||
let record_pcap backend pcap_file fn =
|
||||
Lwt.catch
|
||||
(fun _ ->
|
||||
Lwt_io.with_file ~mode:Lwt_io.output pcap_file (fun oc ->
|
||||
create_pcap_recorder backend oc >>= fun recorder_id ->
|
||||
fn () >>= fun () ->
|
||||
disable_backend_listener backend recorder_id >>= fun () ->
|
||||
Lwt.return_unit
|
||||
)
|
||||
)
|
||||
(function
|
||||
| Unix.Unix_error _ ->
|
||||
Printf.printf "Could not create pcap file %s - something along the way doesn't exist.\n" pcap_file;
|
||||
fn ()
|
||||
| e -> Lwt.fail e
|
||||
)
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue