Bundle Protocol Security (RFC 9172) - authentication and encryption for DTN
Squashed 'ocaml-bpsec/' content from commit 5813e80d git-subtree-split: 5813e80d260028baf8fd1205713c000811f5613e
+1047
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.28.1
+15
LICENSE.md
+15
LICENSE.md
···
1
+
ISC License
2
+
3
+
Copyright (c) 2025 Thomas Gazagnaire
4
+
5
+
Permission to use, copy, modify, and/or distribute this software for any
6
+
purpose with or without fee is hereby granted, provided that the above
7
+
copyright notice and this permission notice appear in all copies.
8
+
9
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
10
+
REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
11
+
AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
12
+
INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
13
+
LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
14
+
OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
15
+
PERFORMANCE OF THIS SOFTWARE.
+71
README.md
+71
README.md
···
1
+
# bpsec
2
+
3
+
Pure OCaml implementation of Bundle Protocol Security (RFC 9172) for
4
+
Delay-Tolerant Networking.
5
+
6
+
## Overview
7
+
8
+
BPSec provides integrity and confidentiality services for Bundle Protocol v7
9
+
bundles. It defines two extension block types:
10
+
11
+
- **Block Integrity Block (BIB)** - HMAC-based integrity protection
12
+
- **Block Confidentiality Block (BCB)** - AES-GCM authenticated encryption
13
+
14
+
## Features
15
+
16
+
- Full RFC 9172 BPSec implementation
17
+
- RFC 9173 default security contexts:
18
+
- BIB-HMAC-SHA2 (SHA-256, SHA-384, SHA-512)
19
+
- BCB-AES-GCM (A128GCM, A256GCM)
20
+
- CBOR encoding/decoding
21
+
- Integration with `bundle` library
22
+
23
+
## Installation
24
+
25
+
```
26
+
opam install bpsec
27
+
```
28
+
29
+
## Usage
30
+
31
+
```ocaml
32
+
(* Create a Block Integrity Block *)
33
+
let key = String.make 32 '\x42' in
34
+
let bib = Bpsec.create_bib
35
+
~key
36
+
~source:(Bundle.Ipn (1L, 1L))
37
+
~targets:[1]
38
+
~target_data:["payload data"]
39
+
()
40
+
41
+
(* Verify integrity *)
42
+
let valid = Bpsec.verify_bib ~key bib ~target_data:["payload data"]
43
+
44
+
(* Create a Block Confidentiality Block *)
45
+
let bcb, encrypted = Bpsec.create_bcb
46
+
~key
47
+
~source:(Bundle.Ipn (1L, 1L))
48
+
~targets:[1]
49
+
~target_data:["secret payload"]
50
+
()
51
+
52
+
(* Decrypt *)
53
+
match Bpsec.decrypt_bcb ~key bcb ~ciphertext:encrypted with
54
+
| Some plaintext -> (* ... *)
55
+
| None -> (* decryption failed *)
56
+
```
57
+
58
+
## Related Work
59
+
60
+
- [ION](https://sourceforge.net/projects/ion-dtn/) - NASA/JPL DTN with BPSec
61
+
- [µD3TN](https://gitlab.com/d3tn/ud3tn) - Lightweight DTN implementation
62
+
- [DTN7-go](https://github.com/dtn7/dtn7-go) - Go BPv7 with BPSec support
63
+
64
+
## References
65
+
66
+
- [RFC 9172](https://datatracker.ietf.org/doc/html/rfc9172) - Bundle Protocol Security
67
+
- [RFC 9173](https://datatracker.ietf.org/doc/html/rfc9173) - Default Security Contexts
68
+
69
+
## License
70
+
71
+
ISC License. See [LICENSE.md](LICENSE.md) for details.
+31
dune-project
+31
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name bpsec)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
9
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
11
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
12
+
13
+
(source
14
+
(uri https://github.com/samoht/ocaml-bpsec))
15
+
16
+
(package
17
+
(name bpsec)
18
+
(synopsis "Bundle Protocol Security (RFC 9172)")
19
+
(description
20
+
"Pure OCaml implementation of BPSec providing integrity and confidentiality
21
+
services for Bundle Protocol v7. Implements Block Integrity Block (BIB) and
22
+
Block Confidentiality Block (BCB) using HMAC-SHA256 and AES-GCM.")
23
+
(depends
24
+
(ocaml (>= 4.14))
25
+
(bundle (>= 0.1))
26
+
(cbort (>= 0.1))
27
+
(mirage-crypto (>= 1.0))
28
+
(mirage-crypto-rng (>= 1.0))
29
+
fmt
30
+
(alcotest :with-test)
31
+
(crowbar :with-test)))
+10
fuzz/dune
+10
fuzz/dune
+89
fuzz/fuzz_bpsec.ml
+89
fuzz/fuzz_bpsec.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Crowbar
7
+
8
+
let () = Mirage_crypto_rng_unix.use_default ()
9
+
10
+
let truncate s =
11
+
if String.length s > 1024 then String.sub s 0 1024 else s
12
+
13
+
let to_bytes buf =
14
+
let len = String.length buf in
15
+
let b = Bytes.create len in
16
+
Bytes.blit_string buf 0 b 0 len;
17
+
b
18
+
19
+
(** Security block decode - must not crash. *)
20
+
let test_decode buf =
21
+
let buf = truncate buf in
22
+
let reader = Bytesrw.Bytes.Reader.of_string buf in
23
+
let dec = Cbort.Rw.make_decoder reader in
24
+
(try
25
+
let cbor = Cbort.Rw.read_cbor dec in
26
+
let _ = Bpsec.security_block_of_cbor cbor in
27
+
()
28
+
with _ -> ());
29
+
()
30
+
31
+
(** BIB create/verify roundtrip. *)
32
+
let test_bib_roundtrip key_seed data =
33
+
if String.length key_seed < 32 then ()
34
+
else
35
+
let key = String.sub key_seed 0 32 in
36
+
let data = truncate data in
37
+
if String.length data = 0 then ()
38
+
else
39
+
let source = Bundle.Dtn_none in
40
+
let targets = [ 1 ] in
41
+
let target_data = [ data ] in
42
+
let bib =
43
+
Bpsec.create_bib ~key ~source ~targets ~target_data ()
44
+
in
45
+
let verified = Bpsec.verify_bib ~key bib ~target_data in
46
+
if not verified then fail "BIB roundtrip failed"
47
+
48
+
(** BCB create/decrypt roundtrip. *)
49
+
let test_bcb_roundtrip key_seed data =
50
+
if String.length key_seed < 32 then ()
51
+
else
52
+
let key = String.sub key_seed 0 32 in
53
+
let data = truncate data in
54
+
if String.length data = 0 then ()
55
+
else
56
+
let source = Bundle.Dtn_none in
57
+
let targets = [ 1 ] in
58
+
let target_data = [ data ] in
59
+
let bcb, encrypted =
60
+
Bpsec.create_bcb ~key ~source ~targets ~target_data ()
61
+
in
62
+
match Bpsec.decrypt_bcb ~key bcb ~ciphertext:encrypted with
63
+
| Some decrypted ->
64
+
if decrypted <> target_data then fail "BCB roundtrip mismatch"
65
+
| None -> fail "BCB decryption failed"
66
+
67
+
(** CBOR roundtrip for security block. *)
68
+
let test_cbor_roundtrip key_seed data =
69
+
if String.length key_seed < 32 then ()
70
+
else
71
+
let key = String.sub key_seed 0 32 in
72
+
let data = truncate data in
73
+
if String.length data = 0 then ()
74
+
else
75
+
let source = Bundle.Dtn_none in
76
+
let targets = [ 1 ] in
77
+
let target_data = [ data ] in
78
+
let bib = Bpsec.create_bib ~key ~source ~targets ~target_data () in
79
+
let cbor = Bpsec.security_block_to_cbor bib in
80
+
match Bpsec.security_block_of_cbor cbor with
81
+
| Ok decoded ->
82
+
if decoded.targets <> targets then fail "targets mismatch"
83
+
| Error _ -> fail "CBOR roundtrip decode failed"
84
+
85
+
let () =
86
+
add_test ~name:"bpsec: decode no crash" [ bytes ] test_decode;
87
+
add_test ~name:"bpsec: BIB roundtrip" [ bytes; bytes ] test_bib_roundtrip;
88
+
add_test ~name:"bpsec: BCB roundtrip" [ bytes; bytes ] test_bcb_roundtrip;
89
+
add_test ~name:"bpsec: CBOR roundtrip" [ bytes; bytes ] test_cbor_roundtrip
+498
lib/bpsec.ml
+498
lib/bpsec.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Bundle Protocol Security (RFC 9172). *)
7
+
8
+
module Cbor = Cbort.Cbor
9
+
10
+
(* {1 Security Context} *)
11
+
12
+
type security_context_id = int
13
+
14
+
let bib_hmac_sha2 = 1
15
+
let bcb_aes_gcm = 2
16
+
17
+
(* {1 Security Context Flags} *)
18
+
19
+
type context_flags = { parameters_present : bool }
20
+
21
+
let context_flags_default = { parameters_present = false }
22
+
23
+
let int_of_context_flags f = if f.parameters_present then 1 else 0
24
+
let context_flags_of_int n = { parameters_present = n land 1 <> 0 }
25
+
26
+
(* {1 Security Parameters} *)
27
+
28
+
type bib_parameter =
29
+
| SHA_variant of int
30
+
| Wrapped_key of string
31
+
| Integrity_scope_flags of int
32
+
33
+
type bcb_parameter =
34
+
| IV of string
35
+
| AES_variant of int
36
+
| Wrapped_key of string
37
+
| AAD_scope_flags of int
38
+
39
+
type parameter =
40
+
| Bib_param of bib_parameter
41
+
| Bcb_param of bcb_parameter
42
+
| Unknown_param of int * string
43
+
44
+
(* {1 Security Results} *)
45
+
46
+
type bib_result = Expected_hmac of string
47
+
type bcb_result = Auth_tag of string
48
+
49
+
type result =
50
+
| Bib_result of bib_result
51
+
| Bcb_result of bcb_result
52
+
| Unknown_result of int * string
53
+
54
+
(* {1 Security Blocks} *)
55
+
56
+
type security_target = int
57
+
58
+
type security_block = {
59
+
targets : security_target list;
60
+
context_id : security_context_id;
61
+
context_flags : context_flags;
62
+
source : Bundle.eid;
63
+
parameters : parameter list;
64
+
results : result list list;
65
+
}
66
+
67
+
(* {1 Block Types} *)
68
+
69
+
type bib = security_block
70
+
type bcb = security_block
71
+
72
+
let bib_block_type = 11
73
+
let bcb_block_type = 12
74
+
75
+
(* {1 Errors} *)
76
+
77
+
type error =
78
+
| Invalid_security_context of int
79
+
| Invalid_parameter of int
80
+
| Invalid_result of int
81
+
| Missing_parameter of string
82
+
| Verification_failed
83
+
| Decryption_failed
84
+
| Cbor_error of string
85
+
86
+
let pp_error fmt = function
87
+
| Invalid_security_context n ->
88
+
Format.fprintf fmt "invalid security context: %d" n
89
+
| Invalid_parameter n -> Format.fprintf fmt "invalid parameter: %d" n
90
+
| Invalid_result n -> Format.fprintf fmt "invalid result: %d" n
91
+
| Missing_parameter name -> Format.fprintf fmt "missing parameter: %s" name
92
+
| Verification_failed -> Format.fprintf fmt "verification failed"
93
+
| Decryption_failed -> Format.fprintf fmt "decryption failed"
94
+
| Cbor_error msg -> Format.fprintf fmt "CBOR error: %s" msg
95
+
96
+
(* {1 CBOR Encoding/Decoding} *)
97
+
98
+
let parameter_to_cbor = function
99
+
| Bib_param (SHA_variant v) ->
100
+
Cbor.Array [ Cbor.int 1; Cbor.int v ]
101
+
| Bib_param (Wrapped_key k) ->
102
+
Cbor.Array [ Cbor.int 2; Cbor.Bytes k ]
103
+
| Bib_param (Integrity_scope_flags f) ->
104
+
Cbor.Array [ Cbor.int 3; Cbor.int f ]
105
+
| Bcb_param (IV iv) ->
106
+
Cbor.Array [ Cbor.int 1; Cbor.Bytes iv ]
107
+
| Bcb_param (AES_variant v) ->
108
+
Cbor.Array [ Cbor.int 2; Cbor.int v ]
109
+
| Bcb_param (Wrapped_key k) ->
110
+
Cbor.Array [ Cbor.int 3; Cbor.Bytes k ]
111
+
| Bcb_param (AAD_scope_flags f) ->
112
+
Cbor.Array [ Cbor.int 4; Cbor.int f ]
113
+
| Unknown_param (id, data) ->
114
+
Cbor.Array [ Cbor.int id; Cbor.Bytes data ]
115
+
116
+
let result_to_cbor = function
117
+
| Bib_result (Expected_hmac h) ->
118
+
Cbor.Array [ Cbor.int 1; Cbor.Bytes h ]
119
+
| Bcb_result (Auth_tag t) ->
120
+
Cbor.Array [ Cbor.int 1; Cbor.Bytes t ]
121
+
| Unknown_result (id, data) ->
122
+
Cbor.Array [ Cbor.int id; Cbor.Bytes data ]
123
+
124
+
let security_block_to_cbor sb =
125
+
let targets = Cbor.Array (List.map Cbor.int sb.targets) in
126
+
let context_id = Cbor.int sb.context_id in
127
+
let context_flags = Cbor.int (int_of_context_flags sb.context_flags) in
128
+
let source = Bundle.eid_to_cbor sb.source in
129
+
let parameters =
130
+
if sb.context_flags.parameters_present then
131
+
[ Cbor.Array (List.map parameter_to_cbor sb.parameters) ]
132
+
else []
133
+
in
134
+
let results =
135
+
Cbor.Array
136
+
(List.map
137
+
(fun target_results ->
138
+
Cbor.Array (List.map result_to_cbor target_results))
139
+
sb.results)
140
+
in
141
+
Cbor.Array ([ targets; context_id; context_flags; source ] @ parameters @ [ results ])
142
+
143
+
let parameter_of_cbor context_id cbor =
144
+
match Cbor.to_array cbor with
145
+
| Some [ id_cbor; value_cbor ] -> (
146
+
match Cbor.to_int64 id_cbor with
147
+
| Some id_int ->
148
+
let id = Int64.to_int id_int in
149
+
if context_id = bib_hmac_sha2 then
150
+
match id with
151
+
| 1 -> (
152
+
match Cbor.to_int64 value_cbor with
153
+
| Some v -> Ok (Bib_param (SHA_variant (Int64.to_int v)))
154
+
| None -> Error (Invalid_parameter id))
155
+
| 2 -> (
156
+
match Cbor.to_bytes value_cbor with
157
+
| Some k -> Ok (Bib_param (Wrapped_key k))
158
+
| None -> Error (Invalid_parameter id))
159
+
| 3 -> (
160
+
match Cbor.to_int64 value_cbor with
161
+
| Some f -> Ok (Bib_param (Integrity_scope_flags (Int64.to_int f)))
162
+
| None -> Error (Invalid_parameter id))
163
+
| _ -> (
164
+
match Cbor.to_bytes value_cbor with
165
+
| Some data -> Ok (Unknown_param (id, data))
166
+
| None -> Error (Invalid_parameter id))
167
+
else if context_id = bcb_aes_gcm then
168
+
match id with
169
+
| 1 -> (
170
+
match Cbor.to_bytes value_cbor with
171
+
| Some iv -> Ok (Bcb_param (IV iv))
172
+
| None -> Error (Invalid_parameter id))
173
+
| 2 -> (
174
+
match Cbor.to_int64 value_cbor with
175
+
| Some v -> Ok (Bcb_param (AES_variant (Int64.to_int v)))
176
+
| None -> Error (Invalid_parameter id))
177
+
| 3 -> (
178
+
match Cbor.to_bytes value_cbor with
179
+
| Some k -> Ok (Bcb_param (Wrapped_key k))
180
+
| None -> Error (Invalid_parameter id))
181
+
| 4 -> (
182
+
match Cbor.to_int64 value_cbor with
183
+
| Some f -> Ok (Bcb_param (AAD_scope_flags (Int64.to_int f)))
184
+
| None -> Error (Invalid_parameter id))
185
+
| _ -> (
186
+
match Cbor.to_bytes value_cbor with
187
+
| Some data -> Ok (Unknown_param (id, data))
188
+
| None -> Error (Invalid_parameter id))
189
+
else
190
+
match Cbor.to_bytes value_cbor with
191
+
| Some data -> Ok (Unknown_param (id, data))
192
+
| None -> Error (Invalid_parameter id)
193
+
| None -> Error (Cbor_error "parameter id must be uint"))
194
+
| _ -> Error (Cbor_error "parameter must be array of 2")
195
+
196
+
let result_of_cbor context_id cbor =
197
+
match Cbor.to_array cbor with
198
+
| Some [ id_cbor; value_cbor ] -> (
199
+
match Cbor.to_int64 id_cbor with
200
+
| Some id_int ->
201
+
let id = Int64.to_int id_int in
202
+
if context_id = bib_hmac_sha2 then
203
+
match id with
204
+
| 1 -> (
205
+
match Cbor.to_bytes value_cbor with
206
+
| Some h -> Ok (Bib_result (Expected_hmac h))
207
+
| None -> Error (Invalid_result id))
208
+
| _ -> (
209
+
match Cbor.to_bytes value_cbor with
210
+
| Some data -> Ok (Unknown_result (id, data))
211
+
| None -> Error (Invalid_result id))
212
+
else if context_id = bcb_aes_gcm then
213
+
match id with
214
+
| 1 -> (
215
+
match Cbor.to_bytes value_cbor with
216
+
| Some t -> Ok (Bcb_result (Auth_tag t))
217
+
| None -> Error (Invalid_result id))
218
+
| _ -> (
219
+
match Cbor.to_bytes value_cbor with
220
+
| Some data -> Ok (Unknown_result (id, data))
221
+
| None -> Error (Invalid_result id))
222
+
else
223
+
match Cbor.to_bytes value_cbor with
224
+
| Some data -> Ok (Unknown_result (id, data))
225
+
| None -> Error (Invalid_result id)
226
+
| None -> Error (Cbor_error "result id must be uint"))
227
+
| _ -> Error (Cbor_error "result must be array of 2")
228
+
229
+
let security_block_of_cbor cbor =
230
+
match Cbor.to_array cbor with
231
+
| Some elements when List.length elements >= 5 -> (
232
+
let get i = List.nth elements i in
233
+
match Cbor.to_array (get 0) with
234
+
| Some target_cbors -> (
235
+
let targets =
236
+
List.filter_map
237
+
(fun c ->
238
+
match Cbor.to_int64 c with
239
+
| Some n -> Some (Int64.to_int n)
240
+
| None -> None)
241
+
target_cbors
242
+
in
243
+
match Cbor.to_int64 (get 1) with
244
+
| Some context_id_int -> (
245
+
let context_id = Int64.to_int context_id_int in
246
+
match Cbor.to_int64 (get 2) with
247
+
| Some flags_int -> (
248
+
let context_flags = context_flags_of_int (Int64.to_int flags_int) in
249
+
match Bundle.eid_of_cbor (get 3) with
250
+
| Ok source -> (
251
+
let param_idx, result_idx =
252
+
if context_flags.parameters_present then (4, 5) else (4, 4)
253
+
in
254
+
let parameters =
255
+
if context_flags.parameters_present then
256
+
match Cbor.to_array (get param_idx) with
257
+
| Some param_cbors ->
258
+
List.filter_map
259
+
(fun c ->
260
+
match parameter_of_cbor context_id c with
261
+
| Ok p -> Some p
262
+
| Error _ -> None)
263
+
param_cbors
264
+
| None -> []
265
+
else []
266
+
in
267
+
let result_idx =
268
+
if context_flags.parameters_present then result_idx else param_idx
269
+
in
270
+
match Cbor.to_array (get result_idx) with
271
+
| Some result_arrays ->
272
+
let results =
273
+
List.map
274
+
(fun arr ->
275
+
match Cbor.to_array arr with
276
+
| Some result_cbors ->
277
+
List.filter_map
278
+
(fun c ->
279
+
match result_of_cbor context_id c with
280
+
| Ok r -> Some r
281
+
| Error _ -> None)
282
+
result_cbors
283
+
| None -> [])
284
+
result_arrays
285
+
in
286
+
Ok
287
+
{
288
+
targets;
289
+
context_id;
290
+
context_flags;
291
+
source;
292
+
parameters;
293
+
results;
294
+
}
295
+
| None -> Error (Cbor_error "results must be array"))
296
+
| Error msg -> Error (Cbor_error msg))
297
+
| None -> Error (Cbor_error "flags must be uint"))
298
+
| None -> Error (Cbor_error "context id must be uint"))
299
+
| None -> Error (Cbor_error "targets must be array"))
300
+
| Some _ -> Error (Cbor_error "security block needs at least 5 elements")
301
+
| None -> Error (Cbor_error "security block must be array")
302
+
303
+
(* {1 Crypto Operations} *)
304
+
305
+
let compute_hmac ~key ~sha_variant ~scope_flags:_ data =
306
+
let module Hash =
307
+
(val match sha_variant with
308
+
| 5 -> (module Mirage_crypto.Hash.SHA256 : Mirage_crypto.Hash.S)
309
+
| 6 -> (module Mirage_crypto.Hash.SHA384 : Mirage_crypto.Hash.S)
310
+
| 7 -> (module Mirage_crypto.Hash.SHA512 : Mirage_crypto.Hash.S)
311
+
| _ -> (module Mirage_crypto.Hash.SHA256 : Mirage_crypto.Hash.S))
312
+
in
313
+
let key = Cstruct.of_string key in
314
+
let data = Cstruct.of_string data in
315
+
Cstruct.to_string (Mirage_crypto.Hash.mac (module Hash) ~key data)
316
+
317
+
let create_bib ~key ?(sha_variant = 5) ~source ~targets ~target_data () =
318
+
let scope_flags = 0x07 in (* Include primary block, target header, security header *)
319
+
let parameters =
320
+
[
321
+
Bib_param (SHA_variant sha_variant);
322
+
Bib_param (Integrity_scope_flags scope_flags);
323
+
]
324
+
in
325
+
let results =
326
+
List.map
327
+
(fun data ->
328
+
let hmac = compute_hmac ~key ~sha_variant ~scope_flags data in
329
+
[ Bib_result (Expected_hmac hmac) ])
330
+
target_data
331
+
in
332
+
{
333
+
targets;
334
+
context_id = bib_hmac_sha2;
335
+
context_flags = { parameters_present = true };
336
+
source;
337
+
parameters;
338
+
results;
339
+
}
340
+
341
+
let verify_bib ~key bib ~target_data =
342
+
let sha_variant =
343
+
List.find_map
344
+
(function Bib_param (SHA_variant v) -> Some v | _ -> None)
345
+
bib.parameters
346
+
|> Option.value ~default:5
347
+
in
348
+
let scope_flags =
349
+
List.find_map
350
+
(function Bib_param (Integrity_scope_flags f) -> Some f | _ -> None)
351
+
bib.parameters
352
+
|> Option.value ~default:0x07
353
+
in
354
+
List.for_all2
355
+
(fun data results ->
356
+
let expected =
357
+
List.find_map
358
+
(function Bib_result (Expected_hmac h) -> Some h | _ -> None)
359
+
results
360
+
in
361
+
match expected with
362
+
| None -> false
363
+
| Some expected_hmac ->
364
+
let computed = compute_hmac ~key ~sha_variant ~scope_flags data in
365
+
String.equal expected_hmac computed)
366
+
target_data bib.results
367
+
368
+
let encrypt_aes_gcm ~key ~iv ~aad ~plaintext =
369
+
let key = Mirage_crypto.Cipher_block.AES.GCM.of_secret (Cstruct.of_string key) in
370
+
let iv = Cstruct.of_string iv in
371
+
let adata = Cstruct.of_string aad in
372
+
let result =
373
+
Mirage_crypto.Cipher_block.AES.GCM.authenticate_encrypt ~key ~nonce:iv ~adata
374
+
(Cstruct.of_string plaintext)
375
+
in
376
+
(* GCM appends the tag to the ciphertext *)
377
+
let tag_len = 16 in
378
+
let ciphertext_len = Cstruct.length result - tag_len in
379
+
let ciphertext = Cstruct.to_string (Cstruct.sub result 0 ciphertext_len) in
380
+
let tag = Cstruct.to_string (Cstruct.sub result ciphertext_len tag_len) in
381
+
(ciphertext, tag)
382
+
383
+
let decrypt_aes_gcm ~key ~iv ~aad ~ciphertext ~tag =
384
+
let key = Mirage_crypto.Cipher_block.AES.GCM.of_secret (Cstruct.of_string key) in
385
+
let iv = Cstruct.of_string iv in
386
+
let adata = Cstruct.of_string aad in
387
+
(* GCM expects ciphertext with tag appended *)
388
+
let data = Cstruct.of_string (ciphertext ^ tag) in
389
+
match
390
+
Mirage_crypto.Cipher_block.AES.GCM.authenticate_decrypt ~key ~nonce:iv ~adata
391
+
data
392
+
with
393
+
| Some plaintext -> Some (Cstruct.to_string plaintext)
394
+
| None -> None
395
+
396
+
let generate_iv () =
397
+
(* 12 bytes for AES-GCM *)
398
+
Cstruct.to_string (Mirage_crypto_rng.generate 12)
399
+
400
+
let create_bcb ~key ?(aes_variant = 3) ~source ~targets ~target_data () =
401
+
let iv = generate_iv () in
402
+
let aad_scope_flags = 0x07 in
403
+
let parameters =
404
+
[
405
+
Bcb_param (IV iv);
406
+
Bcb_param (AES_variant aes_variant);
407
+
Bcb_param (AAD_scope_flags aad_scope_flags);
408
+
]
409
+
in
410
+
let encrypted_data, results =
411
+
List.fold_left_map
412
+
(fun _acc data ->
413
+
let aad = "" in (* Simplified - full impl would include headers *)
414
+
let ciphertext, tag = encrypt_aes_gcm ~key ~iv ~aad ~plaintext:data in
415
+
(ciphertext, [ Bcb_result (Auth_tag tag) ]))
416
+
() target_data
417
+
in
418
+
let _ = encrypted_data in
419
+
let encrypted =
420
+
List.map
421
+
(fun data ->
422
+
let aad = "" in
423
+
let ciphertext, _tag = encrypt_aes_gcm ~key ~iv ~aad ~plaintext:data in
424
+
ciphertext)
425
+
target_data
426
+
in
427
+
( {
428
+
targets;
429
+
context_id = bcb_aes_gcm;
430
+
context_flags = { parameters_present = true };
431
+
source;
432
+
parameters;
433
+
results;
434
+
},
435
+
encrypted )
436
+
437
+
let decrypt_bcb ~key bcb ~ciphertext =
438
+
let iv =
439
+
List.find_map
440
+
(function Bcb_param (IV iv) -> Some iv | _ -> None)
441
+
bcb.parameters
442
+
in
443
+
match iv with
444
+
| None -> None
445
+
| Some iv ->
446
+
let aad = "" in
447
+
let decrypted =
448
+
List.map2
449
+
(fun ct results ->
450
+
let tag =
451
+
List.find_map
452
+
(function Bcb_result (Auth_tag t) -> Some t | _ -> None)
453
+
results
454
+
in
455
+
match tag with
456
+
| None -> None
457
+
| Some tag -> decrypt_aes_gcm ~key ~iv ~aad ~ciphertext:ct ~tag)
458
+
ciphertext bcb.results
459
+
in
460
+
if List.for_all Option.is_some decrypted then
461
+
Some (List.filter_map Fun.id decrypted)
462
+
else None
463
+
464
+
(* {1 Pretty Printing} *)
465
+
466
+
let pp_parameter fmt = function
467
+
| Bib_param (SHA_variant v) -> Format.fprintf fmt "sha_variant=%d" v
468
+
| Bib_param (Wrapped_key _) -> Format.fprintf fmt "wrapped_key=<bytes>"
469
+
| Bib_param (Integrity_scope_flags f) ->
470
+
Format.fprintf fmt "integrity_scope=0x%x" f
471
+
| Bcb_param (IV _) -> Format.fprintf fmt "iv=<bytes>"
472
+
| Bcb_param (AES_variant v) -> Format.fprintf fmt "aes_variant=%d" v
473
+
| Bcb_param (Wrapped_key _) -> Format.fprintf fmt "wrapped_key=<bytes>"
474
+
| Bcb_param (AAD_scope_flags f) -> Format.fprintf fmt "aad_scope=0x%x" f
475
+
| Unknown_param (id, _) -> Format.fprintf fmt "unknown(%d)=<bytes>" id
476
+
477
+
let pp_result fmt = function
478
+
| Bib_result (Expected_hmac _) -> Format.fprintf fmt "hmac=<bytes>"
479
+
| Bcb_result (Auth_tag _) -> Format.fprintf fmt "tag=<bytes>"
480
+
| Unknown_result (id, _) -> Format.fprintf fmt "unknown(%d)=<bytes>" id
481
+
482
+
let pp_security_block fmt sb =
483
+
Format.fprintf fmt
484
+
"@[<v 2>security_block {@ targets=[%a];@ context=%d;@ source=%a;@ \
485
+
parameters=[%a];@ results=[%a]@ }@]"
486
+
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
487
+
Format.pp_print_int)
488
+
sb.targets sb.context_id Bundle.pp_eid sb.source
489
+
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ")
490
+
pp_parameter)
491
+
sb.parameters
492
+
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ")
493
+
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
494
+
pp_result))
495
+
sb.results
496
+
497
+
let pp_bib = pp_security_block
498
+
let pp_bcb = pp_security_block
+198
lib/bpsec.mli
+198
lib/bpsec.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Bundle Protocol Security (RFC 9172).
7
+
8
+
This module implements BPSec providing integrity and confidentiality
9
+
services for Bundle Protocol v7 bundles.
10
+
11
+
{b Security blocks}
12
+
13
+
BPSec defines two extension block types:
14
+
- {b Block Integrity Block (BIB)} - provides integrity protection using
15
+
HMAC or digital signatures
16
+
- {b Block Confidentiality Block (BCB)} - provides confidentiality using
17
+
authenticated encryption (AES-GCM)
18
+
19
+
{b Security contexts}
20
+
21
+
A security context defines the cryptographic algorithms and parameters
22
+
used. RFC 9173 defines the default context using:
23
+
- HMAC-SHA256 for integrity (BIB)
24
+
- AES-GCM with 256-bit keys for confidentiality (BCB)
25
+
26
+
{b References}
27
+
- {{:https://datatracker.ietf.org/doc/html/rfc9172}RFC 9172} - Bundle
28
+
Protocol Security (BPSec)
29
+
- {{:https://datatracker.ietf.org/doc/html/rfc9173}RFC 9173} - Default
30
+
Security Contexts for BPSec *)
31
+
32
+
(** {1 Security Context} *)
33
+
34
+
type security_context_id = int
35
+
(** Security context identifier. Standard contexts:
36
+
- 1 = BIB-HMAC-SHA2 (RFC 9173)
37
+
- 2 = BCB-AES-GCM (RFC 9173) *)
38
+
39
+
val bib_hmac_sha2 : security_context_id
40
+
(** BIB-HMAC-SHA2 security context (RFC 9173 Section 3). *)
41
+
42
+
val bcb_aes_gcm : security_context_id
43
+
(** BCB-AES-GCM security context (RFC 9173 Section 4). *)
44
+
45
+
(** {1 Security Context Flags} *)
46
+
47
+
type context_flags = {
48
+
parameters_present : bool; (** Security context parameters are present. *)
49
+
}
50
+
(** Security context flags (RFC 9172 Section 3.6). *)
51
+
52
+
val context_flags_default : context_flags
53
+
54
+
(** {1 Security Parameters} *)
55
+
56
+
(** Security context parameter for BIB-HMAC-SHA2 (RFC 9173 Section 3.3). *)
57
+
type bib_parameter =
58
+
| SHA_variant of int (** id=1: SHA variant (5=SHA-256, 6=SHA-384, 7=SHA-512) *)
59
+
| Wrapped_key of string (** id=2: Wrapped key bytes *)
60
+
| Integrity_scope_flags of int (** id=3: Scope flags *)
61
+
62
+
(** Security context parameter for BCB-AES-GCM (RFC 9173 Section 4.3). *)
63
+
type bcb_parameter =
64
+
| IV of string (** id=1: Initialization vector (12 bytes for AES-GCM) *)
65
+
| AES_variant of int (** id=2: AES variant (1=A128GCM, 3=A256GCM) *)
66
+
| Wrapped_key of string (** id=3: Wrapped key bytes *)
67
+
| AAD_scope_flags of int (** id=4: AAD scope flags *)
68
+
69
+
type parameter =
70
+
| Bib_param of bib_parameter
71
+
| Bcb_param of bcb_parameter
72
+
| Unknown_param of int * string
73
+
74
+
(** {1 Security Results} *)
75
+
76
+
(** Security result for BIB (integrity tag/signature). *)
77
+
type bib_result = Expected_hmac of string (** id=1: Expected HMAC value *)
78
+
79
+
(** Security result for BCB (authentication tag). *)
80
+
type bcb_result = Auth_tag of string (** id=1: Authentication tag *)
81
+
82
+
type result =
83
+
| Bib_result of bib_result
84
+
| Bcb_result of bcb_result
85
+
| Unknown_result of int * string
86
+
87
+
(** {1 Security Blocks} *)
88
+
89
+
type security_target = int
90
+
(** Block number of the target block (RFC 9172 Section 3.3). *)
91
+
92
+
type security_block = {
93
+
targets : security_target list;
94
+
(** Block numbers of protected blocks. *)
95
+
context_id : security_context_id; (** Security context identifier. *)
96
+
context_flags : context_flags; (** Security context flags. *)
97
+
source : Bundle.eid; (** Security source (BPA that added this block). *)
98
+
parameters : parameter list; (** Per-target security parameters. *)
99
+
results : result list list;
100
+
(** Per-target security results (one list per target). *)
101
+
}
102
+
(** Abstract security block (BIB or BCB share this structure). *)
103
+
104
+
(** {1 Block Integrity Block (BIB)} *)
105
+
106
+
type bib = security_block
107
+
(** Block Integrity Block - provides integrity services. *)
108
+
109
+
val bib_block_type : int
110
+
(** BIB block type number (11). *)
111
+
112
+
(** {1 Block Confidentiality Block (BCB)} *)
113
+
114
+
type bcb = security_block
115
+
(** Block Confidentiality Block - provides confidentiality services. *)
116
+
117
+
val bcb_block_type : int
118
+
(** BCB block type number (12). *)
119
+
120
+
(** {1 Errors} *)
121
+
122
+
type error =
123
+
| Invalid_security_context of int
124
+
| Invalid_parameter of int
125
+
| Invalid_result of int
126
+
| Missing_parameter of string
127
+
| Verification_failed
128
+
| Decryption_failed
129
+
| Cbor_error of string
130
+
131
+
val pp_error : error Fmt.t
132
+
133
+
(** {1 CBOR Encoding/Decoding} *)
134
+
135
+
val security_block_to_cbor : security_block -> Cbort.Cbor.t
136
+
(** [security_block_to_cbor sb] encodes a security block as CBOR. *)
137
+
138
+
val security_block_of_cbor : Cbort.Cbor.t -> (security_block, error) result
139
+
(** [security_block_of_cbor cbor] decodes a security block from CBOR. *)
140
+
141
+
(** {1 Integrity Operations (BIB)} *)
142
+
143
+
val compute_hmac :
144
+
key:string -> sha_variant:int -> scope_flags:int -> string -> string
145
+
(** [compute_hmac ~key ~sha_variant ~scope_flags data] computes HMAC over data.
146
+
@param sha_variant 5=SHA-256, 6=SHA-384, 7=SHA-512 *)
147
+
148
+
val create_bib :
149
+
key:string ->
150
+
?sha_variant:int ->
151
+
source:Bundle.eid ->
152
+
targets:security_target list ->
153
+
target_data:string list ->
154
+
unit ->
155
+
bib
156
+
(** [create_bib ~key ~source ~targets ~target_data ()] creates a BIB protecting
157
+
the specified target blocks. *)
158
+
159
+
val verify_bib : key:string -> bib -> target_data:string list -> bool
160
+
(** [verify_bib ~key bib ~target_data] verifies the integrity of target blocks.
161
+
*)
162
+
163
+
(** {1 Confidentiality Operations (BCB)} *)
164
+
165
+
val encrypt_aes_gcm :
166
+
key:string -> iv:string -> aad:string -> plaintext:string -> string * string
167
+
(** [encrypt_aes_gcm ~key ~iv ~aad ~plaintext] returns [(ciphertext, tag)]. *)
168
+
169
+
val decrypt_aes_gcm :
170
+
key:string ->
171
+
iv:string ->
172
+
aad:string ->
173
+
ciphertext:string ->
174
+
tag:string ->
175
+
string option
176
+
(** [decrypt_aes_gcm ~key ~iv ~aad ~ciphertext ~tag] returns [Some plaintext] on
177
+
success. *)
178
+
179
+
val create_bcb :
180
+
key:string ->
181
+
?aes_variant:int ->
182
+
source:Bundle.eid ->
183
+
targets:security_target list ->
184
+
target_data:string list ->
185
+
unit ->
186
+
bcb * string list
187
+
(** [create_bcb ~key ~source ~targets ~target_data ()] creates a BCB and returns
188
+
the encrypted target data. *)
189
+
190
+
val decrypt_bcb :
191
+
key:string -> bcb -> ciphertext:string list -> string list option
192
+
(** [decrypt_bcb ~key bcb ~ciphertext] decrypts the protected blocks. *)
193
+
194
+
(** {1 Pretty Printing} *)
195
+
196
+
val pp_security_block : security_block Fmt.t
197
+
val pp_bib : bib Fmt.t
198
+
val pp_bcb : bcb Fmt.t
+4
lib/dune
+4
lib/dune
+3
test/dune
+3
test/dune
+127
test/test_bpsec.ml
+127
test/test_bpsec.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let () = Mirage_crypto_rng_unix.use_default ()
7
+
8
+
(* Test helpers *)
9
+
let test_key_256 = String.make 32 '\x42'
10
+
let test_source = Bundle.Ipn (1L, 1L)
11
+
12
+
(* BIB Tests *)
13
+
14
+
let test_bib_create () =
15
+
let targets = [ 1 ] in
16
+
let target_data = [ "Hello, DTN!" ] in
17
+
let bib =
18
+
Bpsec.create_bib ~key:test_key_256 ~source:test_source ~targets ~target_data
19
+
()
20
+
in
21
+
Alcotest.(check int) "context is BIB-HMAC-SHA2" Bpsec.bib_hmac_sha2
22
+
bib.context_id;
23
+
Alcotest.(check int) "one target" 1 (List.length bib.targets);
24
+
Alcotest.(check int) "one result set" 1 (List.length bib.results)
25
+
26
+
let test_bib_verify () =
27
+
let targets = [ 1 ] in
28
+
let target_data = [ "Hello, DTN!" ] in
29
+
let bib =
30
+
Bpsec.create_bib ~key:test_key_256 ~source:test_source ~targets ~target_data
31
+
()
32
+
in
33
+
let verified = Bpsec.verify_bib ~key:test_key_256 bib ~target_data in
34
+
Alcotest.(check bool) "verification succeeds" true verified
35
+
36
+
let test_bib_tamper_detection () =
37
+
let targets = [ 1 ] in
38
+
let target_data = [ "Hello, DTN!" ] in
39
+
let bib =
40
+
Bpsec.create_bib ~key:test_key_256 ~source:test_source ~targets ~target_data
41
+
()
42
+
in
43
+
let tampered_data = [ "Tampered!" ] in
44
+
let verified = Bpsec.verify_bib ~key:test_key_256 bib ~target_data:tampered_data in
45
+
Alcotest.(check bool) "tampered data fails verification" false verified
46
+
47
+
let test_bib_wrong_key () =
48
+
let targets = [ 1 ] in
49
+
let target_data = [ "Hello, DTN!" ] in
50
+
let bib =
51
+
Bpsec.create_bib ~key:test_key_256 ~source:test_source ~targets ~target_data
52
+
()
53
+
in
54
+
let wrong_key = String.make 32 '\x00' in
55
+
let verified = Bpsec.verify_bib ~key:wrong_key bib ~target_data in
56
+
Alcotest.(check bool) "wrong key fails verification" false verified
57
+
58
+
(* BCB Tests *)
59
+
60
+
let test_bcb_roundtrip () =
61
+
let targets = [ 1 ] in
62
+
let target_data = [ "Secret payload!" ] in
63
+
let bcb, encrypted =
64
+
Bpsec.create_bcb ~key:test_key_256 ~source:test_source ~targets ~target_data
65
+
()
66
+
in
67
+
Alcotest.(check int) "context is BCB-AES-GCM" Bpsec.bcb_aes_gcm bcb.context_id;
68
+
Alcotest.(check bool)
69
+
"encrypted differs from plaintext" false
70
+
(List.hd encrypted = List.hd target_data);
71
+
match Bpsec.decrypt_bcb ~key:test_key_256 bcb ~ciphertext:encrypted with
72
+
| Some decrypted ->
73
+
Alcotest.(check string)
74
+
"roundtrip succeeds" (List.hd target_data) (List.hd decrypted)
75
+
| None -> Alcotest.fail "decryption failed"
76
+
77
+
let test_bcb_wrong_key () =
78
+
let targets = [ 1 ] in
79
+
let target_data = [ "Secret payload!" ] in
80
+
let bcb, encrypted =
81
+
Bpsec.create_bcb ~key:test_key_256 ~source:test_source ~targets ~target_data
82
+
()
83
+
in
84
+
let wrong_key = String.make 32 '\x00' in
85
+
match Bpsec.decrypt_bcb ~key:wrong_key bcb ~ciphertext:encrypted with
86
+
| Some _ -> Alcotest.fail "decryption should fail with wrong key"
87
+
| None -> ()
88
+
89
+
(* CBOR Roundtrip Tests *)
90
+
91
+
let test_security_block_cbor_roundtrip () =
92
+
let targets = [ 1; 2 ] in
93
+
let target_data = [ "Block 1"; "Block 2" ] in
94
+
let bib =
95
+
Bpsec.create_bib ~key:test_key_256 ~source:test_source ~targets ~target_data
96
+
()
97
+
in
98
+
let cbor = Bpsec.security_block_to_cbor bib in
99
+
match Bpsec.security_block_of_cbor cbor with
100
+
| Ok decoded ->
101
+
Alcotest.(check (list int)) "targets match" targets decoded.targets;
102
+
Alcotest.(check int)
103
+
"context matches" bib.context_id decoded.context_id
104
+
| Error e ->
105
+
Alcotest.failf "decode failed: %a" Bpsec.pp_error e
106
+
107
+
(* Test Suites *)
108
+
109
+
let bib_tests =
110
+
[
111
+
Alcotest.test_case "create" `Quick test_bib_create;
112
+
Alcotest.test_case "verify" `Quick test_bib_verify;
113
+
Alcotest.test_case "tamper detection" `Quick test_bib_tamper_detection;
114
+
Alcotest.test_case "wrong key" `Quick test_bib_wrong_key;
115
+
]
116
+
117
+
let bcb_tests =
118
+
[
119
+
Alcotest.test_case "roundtrip" `Quick test_bcb_roundtrip;
120
+
Alcotest.test_case "wrong key" `Quick test_bcb_wrong_key;
121
+
]
122
+
123
+
let cbor_tests =
124
+
[ Alcotest.test_case "security block roundtrip" `Quick test_security_block_cbor_roundtrip ]
125
+
126
+
let () =
127
+
Alcotest.run "bpsec" [ ("BIB", bib_tests); ("BCB", bcb_tests); ("CBOR", cbor_tests) ]