CCSDS Space Data Link Security (355.0-B-2)
irmin: value-oriented Heap + Schema + Cursor with 4 backends
+81
-94
+1
-4
lib/ep.ml
+1
-4
lib/ep.ml
···
206
206
Byte 0: Type (1b) | UF (1b) | SG (2b) | PID (4b)
207
207
Bytes 1-2: PDU_LEN (16b) *)
208
208
209
-
210
209
type header = {
211
210
is_reply : bool;
212
211
user_flag : bool;
···
226
225
let w_sg = Wire.Field.v "SG" (bits8 2)
227
226
let w_pid = Wire.Field.v "PID" (bits8 4)
228
227
let w_pdu_len = Wire.Field.v "PDU_LEN" Wire.uint16be
229
-
230
228
let bf_sg = Wire.Codec.(w_sg $ fun t -> int_of_service_group t.service_group)
231
229
232
230
let codec =
···
291
289
292
290
let mc_status_reply_codec =
293
291
Wire.Codec.v "MC_Status_Reply"
294
-
(fun operational key_count sa_count ->
295
-
{ operational; key_count; sa_count })
292
+
(fun operational key_count sa_count -> { operational; key_count; sa_count })
296
293
Wire.Codec.
297
294
[
298
295
(w_operational $ fun r -> r.operational);
+72
-81
lib/mc.ml
+72
-81
lib/mc.ml
···
360
360
let tlv_header_codec =
361
361
Wire.Codec.v "TLV_Header"
362
362
(fun tag data_len -> { tag; data_len })
363
-
Wire.Codec.
364
-
[
365
-
(f_tag $ fun h -> h.tag);
366
-
(f_data_len $ fun h -> h.data_len);
367
-
]
363
+
Wire.Codec.[ (f_tag $ fun h -> h.tag); (f_data_len $ fun h -> h.data_len) ]
368
364
369
365
let tlv_header_size = Wire.Codec.wire_size tlv_header_codec
370
366
···
382
378
Wire.Codec.
383
379
[
384
380
(f_ev_spi $ fun r -> r.spi);
385
-
(f_ev_code $ fun r ->
381
+
( f_ev_code $ fun r ->
386
382
let base = r.code land 0x7F in
387
-
base lor if Option.is_some r.vcid then 0x80 else 0);
383
+
base lor if Option.is_some r.vcid then 0x80 else 0 );
388
384
]
389
385
390
386
let spi_code_size = Wire.Codec.wire_size spi_code_codec
···
396
392
let buf = Bytes.create total in
397
393
let rec_val = { spi; code; vcid } in
398
394
Wire.Codec.encode spi_code_codec rec_val buf 0;
399
-
(match vcid with
400
-
| Some v -> Bytes.set_uint8 buf spi_code_size v
401
-
| None -> ());
395
+
(match vcid with Some v -> Bytes.set_uint8 buf spi_code_size v | None -> ());
402
396
buf
403
397
404
398
(** Decode the SPI + code byte + optional VCID from [buf] at [off] with
···
413
407
let code = r.code land 0x7F in
414
408
if has_vcid && data_len >= spi_code_size + 1 then
415
409
let v = Bytes.get_uint8 buf (off + spi_code_size) in
416
-
if v > 63 then Error (`Invalid_vcid v)
417
-
else Ok (r.spi, code, Some v)
410
+
if v > 63 then Error (`Invalid_vcid v) else Ok (r.spi, code, Some v)
418
411
else Ok (r.spi, code, None)
419
412
420
413
(* SPI + u64 remaining codec (iv_warning) *)
···
428
421
Wire.Codec.v "IV_Warning"
429
422
(fun spi remaining -> { spi; remaining })
430
423
Wire.Codec.
431
-
[
432
-
(f_iv_spi $ fun r -> r.spi);
433
-
(f_remaining $ fun r -> r.remaining);
434
-
]
424
+
[ (f_iv_spi $ fun r -> r.spi); (f_remaining $ fun r -> r.remaining) ]
435
425
436
426
let iv_warning_data_size = Wire.Codec.wire_size iv_warning_codec
437
427
···
445
435
let spi_trans_codec =
446
436
Wire.Codec.v "SPI_Trans"
447
437
(fun spi trans -> { spi; trans })
448
-
Wire.Codec.
449
-
[
450
-
(f_tr_spi $ fun r -> r.spi);
451
-
(f_trans $ fun r -> r.trans);
452
-
]
438
+
Wire.Codec.[ (f_tr_spi $ fun r -> r.spi); (f_trans $ fun r -> r.trans) ]
453
439
454
440
let spi_trans_data_size = Wire.Codec.wire_size spi_trans_codec
455
441
···
462
448
(fun v -> v = 0)
463
449
Wire.Codec.[ (f_success $ fun s -> if s then 0 else 1) ]
464
450
465
-
(** Encode a TLV header and return a buffer with header + data_len spare room. *)
451
+
(** Encode a TLV header and return a buffer with header + data_len spare room.
452
+
*)
466
453
let encode_tlv tag data_len =
467
454
let buf = Bytes.create (tlv_header_size + data_len) in
468
455
Wire.Codec.encode tlv_header_codec { tag; data_len } buf 0;
···
496
483
| Sa_change { spi; transition } ->
497
484
let buf = encode_tlv tag_sa_change spi_trans_data_size in
498
485
Wire.Codec.encode spi_trans_codec
499
-
{ spi; trans = int_of_sa_trans transition } buf tlv_header_size;
486
+
{ spi; trans = int_of_sa_trans transition }
487
+
buf tlv_header_size;
500
488
buf
501
489
| Key_change { kid; transition } ->
502
490
let buf = encode_tlv tag_key_change spi_trans_data_size in
503
491
Wire.Codec.encode spi_trans_codec
504
-
{ spi = kid; trans = int_of_key_trans transition } buf tlv_header_size;
492
+
{ spi = kid; trans = int_of_key_trans transition }
493
+
buf tlv_header_size;
505
494
buf
506
495
| Alarm_reset -> encode_tlv tag_alarm_reset 0
507
496
| Self_test { success } ->
···
525
514
else
526
515
match Wire.Codec.decode tlv_header_codec buf off with
527
516
| Error _ -> Error `Truncated
528
-
| Ok { tag; data_len } ->
529
-
if remaining < tlv_header_size + data_len then Error `Truncated
530
-
else
531
-
let data_off = off + tlv_header_size in
532
-
let consumed = tlv_header_size + data_len in
533
-
let decode_frame_dir_event mk =
534
-
match decode_spi_code_vcid buf data_off data_len with
535
-
| Error _ as e -> e
536
-
| Ok (spi, code, vcid) ->
537
-
let direction = direction_of_int code in
538
-
Ok (mk ~spi ~direction ~vcid, consumed)
539
-
in
540
-
match tag with
541
-
| t when t = tag_auth_failure -> (
542
-
match decode_spi_code_vcid buf data_off data_len with
543
-
| Error _ as e -> e
544
-
| Ok (spi, code, vcid) ->
545
-
let reason = auth_reason_of_int code in
546
-
Ok (Auth_failure { spi; reason; vcid }, consumed))
547
-
| t when t = tag_frame_protected ->
548
-
decode_frame_dir_event (fun ~spi ~direction ~vcid ->
549
-
Frame_protected { spi; direction; vcid })
550
-
| t when t = tag_frame_unprotected ->
551
-
decode_frame_dir_event (fun ~spi ~direction ~vcid ->
552
-
Frame_unprotected { spi; direction; vcid })
553
-
| t when t = tag_iv_warning ->
554
-
if data_len < iv_warning_data_size then Error `Truncated
555
-
else (
556
-
match Wire.Codec.decode iv_warning_codec buf data_off with
557
-
| Error _ -> Error `Truncated
558
-
| Ok r -> Ok (Iv_warning { spi = r.spi; remaining = r.remaining },
559
-
consumed))
560
-
| t when t = tag_sa_change ->
561
-
if data_len < spi_trans_data_size then Error `Truncated
562
-
else (
563
-
match Wire.Codec.decode spi_trans_codec buf data_off with
564
-
| Error _ -> Error `Truncated
565
-
| Ok r ->
566
-
let transition = sa_trans_of_int r.trans in
567
-
Ok (Sa_change { spi = r.spi; transition }, consumed))
568
-
| t when t = tag_key_change ->
569
-
if data_len < spi_trans_data_size then Error `Truncated
570
-
else (
571
-
match Wire.Codec.decode spi_trans_codec buf data_off with
572
-
| Error _ -> Error `Truncated
573
-
| Ok r ->
574
-
let transition = key_trans_of_int r.trans in
575
-
Ok (Key_change { kid = r.spi; transition }, consumed))
576
-
| t when t = tag_alarm_reset -> Ok (Alarm_reset, consumed)
577
-
| t when t = tag_self_test ->
578
-
if data_len >= 1 then
579
-
match Wire.Codec.decode success_codec buf data_off with
580
-
| Error _ -> Ok (Self_test { success = true }, consumed)
581
-
| Ok success -> Ok (Self_test { success }, consumed)
582
-
else Ok (Self_test { success = true }, consumed)
583
-
| t when t = tag_log_erased -> Ok (Log_erased, consumed)
584
-
| t -> Error (`Invalid_tag t)
517
+
| Ok { tag; data_len } -> (
518
+
if remaining < tlv_header_size + data_len then Error `Truncated
519
+
else
520
+
let data_off = off + tlv_header_size in
521
+
let consumed = tlv_header_size + data_len in
522
+
let decode_frame_dir_event mk =
523
+
match decode_spi_code_vcid buf data_off data_len with
524
+
| Error _ as e -> e
525
+
| Ok (spi, code, vcid) ->
526
+
let direction = direction_of_int code in
527
+
Ok (mk ~spi ~direction ~vcid, consumed)
528
+
in
529
+
match tag with
530
+
| t when t = tag_auth_failure -> (
531
+
match decode_spi_code_vcid buf data_off data_len with
532
+
| Error _ as e -> e
533
+
| Ok (spi, code, vcid) ->
534
+
let reason = auth_reason_of_int code in
535
+
Ok (Auth_failure { spi; reason; vcid }, consumed))
536
+
| t when t = tag_frame_protected ->
537
+
decode_frame_dir_event (fun ~spi ~direction ~vcid ->
538
+
Frame_protected { spi; direction; vcid })
539
+
| t when t = tag_frame_unprotected ->
540
+
decode_frame_dir_event (fun ~spi ~direction ~vcid ->
541
+
Frame_unprotected { spi; direction; vcid })
542
+
| t when t = tag_iv_warning -> (
543
+
if data_len < iv_warning_data_size then Error `Truncated
544
+
else
545
+
match Wire.Codec.decode iv_warning_codec buf data_off with
546
+
| Error _ -> Error `Truncated
547
+
| Ok r ->
548
+
Ok
549
+
( Iv_warning { spi = r.spi; remaining = r.remaining },
550
+
consumed ))
551
+
| t when t = tag_sa_change -> (
552
+
if data_len < spi_trans_data_size then Error `Truncated
553
+
else
554
+
match Wire.Codec.decode spi_trans_codec buf data_off with
555
+
| Error _ -> Error `Truncated
556
+
| Ok r ->
557
+
let transition = sa_trans_of_int r.trans in
558
+
Ok (Sa_change { spi = r.spi; transition }, consumed))
559
+
| t when t = tag_key_change -> (
560
+
if data_len < spi_trans_data_size then Error `Truncated
561
+
else
562
+
match Wire.Codec.decode spi_trans_codec buf data_off with
563
+
| Error _ -> Error `Truncated
564
+
| Ok r ->
565
+
let transition = key_trans_of_int r.trans in
566
+
Ok (Key_change { kid = r.spi; transition }, consumed))
567
+
| t when t = tag_alarm_reset -> Ok (Alarm_reset, consumed)
568
+
| t when t = tag_self_test ->
569
+
if data_len >= 1 then
570
+
match Wire.Codec.decode success_codec buf data_off with
571
+
| Error _ -> Ok (Self_test { success = true }, consumed)
572
+
| Ok success -> Ok (Self_test { success }, consumed)
573
+
else Ok (Self_test { success = true }, consumed)
574
+
| t when t = tag_log_erased -> Ok (Log_erased, consumed)
575
+
| t -> Error (`Invalid_tag t))
585
576
586
577
(* {1 Dump Log PDU (PID=3)}
587
578
+8
-9
lib/sdls.ml
+8
-9
lib/sdls.ml
···
85
85
86
86
let p_iv_len = Wire.Param.input "iv_len" Wire.uint16be
87
87
let p_sn_len = Wire.Param.input "sn_len" Wire.uint16be
88
-
89
88
let f_spi = Wire.Field.v "SPI" Wire.uint16be
90
89
let f_iv = Wire.Field.v "IV" (Wire.byte_array ~size:(Wire.Param.expr p_iv_len))
91
90
let f_sn = Wire.Field.v "SN" (Wire.byte_array ~size:(Wire.Param.expr p_sn_len))
···
123
122
let need = sec_hdr_len sa in
124
123
match Binary.Reader.ensure r need with
125
124
| Error (`Truncated _) -> Error Invalid_frame_length
126
-
| Ok () ->
125
+
| Ok () -> (
127
126
let buf = Binary.Reader.bytes r need in
128
127
let env =
129
128
Wire.Codec.env sec_hdr_codec
130
129
|> Wire.Param.bind p_iv_len sa.config.iv_len
131
130
|> Wire.Param.bind p_sn_len sa.config.sn_len
132
131
in
133
-
(match Wire.Codec.decode_with sec_hdr_codec env buf 0 with
134
-
| Ok sh -> Ok sh
135
-
| Error _ -> Error Invalid_frame_length)
132
+
match Wire.Codec.decode_with sec_hdr_codec env buf 0 with
133
+
| Ok sh -> Ok sh
134
+
| Error _ -> Error Invalid_frame_length)
136
135
137
136
let write_security_trailer w (st : Sa.security_trailer) =
138
137
Binary.Writer.bytes w st.mac
···
140
139
let read_security_trailer ~(sa : Sa.entry) r =
141
140
match Binary.Reader.ensure r sa.config.mac_len with
142
141
| Error (`Truncated _) -> Error Invalid_frame_length
143
-
| Ok () ->
142
+
| Ok () -> (
144
143
let buf = Binary.Reader.bytes r sa.config.mac_len in
145
144
let env =
146
145
Wire.Codec.env sec_trl_codec
147
146
|> Wire.Param.bind p_mac_len sa.config.mac_len
148
147
in
149
-
(match Wire.Codec.decode_with sec_trl_codec env buf 0 with
150
-
| Ok st -> Ok st
151
-
| Error _ -> Error Invalid_frame_length)
148
+
match Wire.Codec.decode_with sec_trl_codec env buf 0 with
149
+
| Ok st -> Ok st
150
+
| Error _ -> Error Invalid_frame_length)
152
151
153
152
let encode_security_header (sh : Sa.security_header) =
154
153
let len = 2 + Bytes.length sh.iv + Bytes.length sh.sn in