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
6(* Test vectors based on RFC 9171 examples *)
7
8let eid_testable = Alcotest.testable Bundle.pp_eid ( = )
9let error_testable = Alcotest.testable Bundle.pp_error ( = )
10
11let bundle_testable =
12 Alcotest.testable Bundle.pp (fun a b -> Bundle.encode a = Bundle.encode b)
13
14let test_eid_dtn_none () =
15 let eid = Bundle.Dtn_none in
16 let cbor = Bundle.eid_to_cbor eid in
17 let decoded = Bundle.eid_of_cbor cbor in
18 Alcotest.(check (result eid_testable string))
19 "dtn:none roundtrip" (Ok eid) decoded
20
21let test_eid_dtn () =
22 let eid = Bundle.Dtn "//node-1/incoming" in
23 let cbor = Bundle.eid_to_cbor eid in
24 let decoded = Bundle.eid_of_cbor cbor in
25 Alcotest.(check (result eid_testable string))
26 "dtn URI roundtrip" (Ok eid) decoded
27
28let test_eid_ipn () =
29 let eid = Bundle.Ipn (1L, 1L) in
30 let cbor = Bundle.eid_to_cbor eid in
31 let decoded = Bundle.eid_of_cbor cbor in
32 Alcotest.(check (result eid_testable string))
33 "ipn:1.1 roundtrip" (Ok eid) decoded
34
35let test_bundle_flags () =
36 let flags =
37 Bundle.{ default_flags with ack_requested = true; report_delivery = true }
38 in
39 let encoded = Bundle.int_of_flags flags in
40 let decoded = Bundle.flags_of_int encoded in
41 Alcotest.(check bool)
42 "ack_requested" flags.ack_requested decoded.ack_requested;
43 Alcotest.(check bool)
44 "report_delivery" flags.report_delivery decoded.report_delivery;
45 Alcotest.(check bool) "is_fragment" flags.is_fragment decoded.is_fragment
46
47let test_block_flags () =
48 let flags =
49 Bundle.{ block_flags_default with replicate_in_fragment = true }
50 in
51 let encoded = Bundle.int_of_block_flags flags in
52 let decoded = Bundle.block_flags_of_int encoded in
53 Alcotest.(check bool)
54 "replicate_in_fragment" flags.replicate_in_fragment
55 decoded.replicate_in_fragment
56
57let test_crc_type () =
58 Alcotest.(check int) "No_crc" 0 (Bundle.int_of_crc_type Bundle.No_crc);
59 Alcotest.(check int) "Crc16" 1 (Bundle.int_of_crc_type Bundle.Crc16);
60 Alcotest.(check int) "Crc32c" 2 (Bundle.int_of_crc_type Bundle.Crc32c);
61 Alcotest.(check (result (of_pp Bundle.pp_crc_type) int))
62 "decode 0" (Ok Bundle.No_crc) (Bundle.crc_type_of_int 0);
63 Alcotest.(check (result (of_pp Bundle.pp_crc_type) int))
64 "decode 2" (Ok Bundle.Crc32c) (Bundle.crc_type_of_int 2);
65 Alcotest.(check (result (of_pp Bundle.pp_crc_type) int))
66 "decode invalid" (Error 99)
67 (Bundle.crc_type_of_int 99)
68
69let test_simple_bundle () =
70 let bundle =
71 Bundle.v
72 ~source:(Bundle.Ipn (1L, 1L))
73 ~destination:(Bundle.Ipn (2L, 1L))
74 ~creation_timestamp:{ Bundle.time = 0L; seq = 0L }
75 ~payload:"Hello, DTN!" ()
76 in
77 Alcotest.(check (option string))
78 "payload" (Some "Hello, DTN!") (Bundle.payload bundle);
79 Alcotest.(check int) "version" 7 bundle.primary.version;
80 Alcotest.(check (of_pp Bundle.pp_eid))
81 "source"
82 (Bundle.Ipn (1L, 1L))
83 bundle.primary.source;
84 Alcotest.(check (of_pp Bundle.pp_eid))
85 "destination"
86 (Bundle.Ipn (2L, 1L))
87 bundle.primary.destination
88
89let test_bundle_roundtrip () =
90 let bundle =
91 Bundle.v ~source:(Bundle.Dtn "//sender/app")
92 ~destination:(Bundle.Dtn "//receiver/app")
93 ~creation_timestamp:{ Bundle.time = 1000000L; seq = 42L }
94 ~lifetime:3600000L ~payload:"Test payload data" ()
95 in
96 let encoded = Bundle.encode bundle in
97 let decoded = Bundle.decode encoded in
98 match decoded with
99 | Ok decoded_bundle ->
100 Alcotest.(check (option string))
101 "payload preserved" (Bundle.payload bundle)
102 (Bundle.payload decoded_bundle);
103 Alcotest.(check (of_pp Bundle.pp_eid))
104 "source preserved" bundle.primary.source decoded_bundle.primary.source;
105 Alcotest.(check (of_pp Bundle.pp_eid))
106 "destination preserved" bundle.primary.destination
107 decoded_bundle.primary.destination;
108 Alcotest.(check int64)
109 "lifetime preserved" bundle.primary.lifetime
110 decoded_bundle.primary.lifetime
111 | Error e -> Alcotest.failf "decode failed: %a" Bundle.pp_error e
112
113let test_bundle_no_crc () =
114 let bundle =
115 Bundle.v ~crc_type:Bundle.No_crc
116 ~source:(Bundle.Ipn (1L, 1L))
117 ~destination:(Bundle.Ipn (2L, 1L))
118 ~creation_timestamp:{ Bundle.time = 0L; seq = 0L }
119 ~payload:"No CRC test" ()
120 in
121 let encoded = Bundle.encode bundle in
122 let decoded = Bundle.decode encoded in
123 Alcotest.(check (result bundle_testable error_testable))
124 "no CRC roundtrip" (Ok bundle) decoded
125
126let test_bundle_crc16 () =
127 let bundle =
128 Bundle.v ~crc_type:Bundle.Crc16
129 ~source:(Bundle.Ipn (1L, 1L))
130 ~destination:(Bundle.Ipn (2L, 1L))
131 ~creation_timestamp:{ Bundle.time = 0L; seq = 0L }
132 ~payload:"CRC-16 test" ()
133 in
134 let encoded = Bundle.encode bundle in
135 let decoded = Bundle.decode encoded in
136 match decoded with
137 | Ok _ -> ()
138 | Error e ->
139 Alcotest.fail
140 (Fmt.str "CRC-16 bundle decode failed: %a" Bundle.pp_error e)
141
142(* {1 Fragment Tests} *)
143
144let test_fragment_fields () =
145 (* RFC 9171 Section 4.3.1: fragment_offset and total_adu_length *)
146 let flags = Bundle.{ default_flags with is_fragment = true } in
147 let primary =
148 {
149 Bundle.version = 7;
150 flags;
151 crc_type = Bundle.Crc32c;
152 destination = Bundle.Ipn (2L, 1L);
153 source = Bundle.Ipn (1L, 1L);
154 report_to = Bundle.Ipn (1L, 1L);
155 creation_timestamp = { Bundle.time = 1000L; seq = 0L };
156 lifetime = 3600000L;
157 fragment_offset = Some 1024L;
158 total_adu_length = Some 4096L;
159 }
160 in
161 let payload_block =
162 {
163 Bundle.block_type = Bundle.Payload;
164 block_number = 1;
165 flags = Bundle.block_flags_default;
166 crc_type = Bundle.Crc32c;
167 data = Bundle.Payload_data "fragment data";
168 }
169 in
170 let bundle = { Bundle.primary; blocks = [ payload_block ] } in
171 let encoded = Bundle.encode bundle in
172 match Bundle.decode encoded with
173 | Ok decoded ->
174 Alcotest.(check bool) "is_fragment" true decoded.primary.flags.is_fragment;
175 Alcotest.(check (option int64))
176 "fragment_offset" (Some 1024L) decoded.primary.fragment_offset;
177 Alcotest.(check (option int64))
178 "total_adu_length" (Some 4096L) decoded.primary.total_adu_length
179 | Error e -> Alcotest.failf "fragment decode failed: %a" Bundle.pp_error e
180
181let test_fragment_offset_zero () =
182 (* First fragment has offset 0 *)
183 let flags = Bundle.{ default_flags with is_fragment = true } in
184 let primary =
185 {
186 Bundle.version = 7;
187 flags;
188 crc_type = Bundle.No_crc;
189 destination = Bundle.Ipn (2L, 1L);
190 source = Bundle.Ipn (1L, 1L);
191 report_to = Bundle.Ipn (1L, 1L);
192 creation_timestamp = { Bundle.time = 0L; seq = 0L };
193 lifetime = 3600000L;
194 fragment_offset = Some 0L;
195 total_adu_length = Some 2048L;
196 }
197 in
198 let payload_block =
199 {
200 Bundle.block_type = Bundle.Payload;
201 block_number = 1;
202 flags = Bundle.block_flags_default;
203 crc_type = Bundle.No_crc;
204 data = Bundle.Payload_data "first fragment";
205 }
206 in
207 let bundle = { Bundle.primary; blocks = [ payload_block ] } in
208 let encoded = Bundle.encode bundle in
209 match Bundle.decode encoded with
210 | Ok decoded ->
211 Alcotest.(check (option int64))
212 "fragment_offset" (Some 0L) decoded.primary.fragment_offset
213 | Error e -> Alcotest.failf "decode failed: %a" Bundle.pp_error e
214
215(* {1 Additional Block Type Tests} *)
216
217let test_hop_count_block () =
218 (* RFC 9171 Section 4.4.4: Hop Count block type 10 *)
219 let primary =
220 {
221 Bundle.version = 7;
222 flags = Bundle.default_flags;
223 crc_type = Bundle.No_crc;
224 destination = Bundle.Ipn (2L, 1L);
225 source = Bundle.Ipn (1L, 1L);
226 report_to = Bundle.Ipn (1L, 1L);
227 creation_timestamp = { Bundle.time = 0L; seq = 0L };
228 lifetime = 3600000L;
229 fragment_offset = None;
230 total_adu_length = None;
231 }
232 in
233 let hop_count_block =
234 {
235 Bundle.block_type = Bundle.Hop_count;
236 block_number = 2;
237 flags = Bundle.block_flags_default;
238 crc_type = Bundle.No_crc;
239 data = Bundle.Hop_count_data { limit = 30; count = 5 };
240 }
241 in
242 let payload_block =
243 {
244 Bundle.block_type = Bundle.Payload;
245 block_number = 1;
246 flags = Bundle.block_flags_default;
247 crc_type = Bundle.No_crc;
248 data = Bundle.Payload_data "test";
249 }
250 in
251 let bundle =
252 { Bundle.primary; blocks = [ hop_count_block; payload_block ] }
253 in
254 let encoded = Bundle.encode bundle in
255 match Bundle.decode encoded with
256 | Ok decoded ->
257 Alcotest.(check (option (pair int int)))
258 "hop count"
259 (Some (30, 5))
260 (Bundle.hop_count decoded)
261 | Error e -> Alcotest.failf "decode failed: %a" Bundle.pp_error e
262
263let test_previous_node_block () =
264 (* RFC 9171 Section 4.4.2: Previous Node block type 6 *)
265 let prev_eid = Bundle.Ipn (3L, 0L) in
266 let primary =
267 {
268 Bundle.version = 7;
269 flags = Bundle.default_flags;
270 crc_type = Bundle.No_crc;
271 destination = Bundle.Ipn (2L, 1L);
272 source = Bundle.Ipn (1L, 1L);
273 report_to = Bundle.Ipn (1L, 1L);
274 creation_timestamp = { Bundle.time = 0L; seq = 0L };
275 lifetime = 3600000L;
276 fragment_offset = None;
277 total_adu_length = None;
278 }
279 in
280 let prev_node_block =
281 {
282 Bundle.block_type = Bundle.Previous_node;
283 block_number = 2;
284 flags = Bundle.block_flags_default;
285 crc_type = Bundle.No_crc;
286 data = Bundle.Previous_node_data prev_eid;
287 }
288 in
289 let payload_block =
290 {
291 Bundle.block_type = Bundle.Payload;
292 block_number = 1;
293 flags = Bundle.block_flags_default;
294 crc_type = Bundle.No_crc;
295 data = Bundle.Payload_data "test";
296 }
297 in
298 let bundle =
299 { Bundle.primary; blocks = [ prev_node_block; payload_block ] }
300 in
301 let encoded = Bundle.encode bundle in
302 match Bundle.decode encoded with
303 | Ok decoded ->
304 Alcotest.(check (option (of_pp Bundle.pp_eid)))
305 "previous node" (Some prev_eid)
306 (Bundle.previous_node decoded)
307 | Error e -> Alcotest.failf "decode failed: %a" Bundle.pp_error e
308
309let test_bundle_age_block () =
310 (* RFC 9171 Section 4.4.3: Bundle Age block type 7 *)
311 let primary =
312 {
313 Bundle.version = 7;
314 flags = Bundle.default_flags;
315 crc_type = Bundle.No_crc;
316 destination = Bundle.Ipn (2L, 1L);
317 source = Bundle.Ipn (1L, 1L);
318 report_to = Bundle.Ipn (1L, 1L);
319 creation_timestamp = { Bundle.time = 0L; seq = 0L };
320 lifetime = 3600000L;
321 fragment_offset = None;
322 total_adu_length = None;
323 }
324 in
325 let age_block =
326 {
327 Bundle.block_type = Bundle.Bundle_age;
328 block_number = 2;
329 flags = Bundle.block_flags_default;
330 crc_type = Bundle.No_crc;
331 data = Bundle.Bundle_age_data 12345L;
332 }
333 in
334 let payload_block =
335 {
336 Bundle.block_type = Bundle.Payload;
337 block_number = 1;
338 flags = Bundle.block_flags_default;
339 crc_type = Bundle.No_crc;
340 data = Bundle.Payload_data "test";
341 }
342 in
343 let bundle = { Bundle.primary; blocks = [ age_block; payload_block ] } in
344 let encoded = Bundle.encode bundle in
345 match Bundle.decode encoded with
346 | Ok decoded ->
347 Alcotest.(check (option int64))
348 "bundle age" (Some 12345L) (Bundle.age decoded)
349 | Error e -> Alcotest.failf "decode failed: %a" Bundle.pp_error e
350
351(* {1 do_not_fragment Flag Tests} *)
352
353let test_do_not_fragment_flag () =
354 (* RFC 9171 Section 4.2.3: must_not_fragment flag *)
355 let flags = Bundle.{ default_flags with must_not_fragment = true } in
356 let encoded_flags = Bundle.int_of_flags flags in
357 Alcotest.(check bool) "bit 2 set" true (encoded_flags land 0x04 <> 0);
358 let decoded_flags = Bundle.flags_of_int encoded_flags in
359 Alcotest.(check bool) "must_not_fragment" true decoded_flags.must_not_fragment;
360 (* Roundtrip through a full bundle *)
361 let bundle =
362 Bundle.v ~flags
363 ~source:(Bundle.Ipn (1L, 1L))
364 ~destination:(Bundle.Ipn (2L, 1L))
365 ~creation_timestamp:{ Bundle.time = 0L; seq = 0L }
366 ~payload:"no fragment" ()
367 in
368 let encoded = Bundle.encode bundle in
369 match Bundle.decode encoded with
370 | Ok decoded ->
371 Alcotest.(check bool)
372 "must_not_fragment preserved" true
373 decoded.primary.flags.must_not_fragment
374 | Error e -> Alcotest.failf "decode failed: %a" Bundle.pp_error e
375
376(* {1 CRC-32C Tests} *)
377
378let test_crc32c_roundtrip () =
379 (* Verify CRC-32C encoding and decoding *)
380 let bundle =
381 Bundle.v ~crc_type:Bundle.Crc32c
382 ~source:(Bundle.Ipn (1L, 1L))
383 ~destination:(Bundle.Ipn (2L, 1L))
384 ~creation_timestamp:{ Bundle.time = 500000L; seq = 1L }
385 ~payload:"CRC-32C payload" ()
386 in
387 let encoded = Bundle.encode bundle in
388 match Bundle.decode encoded with
389 | Ok decoded ->
390 Alcotest.(check (option string))
391 "payload preserved" (Some "CRC-32C payload") (Bundle.payload decoded);
392 Alcotest.(check (of_pp Bundle.pp_crc_type))
393 "crc_type preserved" Bundle.Crc32c decoded.primary.crc_type
394 | Error e -> Alcotest.failf "CRC-32C decode failed: %a" Bundle.pp_error e
395
396let test_crc32c_compute () =
397 (* Verify compute_crc produces correct length for CRC-32C *)
398 let data = "test data for CRC-32C" in
399 let crc = Bundle.compute_crc Bundle.Crc32c data in
400 Alcotest.(check int) "CRC-32C is 4 bytes" 4 (String.length crc);
401 (* No_crc should produce empty string *)
402 let no_crc = Bundle.compute_crc Bundle.No_crc data in
403 Alcotest.(check int) "No_crc is 0 bytes" 0 (String.length no_crc);
404 (* CRC-16 should produce 2 bytes *)
405 let crc16 = Bundle.compute_crc Bundle.Crc16 data in
406 Alcotest.(check int) "CRC-16 is 2 bytes" 2 (String.length crc16)
407
408(* {1 Multiple Extension Blocks Test} *)
409
410let test_multiple_extension_blocks () =
411 (* Bundle with hop count, previous node, bundle age, and payload *)
412 let primary =
413 {
414 Bundle.version = 7;
415 flags = Bundle.default_flags;
416 crc_type = Bundle.Crc32c;
417 destination = Bundle.Dtn "//receiver/app";
418 source = Bundle.Dtn "//sender/app";
419 report_to = Bundle.Dtn "//sender/app";
420 creation_timestamp = { Bundle.time = 1000000L; seq = 0L };
421 lifetime = 7200000L;
422 fragment_offset = None;
423 total_adu_length = None;
424 }
425 in
426 let hop_count_block =
427 {
428 Bundle.block_type = Bundle.Hop_count;
429 block_number = 2;
430 flags = Bundle.block_flags_default;
431 crc_type = Bundle.No_crc;
432 data = Bundle.Hop_count_data { limit = 20; count = 0 };
433 }
434 in
435 let prev_node_block =
436 {
437 Bundle.block_type = Bundle.Previous_node;
438 block_number = 3;
439 flags = Bundle.block_flags_default;
440 crc_type = Bundle.No_crc;
441 data = Bundle.Previous_node_data (Bundle.Ipn (5L, 0L));
442 }
443 in
444 let age_block =
445 {
446 Bundle.block_type = Bundle.Bundle_age;
447 block_number = 4;
448 flags = Bundle.block_flags_default;
449 crc_type = Bundle.No_crc;
450 data = Bundle.Bundle_age_data 500L;
451 }
452 in
453 let payload_block =
454 {
455 Bundle.block_type = Bundle.Payload;
456 block_number = 1;
457 flags = Bundle.block_flags_default;
458 crc_type = Bundle.Crc32c;
459 data = Bundle.Payload_data "multi-block bundle";
460 }
461 in
462 let bundle =
463 {
464 Bundle.primary;
465 blocks = [ hop_count_block; prev_node_block; age_block; payload_block ];
466 }
467 in
468 let encoded = Bundle.encode bundle in
469 match Bundle.decode encoded with
470 | Ok decoded ->
471 Alcotest.(check (option (pair int int)))
472 "hop count"
473 (Some (20, 0))
474 (Bundle.hop_count decoded);
475 Alcotest.(check (option (of_pp Bundle.pp_eid)))
476 "previous node"
477 (Some (Bundle.Ipn (5L, 0L)))
478 (Bundle.previous_node decoded);
479 Alcotest.(check (option int64))
480 "bundle age" (Some 500L) (Bundle.age decoded);
481 Alcotest.(check (option string))
482 "payload" (Some "multi-block bundle") (Bundle.payload decoded)
483 | Error e -> Alcotest.failf "decode failed: %a" Bundle.pp_error e
484
485let test_block_type_codes () =
486 (* RFC 9171 Section 4.4: verify block type integer codes *)
487 Alcotest.(check int) "Payload" 1 (Bundle.int_of_block_type Bundle.Payload);
488 Alcotest.(check int)
489 "Previous_node" 6
490 (Bundle.int_of_block_type Bundle.Previous_node);
491 Alcotest.(check int)
492 "Bundle_age" 7
493 (Bundle.int_of_block_type Bundle.Bundle_age);
494 Alcotest.(check int)
495 "Hop_count" 10
496 (Bundle.int_of_block_type Bundle.Hop_count);
497 Alcotest.(check int)
498 "Other 200" 200
499 (Bundle.int_of_block_type (Bundle.Other 200))
500
501let suite =
502 ( "bundle",
503 [
504 Alcotest.test_case "EID dtn:none" `Quick test_eid_dtn_none;
505 Alcotest.test_case "EID dtn URI" `Quick test_eid_dtn;
506 Alcotest.test_case "EID ipn" `Quick test_eid_ipn;
507 Alcotest.test_case "bundle flags" `Quick test_bundle_flags;
508 Alcotest.test_case "block flags" `Quick test_block_flags;
509 Alcotest.test_case "CRC type" `Quick test_crc_type;
510 Alcotest.test_case "simple bundle" `Quick test_simple_bundle;
511 Alcotest.test_case "roundtrip" `Quick test_bundle_roundtrip;
512 Alcotest.test_case "no CRC" `Quick test_bundle_no_crc;
513 Alcotest.test_case "CRC-16" `Quick test_bundle_crc16;
514 Alcotest.test_case "fragment fields" `Quick test_fragment_fields;
515 Alcotest.test_case "fragment offset zero" `Quick test_fragment_offset_zero;
516 Alcotest.test_case "hop count block" `Quick test_hop_count_block;
517 Alcotest.test_case "previous node block" `Quick test_previous_node_block;
518 Alcotest.test_case "bundle age block" `Quick test_bundle_age_block;
519 Alcotest.test_case "do_not_fragment flag" `Quick test_do_not_fragment_flag;
520 Alcotest.test_case "CRC-32C roundtrip" `Quick test_crc32c_roundtrip;
521 Alcotest.test_case "CRC-32C compute" `Quick test_crc32c_compute;
522 Alcotest.test_case "multiple extension blocks" `Quick
523 test_multiple_extension_blocks;
524 Alcotest.test_case "block type codes" `Quick test_block_type_codes;
525 ] )