CCSDS TM Transfer Frames (CCSDS 132.0-B-3)
Merge commit 'eebed820c943ece133fe8d057b49ae04856a9c3d' as 'ocaml-tm'
+1188
+21
.gitignore
+21
.gitignore
···
1
+
# OCaml build artifacts
2
+
_build/
3
+
*.install
4
+
*.merlin
5
+
6
+
# Dune package management
7
+
dune.lock/
8
+
9
+
# Editor and OS files
10
+
.DS_Store
11
+
*.swp
12
+
*~
13
+
.vscode/
14
+
.idea/
15
+
16
+
# Opam local switch
17
+
_opam/
18
+
19
+
# Fuzzing artifacts
20
+
_fuzz/
21
+
corpus/
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.28.1
+21
LICENSE.md
+21
LICENSE.md
···
1
+
MIT License
2
+
3
+
Copyright (c) 2025 Thomas Gazagnaire
4
+
5
+
Permission is hereby granted, free of charge, to any person obtaining a copy
6
+
of this software and associated documentation files (the "Software"), to deal
7
+
in the Software without restriction, including without limitation the rights
8
+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9
+
copies of the Software, and to permit persons to whom the Software is
10
+
furnished to do so, subject to the following conditions:
11
+
12
+
The above copyright notice and this permission notice shall be included in all
13
+
copies or substantial portions of the Software.
14
+
15
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16
+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17
+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18
+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19
+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20
+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21
+
SOFTWARE.
+93
README.md
+93
README.md
···
1
+
# tm
2
+
3
+
CCSDS TM (Telemetry) Transfer Frames for OCaml.
4
+
5
+
## Overview
6
+
7
+
This library implements parsing and encoding of CCSDS TM Transfer Frames as
8
+
specified in CCSDS 132.0-B-3. TM frames are the fundamental data unit for
9
+
transporting telemetry from spacecraft to ground stations.
10
+
11
+
## Features
12
+
13
+
- TM frame primary header (6 bytes) encoding/decoding
14
+
- Operational Control Field (OCF) with CLCW support
15
+
- Frame Error Control Field (FECF) using CRC-16-CCITT
16
+
- Command Link Control Word (CLCW) for COP-1 protocol
17
+
- Typed spacecraft ID (SCID) and virtual channel ID (VCID)
18
+
- Security-hardened parsing with bounds checking
19
+
20
+
## Installation
21
+
22
+
```
23
+
opam install tm
24
+
```
25
+
26
+
## Usage
27
+
28
+
```ocaml
29
+
(* Create a TM frame *)
30
+
let scid = Tm.scid_exn 100 in
31
+
let vcid = Tm.vcid_exn 2 in
32
+
let data = String.make 1103 '\x00' in
33
+
let frame = Tm.make ~scid ~vcid ~mcfc:1 ~vcfc:2 data in
34
+
35
+
(* Encode to bytes *)
36
+
let bytes = Tm.encode frame in
37
+
38
+
(* Decode from bytes *)
39
+
match Tm.decode bytes with
40
+
| Ok frame -> Printf.printf "SCID: %d\n" (Tm.scid_to_int frame.header.scid)
41
+
| Error e -> Format.printf "Error: %a\n" Tm.pp_error e
42
+
```
43
+
44
+
### Working with CLCW
45
+
46
+
```ocaml
47
+
(* Extract CLCW from frame OCF *)
48
+
match Tm.get_clcw frame with
49
+
| Ok clcw ->
50
+
Printf.printf "Report value (N(R)): %d\n" clcw.report_value;
51
+
if clcw.flags.lockout then print_endline "FARM-1 in lockout!"
52
+
| Error `No_ocf -> print_endline "No OCF present"
53
+
| Error (`Invalid_vcid _) -> print_endline "Invalid VCID in CLCW"
54
+
55
+
(* Create a CLCW *)
56
+
let clcw = Tm.make_clcw ~vcid ~report_value:42 ~lockout:false () in
57
+
let ocf_word = Tm.encode_clcw clcw in
58
+
```
59
+
60
+
## Frame Structure
61
+
62
+
```
63
+
+----------------+-------------+------+------+
64
+
| Primary Header | Data Field | OCF | FECF |
65
+
| (6 bytes) | (variable) | (4B) | (2B) |
66
+
+----------------+-------------+------+------+
67
+
```
68
+
69
+
Standard CCSDS frame length is 1115 bytes (configurable).
70
+
71
+
## API
72
+
73
+
### Types
74
+
- `Tm.scid` - Spacecraft ID (10 bits, 0-1023)
75
+
- `Tm.vcid` - Virtual Channel ID (3 bits, 0-7)
76
+
- `Tm.header` - TM frame primary header
77
+
- `Tm.clcw` - Command Link Control Word
78
+
- `Tm.t` - Complete TM frame
79
+
80
+
### Functions
81
+
- `Tm.decode` - Parse TM frame from bytes
82
+
- `Tm.encode` - Serialize TM frame to bytes
83
+
- `Tm.compute_fecf` - Calculate CRC-16-CCITT
84
+
- `Tm.get_clcw` - Extract CLCW from frame OCF
85
+
86
+
## References
87
+
88
+
- [CCSDS 132.0-B-3](https://public.ccsds.org/Pubs/132x0b3.pdf) - TM Space Data Link Protocol specification
89
+
- [CCSDS 232.1-B-2](https://public.ccsds.org/Pubs/232x1b2.pdf) - Communications Operation Procedure-1 (COP-1)
90
+
91
+
## License
92
+
93
+
MIT License. See [LICENSE.md](LICENSE.md) for details.
+24
dune-project
+24
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name tm)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
11
+
(source
12
+
(uri https://tangled.org/gazagnaire.org/ocaml-tm))
13
+
14
+
(package
15
+
(name tm)
16
+
(synopsis "CCSDS TM Transfer Frames (CCSDS 132.0-B)")
17
+
(description
18
+
"Parser and encoder for CCSDS Telemetry Transfer Frames. Supports TM frame \
19
+
primary headers, Operational Control Field (OCF), Frame Error Control \
20
+
Field (FECF/CRC-16), and CLCW (Command Link Control Word) for COP-1.")
21
+
(depends
22
+
(ocaml (>= 4.14))
23
+
(alcotest :with-test)
24
+
(crowbar :with-test)))
+15
fuzz/dune
+15
fuzz/dune
···
1
+
; Crowbar fuzz testing for TM frames
2
+
;
3
+
; To run: dune exec fuzz/fuzz_tm.exe
4
+
; With AFL: afl-fuzz -i fuzz/corpus -o fuzz/findings -- ./_build/default/fuzz/fuzz_tm.exe @@
5
+
6
+
(executable
7
+
(name fuzz_tm)
8
+
(modules fuzz_tm)
9
+
(libraries tm crowbar))
10
+
11
+
(rule
12
+
(alias fuzz)
13
+
(deps fuzz_tm.exe)
14
+
(action
15
+
(run %{exe:fuzz_tm.exe})))
+136
fuzz/fuzz_tm.ml
+136
fuzz/fuzz_tm.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Fuzz tests for TM frames.
7
+
8
+
Key properties tested: 1. No crashes on malformed input 2. Parser handles
9
+
truncated data gracefully 3. Encode/decode roundtrip preserves data 4. CRC
10
+
validation catches corruption
11
+
12
+
Security context:
13
+
- TM frames received from spacecraft may be corrupted or malicious
14
+
- Parser must handle any input without crashing
15
+
- Memory safety is critical for ground station software *)
16
+
17
+
open Crowbar
18
+
19
+
(* Truncate input to reasonable size to avoid memory issues *)
20
+
let truncate ?(max_len = 2048) s =
21
+
if String.length s > max_len then String.sub s 0 max_len else s
22
+
23
+
(* Property 1: No crashes on arbitrary input *)
24
+
let test_decode_no_crash input =
25
+
let input = truncate input in
26
+
let _ = Tm.decode input in
27
+
()
28
+
29
+
(* Property 2: No crashes on header parsing *)
30
+
let test_header_no_crash input =
31
+
let input = truncate ~max_len:100 input in
32
+
let _ = Tm.decode_header input in
33
+
()
34
+
35
+
(* Property 3: Header roundtrip *)
36
+
let test_header_roundtrip scid_val vcid_val mcfc vcfc fhp =
37
+
let scid_val = scid_val mod 1024 in
38
+
let vcid_val = vcid_val mod 8 in
39
+
let mcfc = mcfc mod 256 in
40
+
let vcfc = vcfc mod 256 in
41
+
let fhp = fhp mod 2048 in
42
+
match (Tm.scid scid_val, Tm.vcid vcid_val) with
43
+
| Some scid, Some vcid -> (
44
+
let hdr = Tm.make_header ~scid ~vcid ~mcfc ~vcfc ~first_hdr_ptr:fhp () in
45
+
let encoded = Tm.encode_header hdr in
46
+
match Tm.decode_header encoded with
47
+
| Ok decoded ->
48
+
if Tm.scid_to_int decoded.scid <> scid_val then
49
+
failf "scid mismatch: %d vs %d"
50
+
(Tm.scid_to_int decoded.scid)
51
+
scid_val;
52
+
if Tm.vcid_to_int decoded.vcid <> vcid_val then
53
+
failf "vcid mismatch: %d vs %d"
54
+
(Tm.vcid_to_int decoded.vcid)
55
+
vcid_val;
56
+
if decoded.mcfc <> mcfc then
57
+
failf "mcfc mismatch: %d vs %d" decoded.mcfc mcfc;
58
+
if decoded.vcfc <> vcfc then
59
+
failf "vcfc mismatch: %d vs %d" decoded.vcfc vcfc
60
+
| Error _ -> failf "decode failed for valid header")
61
+
| _ -> ()
62
+
63
+
(* Property 4: CLCW roundtrip *)
64
+
let test_clcw_roundtrip vcid_val report farm_b =
65
+
let vcid_val = vcid_val mod 8 in
66
+
let report = report mod 256 in
67
+
let farm_b = farm_b mod 4 in
68
+
match Tm.vcid vcid_val with
69
+
| Some vcid -> (
70
+
let clcw =
71
+
Tm.make_clcw ~vcid ~report_value:report ~farm_b_counter:farm_b ()
72
+
in
73
+
let encoded = Tm.encode_clcw clcw in
74
+
match Tm.decode_clcw encoded with
75
+
| Ok decoded ->
76
+
if decoded.report_value <> report then
77
+
failf "report mismatch: %d vs %d" decoded.report_value report
78
+
| Error _ -> failf "decode failed for valid clcw")
79
+
| None -> ()
80
+
81
+
(* Property 5: Full frame roundtrip with FECF *)
82
+
let test_frame_roundtrip data =
83
+
let data = truncate ~max_len:1103 data in
84
+
if String.length data = 0 then ()
85
+
else
86
+
match (Tm.scid 100, Tm.vcid 2) with
87
+
| Some scid, Some vcid -> (
88
+
let frame = Tm.make ~scid ~vcid ~mcfc:0 ~vcfc:0 data in
89
+
let encoded = Tm.encode frame in
90
+
match Tm.decode ~frame_len:(String.length encoded) encoded with
91
+
| Ok decoded ->
92
+
if decoded.data <> data then fail "data mismatch in roundtrip"
93
+
| Error _ -> fail "decode failed for valid frame")
94
+
| _ -> ()
95
+
96
+
(* Property 6: FECF detects single-bit corruption *)
97
+
let test_fecf_corruption data bit_pos =
98
+
let data = truncate ~max_len:1103 data in
99
+
if String.length data < 10 then ()
100
+
else
101
+
match (Tm.scid 0, Tm.vcid 0) with
102
+
| Some scid, Some vcid -> (
103
+
let frame = Tm.make ~scid ~vcid ~mcfc:0 ~vcfc:0 data in
104
+
let encoded = Tm.encode frame in
105
+
let len = String.length encoded in
106
+
if len < 3 then ()
107
+
else
108
+
(* Flip a bit in the frame (not in FECF itself) *)
109
+
let byte_pos = bit_pos mod (len - 2) in
110
+
let bit = bit_pos / (len - 2) mod 8 in
111
+
let bytes = Bytes.of_string encoded in
112
+
let old_byte = Bytes.get bytes byte_pos in
113
+
let new_byte = Char.chr (Char.code old_byte lxor (1 lsl bit)) in
114
+
Bytes.set bytes byte_pos new_byte;
115
+
let corrupted = Bytes.to_string bytes in
116
+
match Tm.decode ~frame_len:len corrupted with
117
+
| Error (Tm.Fecf_mismatch _) -> () (* Expected *)
118
+
| Error _ -> () (* Other errors are acceptable *)
119
+
| Ok _ ->
120
+
(* CRC collision - very rare but possible *)
121
+
())
122
+
| _ -> ()
123
+
124
+
let () =
125
+
add_test ~name:"tm: decode no crash" [ bytes ] test_decode_no_crash;
126
+
add_test ~name:"tm: header no crash" [ bytes ] test_header_no_crash;
127
+
add_test ~name:"tm: header roundtrip"
128
+
[ range 2000; range 20; range 300; range 300; range 3000 ]
129
+
test_header_roundtrip;
130
+
add_test ~name:"tm: clcw roundtrip"
131
+
[ range 20; range 300; range 10 ]
132
+
test_clcw_roundtrip;
133
+
add_test ~name:"tm: frame roundtrip" [ bytes ] test_frame_roundtrip;
134
+
add_test ~name:"tm: fecf corruption"
135
+
[ bytes; range 20000 ]
136
+
test_fecf_corruption
fuzz/input/empty
fuzz/input/empty
This is a binary file and will not be displayed.
fuzz/input/header
fuzz/input/header
This is a binary file and will not be displayed.
+419
lib/tm.ml
+419
lib/tm.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Security limits *)
7
+
let max_frame_len = 2048 (* Reasonable maximum for TM frames *)
8
+
9
+
(* Spacecraft ID: 10 bits, 0-1023 *)
10
+
type scid = int
11
+
12
+
let scid n = if n >= 0 && n <= 1023 then Some n else None
13
+
14
+
let scid_exn n =
15
+
if n >= 0 && n <= 1023 then n
16
+
else invalid_arg (Printf.sprintf "scid: %d out of range 0-1023" n)
17
+
18
+
let scid_to_int s = s
19
+
20
+
(* Virtual Channel ID: 3 bits for TM, 0-7 *)
21
+
type vcid = int
22
+
23
+
let vcid n = if n >= 0 && n <= 7 then Some n else None
24
+
25
+
let vcid_exn n =
26
+
if n >= 0 && n <= 7 then n
27
+
else invalid_arg (Printf.sprintf "vcid: %d out of range 0-7" n)
28
+
29
+
let vcid_to_int v = v
30
+
31
+
(* First Header Pointer constants *)
32
+
let fhp_no_packet = 0x7FE
33
+
let fhp_idle_only = 0x7FF
34
+
35
+
(* Frame header *)
36
+
type header = {
37
+
version : int;
38
+
scid : scid;
39
+
vcid : vcid;
40
+
ocf_flag : bool;
41
+
mcfc : int;
42
+
vcfc : int;
43
+
sec_hdr : bool;
44
+
sync_flag : bool;
45
+
pkt_order : bool;
46
+
seg_len_id : int;
47
+
first_hdr_ptr : int;
48
+
}
49
+
50
+
(* CLCW types *)
51
+
type clcw_status = Ready | Active | Reserved of int
52
+
53
+
type clcw_flags = {
54
+
no_rf_available : bool;
55
+
no_bit_lock : bool;
56
+
lockout : bool;
57
+
wait : bool;
58
+
retransmit : bool;
59
+
}
60
+
61
+
let clcw_no_flags =
62
+
{
63
+
no_rf_available = false;
64
+
no_bit_lock = false;
65
+
lockout = false;
66
+
wait = false;
67
+
retransmit = false;
68
+
}
69
+
70
+
type clcw = {
71
+
control_word_type : int;
72
+
clcw_version : int;
73
+
status : clcw_status;
74
+
cop_in_effect : int;
75
+
clcw_vcid : vcid;
76
+
flags : clcw_flags;
77
+
farm_b_counter : int;
78
+
report_value : int;
79
+
}
80
+
81
+
(* TM Frame *)
82
+
type t = {
83
+
header : header;
84
+
sec_hdr_data : string option;
85
+
data : string;
86
+
ocf : int option;
87
+
fecf : int option;
88
+
}
89
+
90
+
(* Errors *)
91
+
type error =
92
+
| Truncated of { need : int; have : int }
93
+
| Invalid_version of int
94
+
| Invalid_scid of int
95
+
| Invalid_vcid of int
96
+
| Fecf_mismatch of { expected : int; actual : int }
97
+
98
+
let pp_error ppf = function
99
+
| Truncated { need; have } ->
100
+
Format.fprintf ppf "Truncated: need %d bytes, have %d" need have
101
+
| Invalid_version v -> Format.fprintf ppf "Invalid version: %d" v
102
+
| Invalid_scid s -> Format.fprintf ppf "Invalid SCID: %d" s
103
+
| Invalid_vcid v -> Format.fprintf ppf "Invalid VCID: %d" v
104
+
| Fecf_mismatch { expected; actual } ->
105
+
Format.fprintf ppf "FECF mismatch: expected 0x%04X, got 0x%04X" expected
106
+
actual
107
+
108
+
(* Binary helpers *)
109
+
let get_u8 s i = Char.code (String.get s i)
110
+
111
+
let get_u16_be s i =
112
+
let b0 = get_u8 s i in
113
+
let b1 = get_u8 s (i + 1) in
114
+
(b0 lsl 8) lor b1
115
+
116
+
let get_u32_be s i =
117
+
let b0 = get_u8 s i in
118
+
let b1 = get_u8 s (i + 1) in
119
+
let b2 = get_u8 s (i + 2) in
120
+
let b3 = get_u8 s (i + 3) in
121
+
(b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3
122
+
123
+
let set_u8 b i v = Bytes.set b i (Char.chr (v land 0xFF))
124
+
125
+
let set_u16_be b i v =
126
+
set_u8 b i (v lsr 8);
127
+
set_u8 b (i + 1) v
128
+
129
+
let set_u32_be b i v =
130
+
set_u8 b i (v lsr 24);
131
+
set_u8 b (i + 1) (v lsr 16);
132
+
set_u8 b (i + 2) (v lsr 8);
133
+
set_u8 b (i + 3) v
134
+
135
+
(* CRC-16-CCITT computation *)
136
+
let crc16_ccitt_table =
137
+
let table = Array.make 256 0 in
138
+
for i = 0 to 255 do
139
+
let crc = ref (i lsl 8) in
140
+
for _ = 0 to 7 do
141
+
if !crc land 0x8000 <> 0 then crc := (!crc lsl 1) lxor 0x1021
142
+
else crc := !crc lsl 1
143
+
done;
144
+
table.(i) <- !crc land 0xFFFF
145
+
done;
146
+
table
147
+
148
+
let compute_fecf data =
149
+
let crc = ref 0xFFFF in
150
+
for i = 0 to String.length data - 1 do
151
+
let byte = Char.code data.[i] in
152
+
let idx = (!crc lsr 8) lxor byte land 0xFF in
153
+
crc := (!crc lsl 8) lxor crc16_ccitt_table.(idx) land 0xFFFF
154
+
done;
155
+
!crc
156
+
157
+
(* Header decoding *)
158
+
let decode_header buf =
159
+
let len = String.length buf in
160
+
if len < 6 then Error (Truncated { need = 6; have = len })
161
+
else
162
+
let w0 = get_u16_be buf 0 in
163
+
let w1 = get_u16_be buf 2 in
164
+
let w2 = get_u16_be buf 4 in
165
+
let version = (w0 lsr 14) land 0x3 in
166
+
if version <> 0 then Error (Invalid_version version)
167
+
else
168
+
let scid_val = (w0 lsr 4) land 0x3FF in
169
+
let vcid_val = (w0 lsr 1) land 0x7 in
170
+
let ocf_flag = w0 land 0x1 = 1 in
171
+
let mcfc = (w1 lsr 8) land 0xFF in
172
+
let vcfc = w1 land 0xFF in
173
+
let sec_hdr = (w2 lsr 15) land 0x1 = 1 in
174
+
let sync_flag = (w2 lsr 14) land 0x1 = 1 in
175
+
let pkt_order = (w2 lsr 13) land 0x1 = 1 in
176
+
let seg_len_id = (w2 lsr 11) land 0x3 in
177
+
let first_hdr_ptr = w2 land 0x7FF in
178
+
Ok
179
+
{
180
+
version;
181
+
scid = scid_val;
182
+
vcid = vcid_val;
183
+
ocf_flag;
184
+
mcfc;
185
+
vcfc;
186
+
sec_hdr;
187
+
sync_flag;
188
+
pkt_order;
189
+
seg_len_id;
190
+
first_hdr_ptr;
191
+
}
192
+
193
+
(* Header encoding *)
194
+
let encode_header hdr =
195
+
let buf = Bytes.create 6 in
196
+
let w0 =
197
+
hdr.version land (0x3 lsl 14)
198
+
lor ((hdr.scid land 0x3FF) lsl 4)
199
+
lor ((hdr.vcid land 0x7) lsl 1)
200
+
lor if hdr.ocf_flag then 1 else 0
201
+
in
202
+
let w1 = ((hdr.mcfc land 0xFF) lsl 8) lor (hdr.vcfc land 0xFF) in
203
+
let w2 =
204
+
((if hdr.sec_hdr then 1 else 0) lsl 15)
205
+
lor ((if hdr.sync_flag then 1 else 0) lsl 14)
206
+
lor ((if hdr.pkt_order then 1 else 0) lsl 13)
207
+
lor ((hdr.seg_len_id land 0x3) lsl 11)
208
+
lor (hdr.first_hdr_ptr land 0x7FF)
209
+
in
210
+
set_u16_be buf 0 w0;
211
+
set_u16_be buf 2 w1;
212
+
set_u16_be buf 4 w2;
213
+
Bytes.to_string buf
214
+
215
+
(* Frame decoding *)
216
+
let decode ?(frame_len = 1115) ?(expect_ocf = true) ?(expect_fecf = true)
217
+
?(check_fecf = true) buf =
218
+
let len = String.length buf in
219
+
(* Security check: reject unreasonably large frames *)
220
+
if frame_len > max_frame_len then Error (Truncated { need = 6; have = len })
221
+
else if len < 6 then Error (Truncated { need = 6; have = len })
222
+
else if len < frame_len then
223
+
Error (Truncated { need = frame_len; have = len })
224
+
else
225
+
match decode_header buf with
226
+
| Error e -> Error e
227
+
| Ok header ->
228
+
let ocf_present = expect_ocf || header.ocf_flag in
229
+
let trailer_len =
230
+
(if ocf_present then 4 else 0) + if expect_fecf then 2 else 0
231
+
in
232
+
let data_len = frame_len - 6 - trailer_len in
233
+
if data_len < 0 then Error (Truncated { need = frame_len; have = len })
234
+
else
235
+
let data = String.sub buf 6 data_len in
236
+
let ocf =
237
+
if ocf_present then Some (get_u32_be buf (6 + data_len)) else None
238
+
in
239
+
let fecf_offset = frame_len - 2 in
240
+
let fecf =
241
+
if expect_fecf then Some (get_u16_be buf fecf_offset) else None
242
+
in
243
+
(* Validate FECF if requested *)
244
+
if expect_fecf && check_fecf then
245
+
let frame_data = String.sub buf 0 (frame_len - 2) in
246
+
let computed = compute_fecf frame_data in
247
+
let actual = Option.get fecf in
248
+
if computed <> actual then
249
+
Error (Fecf_mismatch { expected = computed; actual })
250
+
else Ok { header; sec_hdr_data = None; data; ocf; fecf }
251
+
else Ok { header; sec_hdr_data = None; data; ocf; fecf }
252
+
253
+
(* Frame encoding *)
254
+
let encoded_len ?(with_ocf = true) ?(with_fecf = true) frame =
255
+
6
256
+
+ Option.fold ~none:0 ~some:String.length frame.sec_hdr_data
257
+
+ String.length frame.data
258
+
+ (if with_ocf then 4 else 0)
259
+
+ if with_fecf then 2 else 0
260
+
261
+
let encode ?(with_fecf = true) frame =
262
+
let with_ocf = Option.is_some frame.ocf in
263
+
let total_len = encoded_len ~with_ocf ~with_fecf frame in
264
+
let buf = Bytes.create total_len in
265
+
let hdr_bytes = encode_header frame.header in
266
+
Bytes.blit_string hdr_bytes 0 buf 0 6;
267
+
let offset = ref 6 in
268
+
Option.iter
269
+
(fun sh ->
270
+
Bytes.blit_string sh 0 buf !offset (String.length sh);
271
+
offset := !offset + String.length sh)
272
+
frame.sec_hdr_data;
273
+
Bytes.blit_string frame.data 0 buf !offset (String.length frame.data);
274
+
offset := !offset + String.length frame.data;
275
+
Option.iter
276
+
(fun ocf ->
277
+
set_u32_be buf !offset ocf;
278
+
offset := !offset + 4)
279
+
frame.ocf;
280
+
if with_fecf then begin
281
+
let frame_data = Bytes.sub_string buf 0 !offset in
282
+
let crc = compute_fecf frame_data in
283
+
set_u16_be buf !offset crc
284
+
end;
285
+
Bytes.to_string buf
286
+
287
+
(* CLCW decoding *)
288
+
let decode_clcw word =
289
+
let control_word_type = (word lsr 31) land 0x1 in
290
+
let clcw_version = (word lsr 29) land 0x3 in
291
+
let status_val = (word lsr 26) land 0x7 in
292
+
let status =
293
+
match status_val with 0 -> Ready | 1 -> Active | n -> Reserved n
294
+
in
295
+
let cop_in_effect = (word lsr 24) land 0x3 in
296
+
let vcid_val = (word lsr 18) land 0x3F in
297
+
(* 6 bits in CLCW *)
298
+
let vcid_tm = vcid_val land 0x7 in
299
+
(* Use lower 3 bits for TM VCID *)
300
+
let no_rf_available = (word lsr 15) land 0x1 = 1 in
301
+
let no_bit_lock = (word lsr 14) land 0x1 = 1 in
302
+
let lockout = (word lsr 13) land 0x1 = 1 in
303
+
let wait = (word lsr 12) land 0x1 = 1 in
304
+
let retransmit = (word lsr 11) land 0x1 = 1 in
305
+
let farm_b_counter = (word lsr 9) land 0x3 in
306
+
let report_value = word land 0xFF in
307
+
Ok
308
+
{
309
+
control_word_type;
310
+
clcw_version;
311
+
status;
312
+
cop_in_effect;
313
+
clcw_vcid = vcid_tm;
314
+
flags = { no_rf_available; no_bit_lock; lockout; wait; retransmit };
315
+
farm_b_counter;
316
+
report_value;
317
+
}
318
+
319
+
(* CLCW encoding *)
320
+
let encode_clcw clcw =
321
+
let status_val =
322
+
match clcw.status with Ready -> 0 | Active -> 1 | Reserved n -> n land 0x7
323
+
in
324
+
clcw.control_word_type land (0x1 lsl 31)
325
+
lor ((clcw.clcw_version land 0x3) lsl 29)
326
+
lor ((status_val land 0x7) lsl 26)
327
+
lor ((clcw.cop_in_effect land 0x3) lsl 24)
328
+
lor ((clcw.clcw_vcid land 0x3F) lsl 18)
329
+
lor ((if clcw.flags.no_rf_available then 1 else 0) lsl 15)
330
+
lor ((if clcw.flags.no_bit_lock then 1 else 0) lsl 14)
331
+
lor ((if clcw.flags.lockout then 1 else 0) lsl 13)
332
+
lor ((if clcw.flags.wait then 1 else 0) lsl 12)
333
+
lor ((if clcw.flags.retransmit then 1 else 0) lsl 11)
334
+
lor ((clcw.farm_b_counter land 0x3) lsl 9)
335
+
lor (clcw.report_value land 0xFF)
336
+
337
+
let get_clcw frame =
338
+
match frame.ocf with
339
+
| None -> Error `No_ocf
340
+
| Some word -> (
341
+
match decode_clcw word with
342
+
| Ok clcw -> Ok clcw
343
+
| Error (`Invalid_vcid v) -> Error (`Invalid_vcid v))
344
+
345
+
(* Constructors *)
346
+
let make_header ?(version = 0) ?(ocf_flag = true) ?(sec_hdr = false)
347
+
?(sync_flag = false) ?(pkt_order = false) ?(seg_len_id = 3)
348
+
?(first_hdr_ptr = 0) ~scid ~vcid ~mcfc ~vcfc () =
349
+
{
350
+
version;
351
+
scid;
352
+
vcid;
353
+
ocf_flag;
354
+
mcfc;
355
+
vcfc;
356
+
sec_hdr;
357
+
sync_flag;
358
+
pkt_order;
359
+
seg_len_id;
360
+
first_hdr_ptr;
361
+
}
362
+
363
+
let make ?(version = 0) ?(ocf_flag = true) ?(sec_hdr = false)
364
+
?(sync_flag = false) ?(pkt_order = false) ?(seg_len_id = 3)
365
+
?(first_hdr_ptr = 0) ?sec_hdr_data ?ocf ?fecf ~scid ~vcid ~mcfc ~vcfc data =
366
+
let header =
367
+
make_header ~version ~ocf_flag ~sec_hdr ~sync_flag ~pkt_order ~seg_len_id
368
+
~first_hdr_ptr ~scid ~vcid ~mcfc ~vcfc ()
369
+
in
370
+
{ header; sec_hdr_data; data; ocf; fecf }
371
+
372
+
let make_clcw ?(control_word_type = 0) ?(version = 0) ?(status = Ready)
373
+
?(cop_in_effect = 1) ?(no_rf_available = false) ?(no_bit_lock = false)
374
+
?(lockout = false) ?(wait = false) ?(retransmit = false)
375
+
?(farm_b_counter = 0) ~vcid ~report_value () =
376
+
{
377
+
control_word_type;
378
+
clcw_version = version;
379
+
status;
380
+
cop_in_effect;
381
+
clcw_vcid = vcid;
382
+
flags = { no_rf_available; no_bit_lock; lockout; wait; retransmit };
383
+
farm_b_counter;
384
+
report_value;
385
+
}
386
+
387
+
(* Pretty-printing *)
388
+
let pp_header ppf hdr =
389
+
Format.fprintf ppf
390
+
"@[<v>TM Header:@,\
391
+
\ version=%d scid=%d vcid=%d@,\
392
+
\ ocf=%b mcfc=%d vcfc=%d@,\
393
+
\ sec_hdr=%b sync=%b pkt_order=%b@,\
394
+
\ seg_len_id=%d first_hdr_ptr=0x%03X@]"
395
+
hdr.version hdr.scid hdr.vcid hdr.ocf_flag hdr.mcfc hdr.vcfc hdr.sec_hdr
396
+
hdr.sync_flag hdr.pkt_order hdr.seg_len_id hdr.first_hdr_ptr
397
+
398
+
let pp_clcw_status ppf = function
399
+
| Ready -> Format.fprintf ppf "Ready"
400
+
| Active -> Format.fprintf ppf "Active"
401
+
| Reserved n -> Format.fprintf ppf "Reserved(%d)" n
402
+
403
+
let pp_clcw ppf clcw =
404
+
Format.fprintf ppf
405
+
"@[<v>CLCW:@,\
406
+
\ type=%d version=%d status=%a@,\
407
+
\ cop=%d vcid=%d report=%d@,\
408
+
\ lockout=%b wait=%b retransmit=%b@]"
409
+
clcw.control_word_type clcw.clcw_version pp_clcw_status clcw.status
410
+
clcw.cop_in_effect clcw.clcw_vcid clcw.report_value clcw.flags.lockout
411
+
clcw.flags.wait clcw.flags.retransmit
412
+
413
+
let pp ppf frame =
414
+
Format.fprintf ppf "@[<v>%a@,data=%d bytes@,ocf=%a@,fecf=%a@]" pp_header
415
+
frame.header (String.length frame.data)
416
+
(Format.pp_print_option (fun ppf v -> Format.fprintf ppf "0x%08X" v))
417
+
frame.ocf
418
+
(Format.pp_print_option (fun ppf v -> Format.fprintf ppf "0x%04X" v))
419
+
frame.fecf
+259
lib/tm.mli
+259
lib/tm.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** CCSDS TM Transfer Frames (CCSDS 132.0-B-3).
7
+
8
+
TM (Telemetry) Transfer Frames transport telemetry data from spacecraft to
9
+
ground stations. This module handles parsing and encoding of TM frames
10
+
including the primary header, Operational Control Field (OCF), and Frame
11
+
Error Control Field (FECF).
12
+
13
+
{b Frame Structure}
14
+
15
+
{v
16
+
+----------------+-------------+------+------+
17
+
| Primary Header | Data Field | OCF | FECF |
18
+
| (6 bytes) | (variable) | (4B) | (2B) |
19
+
+----------------+-------------+------+------+
20
+
v}
21
+
22
+
{b Primary Header Format (48 bits)}
23
+
24
+
{v
25
+
+---------+------+------+---------+------+------+---------+
26
+
| Version | SCID | VCID | OCF_flg | MCFC | VCFC | DFH+FSH |
27
+
| 2 bits | 10b | 3b | 1b | 8b | 8b | 16 bits|
28
+
+---------+------+------+---------+------+------+---------+
29
+
|
30
+
+---------------------+
31
+
|
32
+
+--------+------+------+--------+-------------+
33
+
| SecHdr | Sync | PktOrd| SegLen | FirstHdrPtr |
34
+
| 1 bit | 1b | 1b | 2b | 11 bits |
35
+
+--------+------+------+--------+-------------+
36
+
v}
37
+
38
+
{b References}
39
+
- CCSDS 132.0-B-3: TM Space Data Link Protocol
40
+
- CCSDS 232.1-B-2: Communications Operation Procedure-1 (COP-1) *)
41
+
42
+
(** {1 Spacecraft and Virtual Channel IDs} *)
43
+
44
+
type scid = private int
45
+
(** Spacecraft Identifier (10 bits, 0-1023). *)
46
+
47
+
val scid : int -> scid option
48
+
(** [scid n] creates a spacecraft ID if [n] is in range 0-1023. *)
49
+
50
+
val scid_exn : int -> scid
51
+
(** [scid_exn n] creates a spacecraft ID, raises [Invalid_argument] if out of
52
+
range. *)
53
+
54
+
val scid_to_int : scid -> int
55
+
(** [scid_to_int s] returns the integer value. *)
56
+
57
+
type vcid = private int
58
+
(** Virtual Channel Identifier (3 bits for TM, 0-7). *)
59
+
60
+
val vcid : int -> vcid option
61
+
(** [vcid n] creates a virtual channel ID if [n] is in range 0-7. *)
62
+
63
+
val vcid_exn : int -> vcid
64
+
(** [vcid_exn n] creates a virtual channel ID, raises [Invalid_argument] if out
65
+
of range. *)
66
+
67
+
val vcid_to_int : vcid -> int
68
+
(** [vcid_to_int v] returns the integer value. *)
69
+
70
+
(** {1 Frame Header} *)
71
+
72
+
type header = {
73
+
version : int; (** Transfer frame version (2 bits, 00 for TM) *)
74
+
scid : scid; (** Spacecraft ID (10 bits) *)
75
+
vcid : vcid; (** Virtual Channel ID (3 bits) *)
76
+
ocf_flag : bool; (** Operational Control Field present *)
77
+
mcfc : int; (** Master Channel Frame Count (8 bits, 0-255) *)
78
+
vcfc : int; (** Virtual Channel Frame Count (8 bits, 0-255) *)
79
+
sec_hdr : bool; (** Secondary header flag *)
80
+
sync_flag : bool; (** Synchronization flag *)
81
+
pkt_order : bool; (** Packet order flag *)
82
+
seg_len_id : int; (** Segment length identifier (2 bits) *)
83
+
first_hdr_ptr : int; (** First header pointer (11 bits) *)
84
+
}
85
+
(** TM frame primary header (6 bytes, 48 bits). *)
86
+
87
+
(** {1 First Header Pointer Constants} *)
88
+
89
+
val fhp_no_packet : int
90
+
(** [0x7FE]: No packet starts in this frame (continuation only). *)
91
+
92
+
val fhp_idle_only : int
93
+
(** [0x7FF]: Only idle data in frame (no valid packets). *)
94
+
95
+
(** {1 CLCW - Command Link Control Word}
96
+
97
+
The CLCW is carried in the OCF field and provides feedback about the command
98
+
link state (COP-1 protocol). *)
99
+
100
+
type clcw_status =
101
+
| Ready (** COP-1 ready to receive *)
102
+
| Active (** COP-1 actively processing *)
103
+
| Reserved of int (** Reserved status value *)
104
+
105
+
type clcw_flags = {
106
+
no_rf_available : bool; (** No RF link available *)
107
+
no_bit_lock : bool; (** No bit lock on uplink *)
108
+
lockout : bool; (** FARM-1 in lockout state *)
109
+
wait : bool; (** FARM-1 in wait state *)
110
+
retransmit : bool; (** Retransmission requested *)
111
+
}
112
+
113
+
type clcw = {
114
+
control_word_type : int; (** Control word type (1 bit, 0 for CLCW) *)
115
+
clcw_version : int; (** CLCW version (2 bits) *)
116
+
status : clcw_status; (** COP-1 status (3 bits) *)
117
+
cop_in_effect : int; (** COP in effect (2 bits) *)
118
+
clcw_vcid : vcid; (** Virtual channel ID *)
119
+
flags : clcw_flags; (** Status flags *)
120
+
farm_b_counter : int; (** FARM-B counter (2 bits) *)
121
+
report_value : int; (** Report value / N(R) (8 bits) *)
122
+
}
123
+
(** Command Link Control Word (32 bits). *)
124
+
125
+
val clcw_no_flags : clcw_flags
126
+
(** All flags set to false. *)
127
+
128
+
(** {1 TM Frame} *)
129
+
130
+
type t = {
131
+
header : header;
132
+
sec_hdr_data : string option; (** Secondary header (mission-specific) *)
133
+
data : string; (** Data field contents *)
134
+
ocf : int option; (** Operational Control Field (32 bits) *)
135
+
fecf : int option; (** Frame Error Control Field (16-bit CRC) *)
136
+
}
137
+
(** Complete TM transfer frame. *)
138
+
139
+
(** {1 Errors} *)
140
+
141
+
type error =
142
+
| Truncated of { need : int; have : int }
143
+
| Invalid_version of int
144
+
| Invalid_scid of int
145
+
| Invalid_vcid of int
146
+
| Fecf_mismatch of { expected : int; actual : int }
147
+
148
+
val pp_error : Format.formatter -> error -> unit
149
+
(** Pretty-print an error. *)
150
+
151
+
(** {1 Decoding} *)
152
+
153
+
val decode_header : string -> (header, error) result
154
+
(** [decode_header buf] decodes a TM frame header from the first 6 bytes. *)
155
+
156
+
val decode :
157
+
?frame_len:int ->
158
+
?expect_ocf:bool ->
159
+
?expect_fecf:bool ->
160
+
?check_fecf:bool ->
161
+
string ->
162
+
(t, error) result
163
+
(** [decode ?frame_len ?expect_ocf ?expect_fecf ?check_fecf buf] decodes a TM
164
+
frame.
165
+
166
+
@param frame_len Total frame length (default 1115 bytes for CCSDS standard)
167
+
@param expect_ocf Whether OCF is present (default: use header flag)
168
+
@param expect_fecf Whether FECF is present (default true)
169
+
@param check_fecf Whether to validate FECF CRC (default true) *)
170
+
171
+
(** {1 Encoding} *)
172
+
173
+
val encode_header : header -> string
174
+
(** [encode_header hdr] encodes a TM frame header to 6 bytes. *)
175
+
176
+
val encode : ?with_fecf:bool -> t -> string
177
+
(** [encode ?with_fecf frame] encodes a TM frame.
178
+
179
+
@param with_fecf Compute and append FECF (default true) *)
180
+
181
+
val encoded_len : ?with_ocf:bool -> ?with_fecf:bool -> t -> int
182
+
(** [encoded_len frame] returns the total encoded length in bytes. *)
183
+
184
+
(** {1 FECF (CRC-16-CCITT)} *)
185
+
186
+
val compute_fecf : string -> int
187
+
(** [compute_fecf data] computes CRC-16-CCITT (polynomial 0x1021) over the frame
188
+
data (excluding FECF itself). *)
189
+
190
+
(** {1 CLCW Operations} *)
191
+
192
+
val decode_clcw : int -> (clcw, [ `Invalid_vcid of int ]) result
193
+
(** [decode_clcw word] decodes a 32-bit CLCW from the OCF field. *)
194
+
195
+
val encode_clcw : clcw -> int
196
+
(** [encode_clcw clcw] encodes a CLCW to a 32-bit word. *)
197
+
198
+
val get_clcw : t -> (clcw, [ `No_ocf | `Invalid_vcid of int ]) result
199
+
(** [get_clcw frame] extracts and decodes the CLCW from the frame's OCF. *)
200
+
201
+
(** {1 Constructors} *)
202
+
203
+
val make_header :
204
+
?version:int ->
205
+
?ocf_flag:bool ->
206
+
?sec_hdr:bool ->
207
+
?sync_flag:bool ->
208
+
?pkt_order:bool ->
209
+
?seg_len_id:int ->
210
+
?first_hdr_ptr:int ->
211
+
scid:scid ->
212
+
vcid:vcid ->
213
+
mcfc:int ->
214
+
vcfc:int ->
215
+
unit ->
216
+
header
217
+
(** Create a TM frame header with the given parameters. *)
218
+
219
+
val make :
220
+
?version:int ->
221
+
?ocf_flag:bool ->
222
+
?sec_hdr:bool ->
223
+
?sync_flag:bool ->
224
+
?pkt_order:bool ->
225
+
?seg_len_id:int ->
226
+
?first_hdr_ptr:int ->
227
+
?sec_hdr_data:string ->
228
+
?ocf:int ->
229
+
?fecf:int ->
230
+
scid:scid ->
231
+
vcid:vcid ->
232
+
mcfc:int ->
233
+
vcfc:int ->
234
+
string ->
235
+
t
236
+
(** [make ~scid ~vcid ~mcfc ~vcfc data] creates a TM frame. *)
237
+
238
+
val make_clcw :
239
+
?control_word_type:int ->
240
+
?version:int ->
241
+
?status:clcw_status ->
242
+
?cop_in_effect:int ->
243
+
?no_rf_available:bool ->
244
+
?no_bit_lock:bool ->
245
+
?lockout:bool ->
246
+
?wait:bool ->
247
+
?retransmit:bool ->
248
+
?farm_b_counter:int ->
249
+
vcid:vcid ->
250
+
report_value:int ->
251
+
unit ->
252
+
clcw
253
+
(** Create a CLCW with the given parameters. *)
254
+
255
+
(** {1 Pretty-printing} *)
256
+
257
+
val pp_header : Format.formatter -> header -> unit
258
+
val pp_clcw : Format.formatter -> clcw -> unit
259
+
val pp : Format.formatter -> t -> unit
+1
test/test.ml
+1
test/test.ml
···
1
+
let () = Alcotest.run "tm" Test_tm.suite
+162
test/test_tm.ml
+162
test/test_tm.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Test TM frame parsing and encoding *)
7
+
8
+
let header_testable =
9
+
Alcotest.testable Tm.pp_header (fun a b ->
10
+
a.Tm.version = b.Tm.version
11
+
&& Tm.scid_to_int a.scid = Tm.scid_to_int b.scid
12
+
&& Tm.vcid_to_int a.vcid = Tm.vcid_to_int b.vcid
13
+
&& a.ocf_flag = b.ocf_flag && a.mcfc = b.mcfc && a.vcfc = b.vcfc
14
+
&& a.sec_hdr = b.sec_hdr && a.sync_flag = b.sync_flag
15
+
&& a.pkt_order = b.pkt_order
16
+
&& a.seg_len_id = b.seg_len_id
17
+
&& a.first_hdr_ptr = b.first_hdr_ptr)
18
+
19
+
let clcw_testable =
20
+
Alcotest.testable Tm.pp_clcw (fun a b ->
21
+
a.Tm.control_word_type = b.Tm.control_word_type
22
+
&& a.clcw_version = b.clcw_version
23
+
&& a.cop_in_effect = b.cop_in_effect
24
+
&& Tm.vcid_to_int a.clcw_vcid = Tm.vcid_to_int b.clcw_vcid
25
+
&& a.farm_b_counter = b.farm_b_counter
26
+
&& a.report_value = b.report_value)
27
+
28
+
(* Test: SCID validation *)
29
+
let test_scid_valid () =
30
+
Alcotest.(check bool) "0 is valid" true (Option.is_some (Tm.scid 0));
31
+
Alcotest.(check bool) "1023 is valid" true (Option.is_some (Tm.scid 1023));
32
+
Alcotest.(check bool) "1024 is invalid" true (Option.is_none (Tm.scid 1024));
33
+
Alcotest.(check bool) "-1 is invalid" true (Option.is_none (Tm.scid (-1)))
34
+
35
+
(* Test: VCID validation *)
36
+
let test_vcid_valid () =
37
+
Alcotest.(check bool) "0 is valid" true (Option.is_some (Tm.vcid 0));
38
+
Alcotest.(check bool) "7 is valid" true (Option.is_some (Tm.vcid 7));
39
+
Alcotest.(check bool) "8 is invalid" true (Option.is_none (Tm.vcid 8));
40
+
Alcotest.(check bool) "-1 is invalid" true (Option.is_none (Tm.vcid (-1)))
41
+
42
+
(* Test: Header roundtrip *)
43
+
let test_header_roundtrip () =
44
+
let scid = Tm.scid_exn 123 in
45
+
let vcid = Tm.vcid_exn 5 in
46
+
let hdr =
47
+
Tm.make_header ~scid ~vcid ~mcfc:42 ~vcfc:99 ~first_hdr_ptr:0x100 ()
48
+
in
49
+
let encoded = Tm.encode_header hdr in
50
+
Alcotest.(check int) "header is 6 bytes" 6 (String.length encoded);
51
+
match Tm.decode_header encoded with
52
+
| Error e -> Alcotest.failf "decode failed: %a" Tm.pp_error e
53
+
| Ok decoded -> Alcotest.check header_testable "roundtrip" hdr decoded
54
+
55
+
(* Test: CLCW roundtrip *)
56
+
let test_clcw_roundtrip () =
57
+
let vcid = Tm.vcid_exn 3 in
58
+
let clcw =
59
+
Tm.make_clcw ~vcid ~report_value:127 ~lockout:true ~retransmit:true ()
60
+
in
61
+
let encoded = Tm.encode_clcw clcw in
62
+
match Tm.decode_clcw encoded with
63
+
| Error _ -> Alcotest.fail "decode failed"
64
+
| Ok decoded -> Alcotest.check clcw_testable "roundtrip" clcw decoded
65
+
66
+
(* Test: Full frame roundtrip *)
67
+
let test_frame_roundtrip () =
68
+
let scid = Tm.scid_exn 100 in
69
+
let vcid = Tm.vcid_exn 2 in
70
+
let data = String.make 1103 '\x55' in
71
+
(* 1115 - 6 header - 4 OCF - 2 FECF = 1103 *)
72
+
let frame = Tm.make ~scid ~vcid ~mcfc:1 ~vcfc:2 ~ocf:0x12345678 data in
73
+
let encoded = Tm.encode frame in
74
+
Alcotest.(check int) "encoded length" 1115 (String.length encoded);
75
+
match Tm.decode encoded with
76
+
| Error e -> Alcotest.failf "decode failed: %a" Tm.pp_error e
77
+
| Ok decoded ->
78
+
Alcotest.(check int)
79
+
"data length" (String.length data)
80
+
(String.length decoded.data);
81
+
Alcotest.(check (option int)) "ocf" (Some 0x12345678) decoded.ocf
82
+
83
+
(* Test: CRC-16 computation *)
84
+
let test_crc16 () =
85
+
(* Known test vector: "123456789" should give 0x29B1 *)
86
+
let crc = Tm.compute_fecf "123456789" in
87
+
Alcotest.(check int) "CRC-16 of 123456789" 0x29B1 crc
88
+
89
+
(* Test: First header pointer constants *)
90
+
let test_fhp_constants () =
91
+
Alcotest.(check int) "fhp_no_packet" 0x7FE Tm.fhp_no_packet;
92
+
Alcotest.(check int) "fhp_idle_only" 0x7FF Tm.fhp_idle_only
93
+
94
+
(* Security tests *)
95
+
96
+
(* Test: Reject truncated input *)
97
+
let test_truncated () =
98
+
match Tm.decode "" with
99
+
| Error (Truncated _) -> ()
100
+
| _ -> Alcotest.fail "should reject empty input"
101
+
102
+
(* Test: Reject too-short header *)
103
+
let test_short_header () =
104
+
match Tm.decode_header "\x00\x01\x02" with
105
+
| Error (Truncated { need = 6; have = 3 }) -> ()
106
+
| _ -> Alcotest.fail "should reject short header"
107
+
108
+
(* Test: Reject invalid version *)
109
+
let test_invalid_version () =
110
+
(* Version field is bits 15-14 of first word, set to 0b11 *)
111
+
let bad_hdr = "\xC0\x00\x00\x00\x00\x00" in
112
+
match Tm.decode_header bad_hdr with
113
+
| Error (Invalid_version 3) -> ()
114
+
| Error (Invalid_version n) -> Alcotest.failf "wrong version error: %d" n
115
+
| _ -> Alcotest.fail "should reject invalid version"
116
+
117
+
(* Test: FECF validation *)
118
+
let test_fecf_mismatch () =
119
+
let scid = Tm.scid_exn 0 in
120
+
let vcid = Tm.vcid_exn 0 in
121
+
let data = String.make 1103 '\x00' in
122
+
let frame = Tm.make ~scid ~vcid ~mcfc:0 ~vcfc:0 ~ocf:0 data in
123
+
let encoded = Tm.encode frame in
124
+
let frame_len = String.length encoded in
125
+
(* Corrupt the FECF (last 2 bytes) *)
126
+
let corrupted = String.sub encoded 0 (frame_len - 2) ^ "\xFF\xFF" in
127
+
match Tm.decode ~frame_len corrupted with
128
+
| Error (Fecf_mismatch _) -> ()
129
+
| Error e -> Alcotest.failf "wrong error: %a" Tm.pp_error e
130
+
| Ok _ -> Alcotest.fail "should reject bad FECF"
131
+
132
+
(* Test: Reject oversized frame_len parameter *)
133
+
let test_oversized_frame_len () =
134
+
let buf = String.make 100 '\x00' in
135
+
match Tm.decode ~frame_len:10000 buf with
136
+
| Error (Truncated _) -> ()
137
+
| _ -> Alcotest.fail "should reject oversized frame_len"
138
+
139
+
let suite =
140
+
[
141
+
( "validation",
142
+
[
143
+
Alcotest.test_case "scid" `Quick test_scid_valid;
144
+
Alcotest.test_case "vcid" `Quick test_vcid_valid;
145
+
] );
146
+
( "roundtrip",
147
+
[
148
+
Alcotest.test_case "header" `Quick test_header_roundtrip;
149
+
Alcotest.test_case "clcw" `Quick test_clcw_roundtrip;
150
+
Alcotest.test_case "frame" `Quick test_frame_roundtrip;
151
+
] );
152
+
("crc", [ Alcotest.test_case "crc16" `Quick test_crc16 ]);
153
+
("constants", [ Alcotest.test_case "fhp" `Quick test_fhp_constants ]);
154
+
( "security",
155
+
[
156
+
Alcotest.test_case "truncated" `Quick test_truncated;
157
+
Alcotest.test_case "short_header" `Quick test_short_header;
158
+
Alcotest.test_case "invalid_version" `Quick test_invalid_version;
159
+
Alcotest.test_case "fecf_mismatch" `Quick test_fecf_mismatch;
160
+
Alcotest.test_case "oversized_frame_len" `Quick test_oversized_frame_len;
161
+
] );
162
+
]
+30
tm.opam
+30
tm.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "CCSDS TM Transfer Frames (CCSDS 132.0-B)"
4
+
description:
5
+
"Parser and encoder for CCSDS Telemetry Transfer Frames. Supports TM frame primary headers, Operational Control Field (OCF), Frame Error Control Field (FECF/CRC-16), and CLCW (Command Link Control Word) for COP-1."
6
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
7
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
license: "MIT"
9
+
depends: [
10
+
"dune" {>= "3.0"}
11
+
"ocaml" {>= "4.14"}
12
+
"alcotest" {with-test}
13
+
"crowbar" {with-test}
14
+
"odoc" {with-doc}
15
+
]
16
+
build: [
17
+
["dune" "subst"] {dev}
18
+
[
19
+
"dune"
20
+
"build"
21
+
"-p"
22
+
name
23
+
"-j"
24
+
jobs
25
+
"@install"
26
+
"@runtest" {with-test}
27
+
"@doc" {with-doc}
28
+
]
29
+
]
30
+
dev-repo: "https://tangled.org/gazagnaire.org/ocaml-tm"