AX.25 Amateur Radio Link-Layer Protocol
irmin: WIP core implementation — tree.ml needs lazy rewrite
+166
-124
+1
ax25.opam
+1
ax25.opam
+164
-123
lib/ax25.ml
+164
-123
lib/ax25.ml
···
5
5
6
6
open Result.Syntax
7
7
8
-
(* {1 Internal Binary Utilities}
9
-
10
-
Minimal reader/writer for in-memory byte operations.
11
-
These are self-contained and don't depend on bytesrw. *)
12
-
13
-
type truncated = { need : int; have : int }
14
-
15
-
module Reader = struct
16
-
type t = { buf : bytes; len : int; mutable pos : int }
17
-
18
-
let of_bytes buf = { buf; len = Bytes.length buf; pos = 0 }
19
-
let remaining t = t.len - t.pos
20
-
21
-
let ensure t n =
22
-
if remaining t >= n then Ok ()
23
-
else Error (`Truncated { need = n; have = remaining t })
24
-
25
-
let uint8 t =
26
-
if t.pos >= t.len then invalid_arg "Reader.uint8: need 1 byte, have 0";
27
-
let b = Bytes.get_uint8 t.buf t.pos in
28
-
t.pos <- t.pos + 1;
29
-
b
30
-
31
-
let bytes t n =
32
-
if t.pos + n > t.len then
33
-
Fmt.invalid_arg "Reader.bytes: need %d bytes, have %d" n (remaining t);
34
-
let result = Bytes.create n in
35
-
Bytes.blit t.buf t.pos result 0 n;
36
-
t.pos <- t.pos + n;
37
-
result
38
-
end
39
-
40
-
module Writer = struct
41
-
type t = { buf : bytes; len : int; mutable pos : int; mutable max_pos : int }
42
-
43
-
let create n = { buf = Bytes.create n; len = n; pos = 0; max_pos = 0 }
44
-
let update_max_pos t = if t.pos > t.max_pos then t.max_pos <- t.pos
45
-
46
-
let uint8 t v =
47
-
if t.pos >= t.len then invalid_arg "Writer.uint8: buffer full";
48
-
Bytes.set_uint8 t.buf t.pos (v land 0xFF);
49
-
t.pos <- t.pos + 1;
50
-
update_max_pos t
51
-
52
-
let bytes t data =
53
-
let n = Bytes.length data in
54
-
if t.pos + n > t.len then
55
-
Fmt.invalid_arg "Writer.bytes: need %d bytes, have %d" n (t.len - t.pos);
56
-
Bytes.blit data 0 t.buf t.pos n;
57
-
t.pos <- t.pos + n;
58
-
update_max_pos t
59
-
60
-
let contents t = Bytes.sub t.buf 0 t.max_pos
61
-
end
62
-
63
8
(* {1 Callsigns} *)
64
9
65
10
type ssid = int
···
279
224
done;
280
225
!crc lxor 0xFFFF
281
226
227
+
(* {1 Wire Codecs}
228
+
229
+
Wire descriptions for the byte-level structures in AX.25 frames. *)
230
+
231
+
type ssid_byte = {
232
+
ch_flag : bool;
233
+
reserved : int;
234
+
ssid_val : int;
235
+
extension : bool;
236
+
}
237
+
(** SSID byte bitfield (1 byte): Bit 7: C/H flag (has_been_repeated) Bits 6-5:
238
+
reserved (always 0b11 = 0x60) Bits 4-1: SSID (4 bits) Bit 0: extension bit
239
+
(is_last) *)
240
+
241
+
let f_ch_flag = Wire.Field.v "ch_flag" (Wire.bit (Wire.bits ~width:1 Wire.U8))
242
+
let f_reserved = Wire.Field.v "reserved" (Wire.bits ~width:2 Wire.U8)
243
+
let f_ssid_val = Wire.Field.v "ssid_val" (Wire.bits ~width:4 Wire.U8)
244
+
245
+
let f_extension =
246
+
Wire.Field.v "extension" (Wire.bit (Wire.bits ~width:1 Wire.U8))
247
+
248
+
let ssid_codec =
249
+
Wire.Codec.v "SSID"
250
+
(fun ch_flag reserved ssid_val extension ->
251
+
{ ch_flag; reserved; ssid_val; extension })
252
+
Wire.Codec.
253
+
[
254
+
(f_ch_flag $ fun s -> s.ch_flag);
255
+
(f_reserved $ fun s -> s.reserved);
256
+
(f_ssid_val $ fun s -> s.ssid_val);
257
+
(f_extension $ fun s -> s.extension);
258
+
]
259
+
260
+
type callsign_wire = { call_bytes : string; ssid_byte : ssid_byte }
261
+
(** Callsign wire record (7 bytes): 6 bytes shifted call + 1 byte SSID *)
262
+
263
+
let f_call_bytes =
264
+
Wire.Field.v "call_bytes" (Wire.byte_array ~size:(Wire.int 6))
265
+
266
+
let f_ssid_byte = Wire.Field.v "ssid_byte" (Wire.codec ssid_codec)
267
+
268
+
let callsign_codec =
269
+
Wire.Codec.v "Callsign"
270
+
(fun call_bytes ssid_byte -> { call_bytes; ssid_byte })
271
+
Wire.Codec.
272
+
[
273
+
(f_call_bytes $ fun c -> c.call_bytes);
274
+
(f_ssid_byte $ fun c -> c.ssid_byte);
275
+
]
276
+
277
+
let callsign_wire_size = Wire.Codec.wire_size callsign_codec
278
+
279
+
(** Control byte: tagged union via map over uint8 *)
280
+
let control_typ =
281
+
Wire.map ~decode:control_of_byte ~encode:byte_of_control Wire.uint8
282
+
283
+
(** PID byte: simple variant via map over uint8 *)
284
+
let pid_typ = Wire.map ~decode:pid_of_byte ~encode:byte_of_pid Wire.uint8
285
+
282
286
(* {1 Address Encoding}
283
287
284
288
Each callsign is 7 bytes: 6 bytes for call (ASCII left-shifted by 1, space padded)
285
289
plus 1 byte for SSID and flags. *)
286
290
287
-
let encode_callsign w (cs : callsign) ~is_last ~has_been_repeated =
288
-
(* Pad call to 6 chars with spaces, then left-shift each by 1 *)
289
-
let padded = Fmt.str "%-6s" cs.call in
291
+
let encode_call_string call =
292
+
(* Pad call to 6 chars with spaces, then left-shift each byte by 1 *)
293
+
let padded = Fmt.str "%-6s" call in
294
+
let buf = Bytes.create 6 in
290
295
for i = 0 to 5 do
291
-
Writer.uint8 w (Char.code padded.[i] lsl 1)
296
+
Bytes.set_uint8 buf i (Char.code padded.[i] lsl 1)
292
297
done;
293
-
(* SSID byte: bits 0 = extension, 1-4 = SSID, 5-6 = reserved (set to 1), 7 = C/H *)
294
-
let ssid_byte =
295
-
(if is_last then 0x01 else 0x00)
296
-
lor ((cs.ssid land 0x0F) lsl 1)
297
-
lor 0x60
298
-
lor
299
-
(* reserved bits = 11 *)
300
-
if has_been_repeated then 0x80 else 0x00
301
-
in
302
-
Writer.uint8 w ssid_byte
298
+
Bytes.to_string buf
303
299
304
-
let decode_callsign r ~is_digipeater:_ =
305
-
let call_bytes = Reader.bytes r 6 in
306
-
let call_buf = Buffer.create 6 in
300
+
let decode_call_string raw =
301
+
(* Right-shift each byte by 1, strip trailing spaces *)
302
+
let buf = Buffer.create 6 in
307
303
for i = 0 to 5 do
308
-
let c = Char.chr (Char.code (Bytes.get call_bytes i) lsr 1) in
309
-
if c <> ' ' then Buffer.add_char call_buf c
304
+
let c = Char.chr (Char.code raw.[i] lsr 1) in
305
+
if c <> ' ' then Buffer.add_char buf c
310
306
done;
311
-
let call = Buffer.contents call_buf in
312
-
let ssid_byte = Reader.uint8 r in
313
-
let ssid = (ssid_byte lsr 1) land 0x0F in
314
-
let is_last = ssid_byte land 0x01 <> 0 in
315
-
let _has_been_repeated = ssid_byte land 0x80 <> 0 in
316
-
match callsign ~call ~ssid with
317
-
| Some cs -> Ok (cs, is_last)
318
-
| None -> Error (Invalid_callsign call)
307
+
Buffer.contents buf
308
+
309
+
let encode_callsign_to_bytes (cs : callsign) ~is_last ~has_been_repeated =
310
+
let cw =
311
+
{
312
+
call_bytes = encode_call_string cs.call;
313
+
ssid_byte =
314
+
{
315
+
ch_flag = has_been_repeated;
316
+
reserved = 0x03;
317
+
ssid_val = cs.ssid land 0x0F;
318
+
extension = is_last;
319
+
};
320
+
}
321
+
in
322
+
let buf = Bytes.create callsign_wire_size in
323
+
Wire.Codec.encode callsign_codec cw buf 0;
324
+
buf
325
+
326
+
let decode_callsign_from_bytes buf off =
327
+
match Wire.Codec.decode callsign_codec buf off with
328
+
| Error _ -> Error (Invalid_callsign "<decode error>")
329
+
| Ok cw -> (
330
+
let call = decode_call_string cw.call_bytes in
331
+
let ssid = cw.ssid_byte.ssid_val in
332
+
let is_last = cw.ssid_byte.extension in
333
+
match callsign ~call ~ssid with
334
+
| Some cs -> Ok (cs, is_last)
335
+
| None -> Error (Invalid_callsign call))
319
336
320
337
(* {1 Encoding/Decoding} *)
321
338
322
-
let write w frame =
339
+
let write_to_buf frame =
340
+
let buf = Buffer.create 512 in
323
341
(* Destination *)
324
-
encode_callsign w frame.address.destination
325
-
~is_last:(frame.address.source.ssid = 0 && frame.address.digipeaters = [])
326
-
~has_been_repeated:false;
342
+
let dst_bytes =
343
+
encode_callsign_to_bytes frame.address.destination
344
+
~is_last:(frame.address.source.ssid = 0 && frame.address.digipeaters = [])
345
+
~has_been_repeated:false
346
+
in
347
+
Buffer.add_bytes buf dst_bytes;
327
348
(* Source *)
328
-
let is_source_last = frame.address.digipeaters = [] in
329
-
encode_callsign w frame.address.source ~is_last:is_source_last
330
-
~has_been_repeated:false;
349
+
let src_bytes =
350
+
encode_callsign_to_bytes frame.address.source
351
+
~is_last:(frame.address.digipeaters = [])
352
+
~has_been_repeated:false
353
+
in
354
+
Buffer.add_bytes buf src_bytes;
331
355
(* Digipeaters *)
332
356
let rec write_digis = function
333
357
| [] -> ()
334
-
| [ d ] -> encode_callsign w d ~is_last:true ~has_been_repeated:false
358
+
| [ d ] ->
359
+
Buffer.add_bytes buf
360
+
(encode_callsign_to_bytes d ~is_last:true ~has_been_repeated:false)
335
361
| d :: rest ->
336
-
encode_callsign w d ~is_last:false ~has_been_repeated:false;
362
+
Buffer.add_bytes buf
363
+
(encode_callsign_to_bytes d ~is_last:false ~has_been_repeated:false);
337
364
write_digis rest
338
365
in
339
366
write_digis frame.address.digipeaters;
340
367
(* Control *)
341
-
Writer.uint8 w (byte_of_control frame.control);
368
+
let ctrl_buf = Wire.encode_to_bytes control_typ frame.control in
369
+
Buffer.add_bytes buf ctrl_buf;
342
370
(* PID (for I and UI frames) *)
343
371
(match frame.pid with
344
-
| Some p -> Writer.uint8 w (byte_of_pid p)
372
+
| Some p ->
373
+
let pid_buf = Wire.encode_to_bytes pid_typ p in
374
+
Buffer.add_bytes buf pid_buf
345
375
| None -> ());
346
376
(* Info *)
347
-
Writer.bytes w frame.info
377
+
Buffer.add_bytes buf frame.info;
378
+
Bytes.of_string (Buffer.contents buf)
348
379
349
-
let read r =
350
-
let ensure n =
351
-
Reader.ensure r n
352
-
|> Result.map_error (fun (`Truncated { have; need }) ->
353
-
Truncated { have; need })
380
+
let read_from_bytes data =
381
+
let len = Bytes.length data in
382
+
let ensure pos n =
383
+
if pos + n <= len then Ok ()
384
+
else Error (Truncated { need = n; have = len - pos })
354
385
in
355
386
(* Need at least 14 bytes for addresses (dest + src) + 1 for control *)
356
-
let* () = ensure 15 in
387
+
let* () = ensure 0 15 in
388
+
let pos = ref 0 in
357
389
(* Destination *)
358
-
let* destination, _ = decode_callsign r ~is_digipeater:false in
390
+
let* destination, _ = decode_callsign_from_bytes data !pos in
391
+
pos := !pos + callsign_wire_size;
359
392
(* Source *)
360
-
let* source, is_last = decode_callsign r ~is_digipeater:false in
393
+
let* source, is_last = decode_callsign_from_bytes data !pos in
394
+
pos := !pos + callsign_wire_size;
361
395
(* Digipeaters (if any) *)
362
396
let rec read_digis acc =
363
-
let* () = ensure 7 in
364
-
let* digi, is_last_digi = decode_callsign r ~is_digipeater:true in
397
+
let* () = ensure !pos 7 in
398
+
let* digi, is_last_digi = decode_callsign_from_bytes data !pos in
399
+
pos := !pos + callsign_wire_size;
365
400
if is_last_digi then Ok (List.rev (digi :: acc))
366
401
else read_digis (digi :: acc)
367
402
in
368
403
let* digipeaters = if is_last then Ok [] else read_digis [] in
369
404
let address = { destination; source; digipeaters } in
370
405
(* Control *)
371
-
let* () = ensure 1 in
372
-
let control = control_of_byte (Reader.uint8 r) in
406
+
let* () = ensure !pos 1 in
407
+
let control =
408
+
match Wire.decode_bytes control_typ (Bytes.sub data !pos 1) with
409
+
| Ok c -> c
410
+
| Error _ -> control_of_byte (Bytes.get_uint8 data !pos)
411
+
in
412
+
pos := !pos + 1;
373
413
(* PID (only for I and UI frames) *)
374
414
let pid =
375
415
match control with
376
-
| UI | I _ -> (
377
-
match Reader.ensure r 1 with
378
-
| Error _ -> None
379
-
| Ok () -> Some (pid_of_byte (Reader.uint8 r)))
416
+
| UI | I _ ->
417
+
if !pos < len then (
418
+
let p =
419
+
match Wire.decode_bytes pid_typ (Bytes.sub data !pos 1) with
420
+
| Ok p -> p
421
+
| Error _ -> pid_of_byte (Bytes.get_uint8 data !pos)
422
+
in
423
+
pos := !pos + 1;
424
+
Some p)
425
+
else None
380
426
| _ -> None
381
427
in
382
428
(* Remaining is info field *)
383
-
let info_len = Reader.remaining r in
384
-
let info = if info_len > 0 then Reader.bytes r info_len else Bytes.empty in
429
+
let info_len = len - !pos in
430
+
let info =
431
+
if info_len > 0 then Bytes.sub data !pos info_len else Bytes.empty
432
+
in
385
433
Ok { address; control; pid; info }
386
434
387
435
let encode frame =
388
-
let w = Writer.create 512 in
389
-
write w frame;
390
-
let data = Writer.contents w in
436
+
let data = write_to_buf frame in
391
437
(* Append FCS *)
392
438
let fcs = crc_ccitt data in
393
439
let result = Bytes.create (Bytes.length data + 2) in
···
409
455
let fcs_actual = fcs_lo lor (fcs_hi lsl 8) in
410
456
if fcs_expected <> fcs_actual then
411
457
Error (Invalid_fcs { expected = fcs_expected; actual = fcs_actual })
412
-
else
413
-
let r = Reader.of_bytes frame_data in
414
-
read r
458
+
else read_from_bytes frame_data
415
459
416
460
(* {1 HDLC Framing}
417
461
···
529
573
let kiss_tfesc = '\xDD'
530
574
531
575
let kiss_encode frame =
532
-
let w = Writer.create 512 in
533
-
write w frame;
534
-
let data = Writer.contents w in
576
+
let data = write_to_buf frame in
535
577
(* Escape special characters *)
536
578
let buf = Buffer.create (Bytes.length data + 10) in
537
579
Buffer.add_char buf kiss_fend;
···
575
617
incr i
576
618
done;
577
619
let frame_data = Bytes.of_string (Buffer.contents buf) in
578
-
let r = Reader.of_bytes frame_data in
579
-
read r
620
+
read_from_bytes frame_data
580
621
581
622
(* {1 Helpers} *)
582
623