gazagnaire.org
Bundle Protocol Version 7 (RFC 9171) for Delay-Tolerant Networking
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6open Crowbar
7
8(* Generate random EIDs *)
9let eid_gen =
10 choose
11 [
12 const Bundle.Dtn_none;
13 map [ bytes ] (fun s -> Bundle.Dtn s);
14 map [ int64; int64 ] (fun n s -> Bundle.Ipn (Int64.abs n, Int64.abs s));
15 ]
16
17(* Generate random timestamps *)
18let timestamp_gen =
19 map [ int64; int64 ] (fun time seq ->
20 Bundle.{ time = Int64.abs time; seq = Int64.abs seq })
21
22(* Test EID roundtrip through CBOR *)
23let test_eid_roundtrip eid =
24 let cbor = Bundle.eid_to_cbor eid in
25 match Bundle.eid_of_cbor cbor with
26 | Ok decoded -> check_eq ~pp:Bundle.pp_eid eid decoded
27 | Error _ -> bad_test ()
28
29(* Test bundle flags roundtrip *)
30let test_bundle_flags_roundtrip n =
31 let n = n land 0x07FFFF in
32 (* Mask to valid flag bits *)
33 let flags = Bundle.flags_of_int n in
34 let encoded = Bundle.int_of_flags flags in
35 let decoded = Bundle.flags_of_int encoded in
36 check_eq ~pp:(fun fmt f -> Fmt.pf fmt "%a" Bundle.pp_flags f) flags decoded
37
38(* Test block flags roundtrip *)
39let test_block_flags_roundtrip n =
40 let n = n land 0x17 in
41 (* Mask to valid flag bits *)
42 let flags = Bundle.block_flags_of_int n in
43 let encoded = Bundle.int_of_block_flags flags in
44 let decoded = Bundle.block_flags_of_int encoded in
45 check_eq
46 ~pp:(fun fmt f -> Fmt.pf fmt "%a" Bundle.pp_block_flags f)
47 flags decoded
48
49(* Test bundle encode/decode roundtrip *)
50let test_bundle_roundtrip source dest timestamp payload =
51 (* Skip empty payloads and very large ones *)
52 if String.length payload = 0 || String.length payload > 65536 then bad_test ()
53 else
54 let bundle =
55 Bundle.v ~source ~destination:dest ~creation_timestamp:timestamp ~payload
56 ()
57 in
58 let encoded = Bundle.encode bundle in
59 match Bundle.decode encoded with
60 | Ok decoded ->
61 check_eq
62 ~pp:(fun fmt s -> Format.pp_print_string fmt s)
63 (Option.value ~default:"" (Bundle.payload bundle))
64 (Option.value ~default:"" (Bundle.payload decoded))
65 | Error _ ->
66 (* Decoding our own encoding should never fail *)
67 fail "bundle roundtrip failed"
68
69(* Test that decoding arbitrary bytes doesn't crash *)
70let test_decode_no_crash data =
71 let _ = Bundle.decode data in
72 check true
73
74let suite =
75 ( "bundle",
76 [
77 test_case "EID roundtrip" [ eid_gen ] test_eid_roundtrip;
78 test_case "bundle flags roundtrip" [ int ] test_bundle_flags_roundtrip;
79 test_case "block flags roundtrip" [ int ] test_block_flags_roundtrip;
80 test_case "encode/decode roundtrip"
81 [ eid_gen; eid_gen; timestamp_gen; bytes ]
82 test_bundle_roundtrip;
83 test_case "decode no crash" [ bytes ] test_decode_no_crash;
84 ] )