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(** Bundle Protocol Version 7 (RFC 9171, CCSDS 734.2-B-1). *)
7
8module Cbor = Cbort.Cbor
9module Cbor_rw = Cbort.Rw
10
11(* {1 Endpoint IDs} *)
12
13type eid = Dtn_none | Dtn of string | Ipn of int64 * int64
14
15let pp_eid fmt = function
16 | Dtn_none -> Fmt.pf fmt "dtn:none"
17 | Dtn s -> Fmt.pf fmt "dtn:%s" s
18 | Ipn (node, service) -> Fmt.pf fmt "ipn:%Ld.%Ld" node service
19
20let eid_to_cbor = function
21 | Dtn_none -> Cbor.Array [ Cbor.int 1; Cbor.int 0 ]
22 | Dtn s -> Cbor.Array [ Cbor.int 1; Cbor.Text s ]
23 | Ipn (node, service) ->
24 Cbor.Array
25 [ Cbor.int 2; Cbor.Array [ Cbor.int64 node; Cbor.int64 service ] ]
26
27let err_unknown_eid_scheme n = Error (Fmt.str "unknown EID scheme: %Ld" n)
28
29let eid_of_cbor cbor =
30 match Cbor.to_array cbor with
31 | Some [ scheme; ssp ] -> (
32 match Cbor.to_int64 scheme with
33 | Some 1L -> (
34 (* dtn scheme *)
35 match Cbor.to_int64 ssp with
36 | Some 0L -> Ok Dtn_none
37 | _ -> (
38 match Cbor.to_text ssp with
39 | Some s -> Ok (Dtn s)
40 | None -> Error "invalid dtn SSP"))
41 | Some 2L -> (
42 (* ipn scheme *)
43 match Cbor.to_array ssp with
44 | Some [ node; service ] -> (
45 match (Cbor.to_int64 node, Cbor.to_int64 service) with
46 | Some n, Some s -> Ok (Ipn (n, s))
47 | _ -> Error "invalid ipn node/service")
48 | _ -> Error "ipn SSP must be array of 2")
49 | Some n -> err_unknown_eid_scheme n
50 | None -> Error "EID scheme must be uint")
51 | _ -> Error "EID must be array of 2"
52
53(* {1 CRC Types} *)
54
55type crc_type = No_crc | Crc16 | Crc32c
56
57let pp_crc_type fmt = function
58 | No_crc -> Fmt.string fmt "none"
59 | Crc16 -> Fmt.string fmt "CRC-16"
60 | Crc32c -> Fmt.string fmt "CRC-32C"
61
62let int_of_crc_type = function No_crc -> 0 | Crc16 -> 1 | Crc32c -> 2
63
64let crc_type_of_int = function
65 | 0 -> Ok No_crc
66 | 1 -> Ok Crc16
67 | 2 -> Ok Crc32c
68 | n -> Error n
69
70(* {1 Bundle Processing Flags} *)
71
72type flags = {
73 is_fragment : bool;
74 is_admin_record : bool;
75 must_not_fragment : bool;
76 ack_requested : bool;
77 status_time_requested : bool;
78 report_reception : bool;
79 report_forwarding : bool;
80 report_delivery : bool;
81 report_deletion : bool;
82}
83
84let default_flags =
85 {
86 is_fragment = false;
87 is_admin_record = false;
88 must_not_fragment = false;
89 ack_requested = false;
90 status_time_requested = false;
91 report_reception = false;
92 report_forwarding = false;
93 report_delivery = false;
94 report_deletion = false;
95 }
96
97let pp_flags fmt f =
98 let flags = [] in
99 let flags = if f.is_fragment then "fragment" :: flags else flags in
100 let flags = if f.is_admin_record then "admin" :: flags else flags in
101 let flags = if f.must_not_fragment then "no-frag" :: flags else flags in
102 let flags = if f.ack_requested then "ack" :: flags else flags in
103 let flags =
104 if f.status_time_requested then "status-time" :: flags else flags
105 in
106 let flags = if f.report_reception then "report-recv" :: flags else flags in
107 let flags = if f.report_forwarding then "report-fwd" :: flags else flags in
108 let flags = if f.report_delivery then "report-dlv" :: flags else flags in
109 let flags = if f.report_deletion then "report-del" :: flags else flags in
110 Fmt.pf fmt "[%s]" (String.concat ", " (List.rev flags))
111
112let int_of_flags f =
113 let n = 0 in
114 let n = if f.is_fragment then n lor 0x000001 else n in
115 let n = if f.is_admin_record then n lor 0x000002 else n in
116 let n = if f.must_not_fragment then n lor 0x000004 else n in
117 let n = if f.ack_requested then n lor 0x000020 else n in
118 let n = if f.status_time_requested then n lor 0x000040 else n in
119 let n = if f.report_reception then n lor 0x004000 else n in
120 let n = if f.report_forwarding then n lor 0x010000 else n in
121 let n = if f.report_delivery then n lor 0x020000 else n in
122 let n = if f.report_deletion then n lor 0x040000 else n in
123 n
124
125let flags_of_int n =
126 {
127 is_fragment = n land 0x000001 <> 0;
128 is_admin_record = n land 0x000002 <> 0;
129 must_not_fragment = n land 0x000004 <> 0;
130 ack_requested = n land 0x000020 <> 0;
131 status_time_requested = n land 0x000040 <> 0;
132 report_reception = n land 0x004000 <> 0;
133 report_forwarding = n land 0x010000 <> 0;
134 report_delivery = n land 0x020000 <> 0;
135 report_deletion = n land 0x040000 <> 0;
136 }
137
138(* {1 Block Processing Flags} *)
139
140type block_flags = {
141 replicate_in_fragment : bool;
142 report_if_unprocessed : bool;
143 delete_if_unprocessed : bool;
144 discard_if_unprocessed : bool;
145}
146
147let block_flags_default =
148 {
149 replicate_in_fragment = false;
150 report_if_unprocessed = false;
151 delete_if_unprocessed = false;
152 discard_if_unprocessed = false;
153 }
154
155let pp_block_flags fmt f =
156 let flags = [] in
157 let flags = if f.replicate_in_fragment then "replicate" :: flags else flags in
158 let flags = if f.report_if_unprocessed then "report" :: flags else flags in
159 let flags = if f.delete_if_unprocessed then "delete" :: flags else flags in
160 let flags = if f.discard_if_unprocessed then "discard" :: flags else flags in
161 Fmt.pf fmt "[%s]" (String.concat ", " (List.rev flags))
162
163let int_of_block_flags f =
164 let n = 0 in
165 let n = if f.replicate_in_fragment then n lor 0x01 else n in
166 let n = if f.report_if_unprocessed then n lor 0x02 else n in
167 let n = if f.delete_if_unprocessed then n lor 0x04 else n in
168 let n = if f.discard_if_unprocessed then n lor 0x10 else n in
169 n
170
171let block_flags_of_int n =
172 {
173 replicate_in_fragment = n land 0x01 <> 0;
174 report_if_unprocessed = n land 0x02 <> 0;
175 delete_if_unprocessed = n land 0x04 <> 0;
176 discard_if_unprocessed = n land 0x10 <> 0;
177 }
178
179(* {1 Creation Timestamp} *)
180
181type timestamp = { time : int64; seq : int64 }
182
183let pp_timestamp fmt ts = Fmt.pf fmt "{ time=%Ld; seq=%Ld }" ts.time ts.seq
184
185(* {1 Primary Block} *)
186
187type primary_block = {
188 version : int;
189 flags : flags;
190 crc_type : crc_type;
191 destination : eid;
192 source : eid;
193 report_to : eid;
194 creation_timestamp : timestamp;
195 lifetime : int64;
196 fragment_offset : int64 option;
197 total_adu_length : int64 option;
198}
199
200let pp_primary_block fmt pb =
201 Fmt.pf fmt
202 "@[<v 2>primary {@ version=%d;@ flags=%a;@ crc=%a;@ dest=%a;@ src=%a;@ \
203 report_to=%a;@ timestamp=%a;@ lifetime=%Ld%a%a@ }@]"
204 pb.version pp_flags pb.flags pp_crc_type pb.crc_type pp_eid pb.destination
205 pp_eid pb.source pp_eid pb.report_to pp_timestamp pb.creation_timestamp
206 pb.lifetime
207 (fun fmt -> function
208 | Some off -> Fmt.pf fmt ";@ fragment_offset=%Ld" off | None -> ())
209 pb.fragment_offset
210 (fun fmt -> function
211 | Some len -> Fmt.pf fmt ";@ total_adu_length=%Ld" len | None -> ())
212 pb.total_adu_length
213
214(* {1 Canonical Blocks} *)
215
216type block_type =
217 | Payload
218 | Previous_node
219 | Bundle_age
220 | Hop_count
221 | Other of int
222
223let pp_block_type fmt = function
224 | Payload -> Fmt.string fmt "payload"
225 | Previous_node -> Fmt.string fmt "previous-node"
226 | Bundle_age -> Fmt.string fmt "bundle-age"
227 | Hop_count -> Fmt.string fmt "hop-count"
228 | Other n -> Fmt.pf fmt "other(%d)" n
229
230let int_of_block_type = function
231 | Payload -> 1
232 | Previous_node -> 6
233 | Bundle_age -> 7
234 | Hop_count -> 10
235 | Other n -> n
236
237let block_type_of_int = function
238 | 1 -> Payload
239 | 6 -> Previous_node
240 | 7 -> Bundle_age
241 | 10 -> Hop_count
242 | n -> Other n
243
244type block_data =
245 | Payload_data of string
246 | Previous_node_data of eid
247 | Bundle_age_data of int64
248 | Hop_count_data of { limit : int; count : int }
249 | Unknown_data of string
250
251let pp_block_data fmt = function
252 | Payload_data b -> Fmt.pf fmt "payload[%d bytes]" (String.length b)
253 | Previous_node_data eid -> Fmt.pf fmt "previous-node=%a" pp_eid eid
254 | Bundle_age_data age -> Fmt.pf fmt "age=%Ld ms" age
255 | Hop_count_data { limit; count } -> Fmt.pf fmt "hop-count=%d/%d" count limit
256 | Unknown_data b -> Fmt.pf fmt "unknown[%d bytes]" (String.length b)
257
258type canonical_block = {
259 block_type : block_type;
260 block_number : int;
261 flags : block_flags;
262 crc_type : crc_type;
263 data : block_data;
264}
265
266let pp_canonical_block fmt cb =
267 Fmt.pf fmt "@[<v 2>block#%d {@ type=%a;@ flags=%a;@ crc=%a;@ data=%a@ }@]"
268 cb.block_number pp_block_type cb.block_type pp_block_flags cb.flags
269 pp_crc_type cb.crc_type pp_block_data cb.data
270
271(* {1 Bundle} *)
272
273type t = { primary : primary_block; blocks : canonical_block list }
274
275let pp fmt bundle =
276 Fmt.pf fmt "@[<v 2>bundle {@ %a" pp_primary_block bundle.primary;
277 List.iter (fun b -> Fmt.pf fmt "@ %a" pp_canonical_block b) bundle.blocks;
278 Fmt.pf fmt "@ }@]"
279
280(* {1 Errors} *)
281
282type error =
283 | Invalid_version of int
284 | Invalid_crc_type of int
285 | Invalid_eid_scheme of int
286 | Invalid_block_type of int
287 | Missing_payload_block
288 | Crc_mismatch of { expected : string; computed : string }
289 | Cbor_error of string
290 | Truncated of string
291
292let pp_hex fmt s = String.iter (fun c -> Fmt.pf fmt "%02x" (Char.code c)) s
293
294let pp_error fmt = function
295 | Invalid_version v -> Fmt.pf fmt "invalid version: %d (expected 7)" v
296 | Invalid_crc_type n -> Fmt.pf fmt "invalid CRC type: %d" n
297 | Invalid_eid_scheme n -> Fmt.pf fmt "invalid EID scheme: %d" n
298 | Invalid_block_type n -> Fmt.pf fmt "invalid block type: %d" n
299 | Missing_payload_block -> Fmt.pf fmt "missing payload block"
300 | Crc_mismatch { expected; computed } ->
301 Fmt.pf fmt "CRC mismatch: expected %a, computed %a" pp_hex expected pp_hex
302 computed
303 | Cbor_error msg -> Fmt.pf fmt "CBOR error: %s" msg
304 | Truncated msg -> Fmt.pf fmt "truncated: %s" msg
305
306open Result.Syntax
307
308(* Helper to convert Option to Result with Cbor_error *)
309let require msg = function Some v -> Ok v | None -> Error (Cbor_error msg)
310
311(* {1 CRC Computation} *)
312
313let crc16_x25 = Crc.crc16_x25
314let crc32c = Crc.crc32c
315
316let compute_crc crc_type data =
317 match crc_type with
318 | No_crc -> ""
319 | Crc16 ->
320 let crc = crc16_x25 data in
321 let buf = Bytes.create 2 in
322 Bytes.set_uint16_be buf 0 crc;
323 Bytes.to_string buf
324 | Crc32c ->
325 let crc = crc32c data in
326 let buf = Bytes.create 4 in
327 Bytes.set_int32_be buf 0 (Int32.of_int crc);
328 Bytes.to_string buf
329
330(* {1 CBOR Helpers} *)
331
332let cbor_encode (v : Cbor.t) : string =
333 let buf = Buffer.create 256 in
334 let writer = Bytesrw.Bytes.Writer.of_buffer buf in
335 let enc = Cbor_rw.encoder writer in
336 Cbor_rw.write_cbor enc v;
337 Cbor_rw.flush_encoder enc;
338 Buffer.contents buf
339
340let cbor_decode (s : string) : Cbor.t option =
341 try
342 let reader = Bytesrw.Bytes.Reader.of_string s in
343 let dec = Cbor_rw.decoder reader in
344 Some (Cbor_rw.read_cbor dec)
345 with End_of_file | Failure _ | Invalid_argument _ -> None
346
347(* {1 Encoding} *)
348
349let encode_timestamp ts = Cbor.Array [ Cbor.int64 ts.time; Cbor.int64 ts.seq ]
350
351let encode_block_data = function
352 | Payload_data b -> Cbor.Bytes b
353 | Previous_node_data eid ->
354 let cbor = eid_to_cbor eid in
355 Cbor.Bytes (cbor_encode cbor)
356 | Bundle_age_data age -> Cbor.Bytes (cbor_encode (Cbor.int64 age))
357 | Hop_count_data { limit; count } ->
358 let cbor = Cbor.Array [ Cbor.int limit; Cbor.int count ] in
359 Cbor.Bytes (cbor_encode cbor)
360 | Unknown_data b -> Cbor.Bytes b
361
362let encode_primary pb =
363 let elements =
364 [
365 Cbor.int pb.version;
366 Cbor.int (int_of_flags pb.flags);
367 Cbor.int (int_of_crc_type pb.crc_type);
368 eid_to_cbor pb.destination;
369 eid_to_cbor pb.source;
370 eid_to_cbor pb.report_to;
371 encode_timestamp pb.creation_timestamp;
372 Cbor.int64 pb.lifetime;
373 ]
374 in
375 let elements =
376 match pb.fragment_offset with
377 | Some off -> elements @ [ Cbor.int64 off ]
378 | None -> elements
379 in
380 let elements =
381 match pb.total_adu_length with
382 | Some len -> elements @ [ Cbor.int64 len ]
383 | None -> elements
384 in
385 (* Add CRC placeholder if needed *)
386 let elements =
387 match pb.crc_type with
388 | No_crc -> elements
389 | Crc16 -> elements @ [ Cbor.Bytes (String.make 2 '\x00') ]
390 | Crc32c -> elements @ [ Cbor.Bytes (String.make 4 '\x00') ]
391 in
392 let arr = Cbor.Array elements in
393 (* Compute CRC if needed *)
394 match pb.crc_type with
395 | No_crc -> arr
396 | _ -> (
397 let encoded = cbor_encode arr in
398 let crc = compute_crc pb.crc_type encoded in
399 let crc_len = String.length crc in
400 (* Replace the last crc_len bytes with computed CRC *)
401 let encoded_bytes = Bytes.of_string encoded in
402 Bytes.blit_string crc 0 encoded_bytes
403 (Bytes.length encoded_bytes - crc_len)
404 crc_len;
405 (* Re-decode to get proper CBOR structure *)
406 match cbor_decode (Bytes.to_string encoded_bytes) with
407 | Some v -> v
408 | None -> arr)
409
410let encode_canonical cb =
411 let elements =
412 [
413 Cbor.int (int_of_block_type cb.block_type);
414 Cbor.int cb.block_number;
415 Cbor.int (int_of_block_flags cb.flags);
416 Cbor.int (int_of_crc_type cb.crc_type);
417 encode_block_data cb.data;
418 ]
419 in
420 let elements =
421 match cb.crc_type with
422 | No_crc -> elements
423 | Crc16 -> elements @ [ Cbor.Bytes (String.make 2 '\x00') ]
424 | Crc32c -> elements @ [ Cbor.Bytes (String.make 4 '\x00') ]
425 in
426 let arr = Cbor.Array elements in
427 match cb.crc_type with
428 | No_crc -> arr
429 | _ -> (
430 let encoded = cbor_encode arr in
431 let crc = compute_crc cb.crc_type encoded in
432 let crc_len = String.length crc in
433 let encoded_bytes = Bytes.of_string encoded in
434 Bytes.blit_string crc 0 encoded_bytes
435 (Bytes.length encoded_bytes - crc_len)
436 crc_len;
437 match cbor_decode (Bytes.to_string encoded_bytes) with
438 | Some v -> v
439 | None -> arr)
440
441let to_cbor bundle =
442 let primary_cbor = encode_primary bundle.primary in
443 let blocks_cbor = List.map encode_canonical bundle.blocks in
444 (* BPv7 uses indefinite-length array, but cbort doesn't have Iarray,
445 so we use regular Array which should be compatible *)
446 Cbor.Array (primary_cbor :: blocks_cbor)
447
448let encode bundle = cbor_encode (to_cbor bundle)
449let write enc bundle = Cbor_rw.write_cbor enc (to_cbor bundle)
450
451(* {1 Decoding} *)
452
453let decode_timestamp cbor =
454 match Cbor.to_array cbor with
455 | Some [ time_cbor; seq_cbor ] -> (
456 match (Cbor.to_int64 time_cbor, Cbor.to_int64 seq_cbor) with
457 | Some time, Some seq -> Ok { time; seq }
458 | _ -> Error (Cbor_error "timestamp fields must be uint"))
459 | _ -> Error (Cbor_error "timestamp must be array of 2")
460
461let decode_block_data block_type data_bytes =
462 let require_cbor msg = cbor_decode data_bytes |> require msg in
463 match block_type with
464 | Payload -> Ok (Payload_data data_bytes)
465 | Previous_node ->
466 let* cbor = require_cbor "failed to decode previous node CBOR" in
467 let* eid =
468 eid_of_cbor cbor |> Result.map_error (fun msg -> Cbor_error msg)
469 in
470 Ok (Previous_node_data eid)
471 | Bundle_age ->
472 let* cbor = require_cbor "failed to decode bundle age CBOR" in
473 let* age = Cbor.to_int64 cbor |> require "bundle age must be uint" in
474 Ok (Bundle_age_data age)
475 | Hop_count -> (
476 let* cbor = require_cbor "failed to decode hop count CBOR" in
477 let* elements =
478 Cbor.to_array cbor |> require "hop count must be array of 2"
479 in
480 match elements with
481 | [ limit_cbor; count_cbor ] ->
482 let* limit =
483 Cbor.to_int64 limit_cbor |> require "hop count fields must be uint"
484 in
485 let* count =
486 Cbor.to_int64 count_cbor |> require "hop count fields must be uint"
487 in
488 Ok
489 (Hop_count_data
490 { limit = Int64.to_int limit; count = Int64.to_int count })
491 | _ -> Error (Cbor_error "hop count must be array of 2"))
492 | Other _ -> Ok (Unknown_data data_bytes)
493
494let decode_primary cbor =
495 let* elements = Cbor.to_array cbor |> require "primary block must be array" in
496 if List.length elements < 8 then
497 Error (Truncated "primary block needs at least 8 elements")
498 else
499 let get i = List.nth elements i in
500 let* version = Cbor.to_int64 (get 0) |> require "version must be uint" in
501 if version <> 7L then Error (Invalid_version (Int64.to_int version))
502 else
503 let* flags_int = Cbor.to_int64 (get 1) |> require "flags must be uint" in
504 let flags = flags_of_int (Int64.to_int flags_int) in
505 let* crc_int = Cbor.to_int64 (get 2) |> require "CRC type must be uint" in
506 let* crc_type =
507 crc_type_of_int (Int64.to_int crc_int)
508 |> Result.map_error (fun n -> Invalid_crc_type n)
509 in
510 let* destination =
511 eid_of_cbor (get 3) |> Result.map_error (fun msg -> Cbor_error msg)
512 in
513 let* source =
514 eid_of_cbor (get 4) |> Result.map_error (fun msg -> Cbor_error msg)
515 in
516 let* report_to =
517 eid_of_cbor (get 5) |> Result.map_error (fun msg -> Cbor_error msg)
518 in
519 let* creation_timestamp = decode_timestamp (get 6) in
520 let* lifetime =
521 Cbor.to_int64 (get 7) |> require "lifetime must be uint"
522 in
523 let fragment_offset, total_adu_length =
524 if flags.is_fragment && List.length elements >= 10 then
525 (Cbor.to_int64 (get 8), Cbor.to_int64 (get 9))
526 else (None, None)
527 in
528 Ok
529 {
530 version = 7;
531 flags;
532 crc_type;
533 destination;
534 source;
535 report_to;
536 creation_timestamp;
537 lifetime;
538 fragment_offset;
539 total_adu_length;
540 }
541
542let decode_canonical cbor =
543 let* elements =
544 Cbor.to_array cbor |> require "canonical block must be array"
545 in
546 if List.length elements < 5 then
547 Error (Truncated "canonical block needs at least 5 elements")
548 else
549 let get i = List.nth elements i in
550 let* type_int =
551 Cbor.to_int64 (get 0) |> require "block type must be uint"
552 in
553 let block_type = block_type_of_int (Int64.to_int type_int) in
554 let* block_number =
555 Cbor.to_int64 (get 1) |> require "block number must be uint"
556 in
557 let* flags_int = Cbor.to_int64 (get 2) |> require "flags must be uint" in
558 let flags = block_flags_of_int (Int64.to_int flags_int) in
559 let* crc_int = Cbor.to_int64 (get 3) |> require "CRC type must be uint" in
560 let* crc_type =
561 crc_type_of_int (Int64.to_int crc_int)
562 |> Result.map_error (fun n -> Invalid_crc_type n)
563 in
564 let* data_bytes =
565 Cbor.to_bytes (get 4) |> require "block data must be bytes"
566 in
567 let* data = decode_block_data block_type data_bytes in
568 Ok
569 {
570 block_type;
571 block_number = Int64.to_int block_number;
572 flags;
573 crc_type;
574 data;
575 }
576
577let of_cbor cbor =
578 let* elements = Cbor.to_array cbor |> require "bundle must be array" in
579 match elements with
580 | [] -> Error (Truncated "bundle must have at least primary block")
581 | primary_cbor :: blocks_cbor ->
582 let* primary = decode_primary primary_cbor in
583 let rec decode_blocks acc = function
584 | [] -> Ok (List.rev acc)
585 | b :: rest ->
586 let* block = decode_canonical b in
587 decode_blocks (block :: acc) rest
588 in
589 let* blocks = decode_blocks [] blocks_cbor in
590 let has_payload = List.exists (fun b -> b.block_type = Payload) blocks in
591 if has_payload then Ok { primary; blocks }
592 else Error Missing_payload_block
593
594let decode s =
595 match cbor_decode s with
596 | Some cbor -> of_cbor cbor
597 | None -> Error (Cbor_error "failed to decode CBOR")
598
599let read dec =
600 try
601 let cbor = Cbor_rw.read_cbor dec in
602 of_cbor cbor
603 with e -> Error (Cbor_error (Printexc.to_string e))
604
605(* {1 Constructors} *)
606
607let v ?(flags = default_flags) ?(crc_type = Crc32c) ?report_to
608 ?(lifetime = 86400000L) ~source ~destination ~creation_timestamp ~payload ()
609 =
610 let report_to = match report_to with Some e -> e | None -> source in
611 let primary =
612 {
613 version = 7;
614 flags;
615 crc_type;
616 destination;
617 source;
618 report_to;
619 creation_timestamp;
620 lifetime;
621 fragment_offset = None;
622 total_adu_length = None;
623 }
624 in
625 let payload_block =
626 {
627 block_type = Payload;
628 block_number = 1;
629 flags = block_flags_default;
630 crc_type;
631 data = Payload_data payload;
632 }
633 in
634 { primary; blocks = [ payload_block ] }
635
636let payload bundle =
637 List.find_map
638 (fun b -> match b.data with Payload_data p -> Some p | _ -> None)
639 bundle.blocks
640
641let previous_node bundle =
642 List.find_map
643 (fun b ->
644 match b.data with Previous_node_data eid -> Some eid | _ -> None)
645 bundle.blocks
646
647let age bundle =
648 List.find_map
649 (fun b -> match b.data with Bundle_age_data age -> Some age | _ -> None)
650 bundle.blocks
651
652let hop_count bundle =
653 List.find_map
654 (fun b ->
655 match b.data with
656 | Hop_count_data { limit; count } -> Some (limit, count)
657 | _ -> None)
658 bundle.blocks