Use Wire codec for all binary encoding/decoding · gazagnaire.org/ocaml-uslp@87bc36f

+384 -280

lib/uslp.ml

··· 110 110 Fmt.pf ppf "FECF mismatch: expected 0x%Lx, got 0x%Lx" expected actual 111 111 | Invalid_vcfc_len l -> Fmt.pf ppf "Invalid VCFC length: %d" l 112 112 113 - (* {1 Binary helpers} *) 113 + (* {1 Binary helpers (for OCF/FECF/VCFC only -- fixed header uses Wire codec)} *) 114 114 115 115 let u8 s i = Char.code (String.get s i) 116 116 ··· 152 152 let compute_crc16 = Crc.crc16_ccitt 153 153 let compute_crc32 = Crc.crc32 154 154 155 - (* {1 Header decoding} *) 156 - 157 - let decode_header ~vcfc_len buf = 158 - let len = String.length buf in 159 - let hdr_len = min_header_len + vcfc_len in 160 - if len < hdr_len then Error (Truncated { need = hdr_len; have = len }) 161 - else 162 - let b0 = u8 buf 0 in 163 - let tfvn = (b0 lsr 4) land 0xF in 164 - if tfvn <> tfvn_uslp then Error (Invalid_version tfvn) 165 - else 166 - let scid_hi = b0 land 0xF in 167 - let b1 = u8 buf 1 in 168 - let b2 = u8 buf 2 in 169 - let scid_mid = b1 in 170 - let scid_lo = (b2 lsr 4) land 0xF in 171 - let scid_val = (scid_hi lsl 12) lor (scid_mid lsl 4) lor scid_lo in 172 - let src_or_dest = if (b2 lsr 3) land 1 = 0 then Source else Dest in 173 - let vcid_hi = b2 land 0x7 in 174 - let b3 = u8 buf 3 in 175 - let vcid_lo = (b3 lsr 5) land 0x7 in 176 - let vcid_val = (vcid_hi lsl 3) lor vcid_lo in 177 - if vcid_val > 63 then Error (Invalid_vcid vcid_val) 178 - else 179 - let map_id_val = (b3 lsr 1) land 0xF in 180 - if map_id_val > 15 then Error (Invalid_map_id map_id_val) 181 - else 182 - let eofph = b3 land 1 = 1 in 183 - let frame_len = u16_be buf 4 in 184 - let b6 = u8 buf 6 in 185 - let bypass_flag = (b6 lsr 7) land 1 = 1 in 186 - let prot_ctrl_cmd = (b6 lsr 6) land 1 = 1 in 187 - let ocf_flag = (b6 lsr 3) land 1 = 1 in 188 - let vcfc_len_field = b6 land 0x7 in 189 - let vcfc = if vcfc_len > 0 then var_uint_be buf 7 vcfc_len else 0 in 190 - Ok 191 - { 192 - tfvn; 193 - scid = scid_val; 194 - src_or_dest; 195 - vcid = vcid_val; 196 - map_id = map_id_val; 197 - eofph; 198 - frame_len; 199 - bypass_flag; 200 - prot_ctrl_cmd; 201 - ocf_flag; 202 - vcfc_len = vcfc_len_field; 203 - vcfc; 204 - } 205 - 206 - (* {1 Frame decoding} *) 207 - 208 - let verify_fecf ~compute buf fecf_off fecf_val = 209 - let expected = compute (String.sub buf 0 fecf_off) in 210 - if expected <> fecf_val then 211 - Error 212 - (Fecf_mismatch 213 - { expected = Int64.of_int expected; actual = Int64.of_int fecf_val }) 214 - else Ok () 215 - 216 - let frame header insert_zone data ocf fecf = 217 - Ok { header; insert_zone; data; ocf; fecf } 218 - 219 - let decode_fecf ~compute ~get buf fecf_off check_fecf header insert_zone data 220 - ocf = 221 - let fecf_val = get buf fecf_off in 222 - let fecf = Some (Int64.of_int fecf_val) in 223 - if check_fecf then 224 - match verify_fecf ~compute buf fecf_off fecf_val with 225 - | Error e -> Error e 226 - | Ok () -> frame header insert_zone data ocf fecf 227 - else frame header insert_zone data ocf fecf 228 - 229 - let decode ?(vcfc_len = 0) ?(insert_zone_len = 0) ?(expect_ocf = false) 230 - ?(expect_fecf = No_fecf) ?(check_fecf = true) buf = 231 - let buf_len = String.length buf in 232 - match decode_header ~vcfc_len buf with 233 - | Error e -> Error e 234 - | Ok header -> ( 235 - let hdr_len = min_header_len + vcfc_len in 236 - let ocf_size = if expect_ocf then ocf_len else 0 in 237 - let fecf_size = 238 - match expect_fecf with No_fecf -> 0 | Crc16 -> 2 | Crc32 -> 4 239 - in 240 - (* Frame length field is total length - 1 *) 241 - let frame_len = header.frame_len + 1 in 242 - if buf_len < frame_len then 243 - Error (Truncated { need = frame_len; have = buf_len }) 244 - else 245 - let data_len = 246 - frame_len - hdr_len - insert_zone_len - ocf_size - fecf_size 247 - in 248 - if data_len < 0 then 249 - Error 250 - (Truncated 251 - { 252 - need = hdr_len + insert_zone_len + ocf_size + fecf_size; 253 - have = frame_len; 254 - }) 255 - else 256 - let insert_zone = 257 - if insert_zone_len > 0 then 258 - Some (String.sub buf hdr_len insert_zone_len) 259 - else None 260 - in 261 - let data_off = hdr_len + insert_zone_len in 262 - let data = String.sub buf data_off data_len in 263 - let ocf_off = data_off + data_len in 264 - let ocf = if ocf_size > 0 then Some (u32_be buf ocf_off) else None in 265 - let fecf_off = ocf_off + ocf_size in 266 - match expect_fecf with 267 - | No_fecf -> frame header insert_zone data ocf None 268 - | Crc16 -> 269 - decode_fecf ~compute:compute_crc16 ~get:u16_be buf fecf_off 270 - check_fecf header insert_zone data ocf 271 - | Crc32 -> 272 - decode_fecf ~compute:compute_crc32 ~get:u32_be buf fecf_off 273 - check_fecf header insert_zone data ocf) 274 - 275 - (* {1 Frame encoding} *) 276 - 277 - let encode_header buf off hdr = 278 - (* Byte 0: TFVN(4b) | SCID[15:12](4b) *) 279 - let b0 = ((hdr.tfvn land 0xF) lsl 4) lor ((hdr.scid lsr 12) land 0xF) in 280 - set_u8 buf off b0; 281 - (* Byte 1: SCID[11:4](8b) *) 282 - set_u8 buf (off + 1) ((hdr.scid lsr 4) land 0xFF); 283 - (* Byte 2: SCID[3:0](4b) | src_dest(1b) | VCID[5:3](3b) *) 284 - let src_dest_bit = match hdr.src_or_dest with Source -> 0 | Dest -> 1 in 285 - let b2 = 286 - ((hdr.scid land 0xF) lsl 4) 287 - lor (src_dest_bit lsl 3) 288 - lor ((hdr.vcid lsr 3) land 0x7) 289 - in 290 - set_u8 buf (off + 2) b2; 291 - (* Byte 3: VCID[2:0](3b) | MAP_ID(4b) | EOFPH(1b) *) 292 - let b3 = 293 - ((hdr.vcid land 0x7) lsl 5) 294 - lor ((hdr.map_id land 0xF) lsl 1) 295 - lor if hdr.eofph then 1 else 0 296 - in 297 - set_u8 buf (off + 3) b3; 298 - (* Byte 4-5: Frame Length (16b) *) 299 - set_u16_be buf (off + 4) hdr.frame_len; 300 - (* Byte 6: Bypass(1b) | PCC(1b) | Rsvd(2b) | OCF(1b) | VCFC_len(3b) *) 301 - let b6 = 302 - ((if hdr.bypass_flag then 1 else 0) lsl 7) 303 - lor ((if hdr.prot_ctrl_cmd then 1 else 0) lsl 6) 304 - lor ((if hdr.ocf_flag then 1 else 0) lsl 3) 305 - lor (hdr.vcfc_len land 0x7) 306 - in 307 - set_u8 buf (off + 6) b6; 308 - (* Bytes 7+: VCFC *) 309 - if hdr.vcfc_len > 0 then set_var_uint_be buf (off + 7) hdr.vcfc_len hdr.vcfc 310 - 311 - let encode ?(insert_zone_len = 0) ?(with_ocf = false) ?(fecf = No_fecf) frame = 312 - let ocf_size = if with_ocf then ocf_len else 0 in 313 - let fecf_size = match fecf with No_fecf -> 0 | Crc16 -> 2 | Crc32 -> 4 in 314 - let hdr_len = min_header_len + frame.header.vcfc_len in 315 - let data_len = String.length frame.data in 316 - let total_len = hdr_len + insert_zone_len + data_len + ocf_size + fecf_size in 317 - let buf = Bytes.make total_len '\000' in 318 - (* Update frame_len in header (total - 1) *) 319 - let header = 320 - { frame.header with frame_len = total_len - 1; ocf_flag = with_ocf } 321 - in 322 - (* Header *) 323 - encode_header buf 0 header; 324 - (* Insert Zone *) 325 - (match frame.insert_zone with 326 - | Some iz when insert_zone_len > 0 -> 327 - let copy_len = min (String.length iz) insert_zone_len in 328 - Bytes.blit_string iz 0 buf hdr_len copy_len 329 - | _ -> ()); 330 - (* Data *) 331 - Bytes.blit_string frame.data 0 buf (hdr_len + insert_zone_len) data_len; 332 - (* OCF *) 333 - (if with_ocf then 334 - let ocf_off = hdr_len + insert_zone_len + data_len in 335 - match frame.ocf with Some ocf -> set_u32_be buf ocf_off ocf | None -> ()); 336 - (* FECF *) 337 - let fecf_off = hdr_len + insert_zone_len + data_len + ocf_size in 338 - (match fecf with 339 - | No_fecf -> () 340 - | Crc16 -> 341 - let crc = compute_crc16 (Bytes.sub_string buf 0 fecf_off) in 342 - set_u16_be buf fecf_off crc 343 - | Crc32 -> 344 - let crc = compute_crc32 (Bytes.sub_string buf 0 fecf_off) in 345 - set_u32_be buf fecf_off crc); 346 - Bytes.to_string buf 347 - 348 - let encoded_len ?(insert_zone_len = 0) ?(with_ocf = false) ?(fecf = No_fecf) 349 - frame = 350 - let ocf_size = if with_ocf then ocf_len else 0 in 351 - let fecf_size = match fecf with No_fecf -> 0 | Crc16 -> 2 | Crc32 -> 4 in 352 - let hdr_len = min_header_len + frame.header.vcfc_len in 353 - hdr_len + insert_zone_len + String.length frame.data + ocf_size + fecf_size 354 - 355 - (* {1 Predicates} *) 356 - 357 - let is_idle frame = vcid_to_int frame.header.vcid = idle_vcid 358 - 359 - (* {1 Pretty-printing} *) 360 - 361 - let pp_src_or_dest ppf = function 362 - | Source -> Fmt.pf ppf "Source" 363 - | Dest -> Fmt.pf ppf "Dest" 364 - 365 - let pp_header ppf (hdr : header) = 366 - Fmt.pf ppf 367 - "@[<hv 2>{ tfvn=%d;@ scid=%d;@ %a;@ vcid=%d;@ map_id=%d;@ vcfc=%d }@]" 368 - hdr.tfvn hdr.scid pp_src_or_dest hdr.src_or_dest hdr.vcid hdr.map_id 369 - hdr.vcfc 370 - 371 - let pp ppf (frame : t) = 372 - Fmt.pf ppf "@[<v 2>USLP_frame %a@ data[%d bytes]%a%a%a@]" pp_header 373 - frame.header (String.length frame.data) 374 - (fun ppf -> function 375 - | Some iz -> Fmt.pf ppf "@ insert_zone[%d bytes]" (String.length iz) 376 - | None -> ()) 377 - frame.insert_zone 378 - (fun ppf -> function 379 - | Some ocf -> Fmt.pf ppf "@ ocf=0x%08X" ocf | None -> ()) 380 - frame.ocf 381 - (fun ppf -> function Some f -> Fmt.pf ppf "@ fecf=0x%Lx" f | None -> ()) 382 - frame.fecf 383 - 384 - let equal_header (a : header) (b : header) = 385 - a.tfvn = b.tfvn && a.scid = b.scid 386 - && a.src_or_dest = b.src_or_dest 387 - && a.vcid = b.vcid && a.map_id = b.map_id && a.eofph = b.eofph 388 - && a.bypass_flag = b.bypass_flag 389 - && a.prot_ctrl_cmd = b.prot_ctrl_cmd 390 - && a.vcfc_len = b.vcfc_len && a.vcfc = b.vcfc 391 - 392 - let equal a b = 393 - let ocf_equal o1 o2 = 394 - match (o1, o2) with 395 - | None, None -> true 396 - | Some x, Some y -> x = y 397 - | None, Some 0 | Some 0, None -> true 398 - | _ -> false 399 - in 400 - equal_header a.header b.header 401 - && a.insert_zone = b.insert_zone 402 - && a.data = b.data && ocf_equal a.ocf b.ocf 155 + (* {1 Packed Header Wire Representation} 403 156 404 - (* {1 Packed Header Wire Representation} *) 157 + Moved before frame decoding/encoding so decode_header and encode_header are 158 + available. *) 405 159 406 160 type packed_header = { 407 161 tfvn : int; ··· 426 180 && a.prot_ctrl_cmd = b.prot_ctrl_cmd 427 181 && a.ocf_flag = b.ocf_flag && a.vcfc_len = b.vcfc_len 428 182 429 - (* Wire Codec *) 183 + (* {1 Wire Fields} 184 + 185 + Raw Wire field definitions (Wire.Field.t) — shared between header codec 186 + and full-frame codec. *) 187 + 188 + let bits32 n = Wire.bits ~width:n Wire.U32be 189 + let bits8 n = Wire.bits ~width:n Wire.U8 190 + let bool32 = Wire.bool (bits32 1) 191 + let bool8 = Wire.bool (bits8 1) 192 + let src_dest_typ = Wire.lookup [ Source; Dest ] (bits32 1) 193 + let w_tfvn = Wire.Field.v "tfvn" (bits32 4) 194 + let w_scid = Wire.Field.v "scid" (bits32 16) 195 + let w_src_or_dest = Wire.Field.v "src_or_dest" src_dest_typ 196 + let w_vcid = Wire.Field.v "vcid" (bits32 6) 197 + let w_map_id = Wire.Field.v "map_id" (bits32 4) 198 + let w_eofph = Wire.Field.v "eofph" bool32 199 + let w_frame_len = Wire.Field.v "frame_len" Wire.uint16be 200 + let w_bypass_flag = Wire.Field.v "bypass_flag" bool8 201 + let w_prot_ctrl_cmd = Wire.Field.v "prot_ctrl_cmd" bool8 202 + let w_ocf_flag = Wire.Field.v "ocf_flag" bool8 203 + let w_vcfc_len = Wire.Field.v "vcfc_len" (bits8 3) 204 + let w_data_zone = Wire.Field.v "data_zone" Wire.all_bytes 205 + 206 + (* {1 Header Wire Codec} *) 207 + 208 + let f_tfvn = Wire.Codec.(w_tfvn $ fun t -> t.tfvn) 209 + let f_scid = Wire.Codec.(w_scid $ fun t -> t.scid) 210 + let f_src_or_dest = Wire.Codec.(w_src_or_dest $ fun t -> t.src_or_dest) 211 + let f_vcid = Wire.Codec.(w_vcid $ fun t -> t.vcid) 212 + let f_map_id = Wire.Codec.(w_map_id $ fun t -> t.map_id) 213 + let f_eofph = Wire.Codec.(w_eofph $ fun t -> t.eofph) 214 + let f_frame_len = Wire.Codec.(w_frame_len $ fun t -> t.frame_len) 215 + let f_bypass_flag = Wire.Codec.(w_bypass_flag $ fun t -> t.bypass_flag) 216 + let f_prot_ctrl_cmd = Wire.Codec.(w_prot_ctrl_cmd $ fun t -> t.prot_ctrl_cmd) 217 + let f_reserved = Wire.Codec.(Wire.Field.v "reserved" (bits8 2) $ fun _ -> 0) 218 + let f_ocf_flag = Wire.Codec.(w_ocf_flag $ fun t -> t.ocf_flag) 219 + let f_vcfc_len = Wire.Codec.(w_vcfc_len $ fun t -> t.vcfc_len) 220 + 430 221 let codec = 431 - let bits32 n = Wire.bits ~width:n Wire.U32be in 432 - let bits8 n = Wire.bits ~width:n Wire.U8 in 433 - let bool32 = Wire.bool (bits32 1) in 434 - let bool8 = Wire.bool (bits8 1) in 435 - let src_dest = Wire.lookup [ Source; Dest ] (bits32 1) in 436 - let f_tfvn = Wire.Field.v "tfvn" (bits32 4) in 437 - let f_scid = Wire.Field.v "scid" (bits32 16) in 438 - let f_src_or_dest = Wire.Field.v "src_or_dest" src_dest in 439 - let f_vcid = Wire.Field.v "vcid" (bits32 6) in 440 - let f_map_id = Wire.Field.v "map_id" (bits32 4) in 441 - let f_eofph = Wire.Field.v "eofph" bool32 in 442 - let f_frame_len = Wire.Field.v "frame_len" Wire.uint16be in 443 - let f_bypass_flag = Wire.Field.v "bypass_flag" bool8 in 444 - let f_prot_ctrl_cmd = Wire.Field.v "prot_ctrl_cmd" bool8 in 445 - let f_reserved = Wire.Field.v "reserved" (bits8 2) in 446 - let f_ocf_flag = Wire.Field.v "ocf_flag" bool8 in 447 - let f_vcfc_len = Wire.Field.v "vcfc_len" (bits8 3) in 448 222 Wire.Codec.v "UslpHeader" 449 223 (fun tfvn scid sd vcid map_id eofph flen bypass pcc _rsvd ocf vcfc_len -> 450 224 { ··· 462 236 }) 463 237 Wire.Codec. 464 238 [ 465 - (f_tfvn $ fun t -> t.tfvn); 466 - (f_scid $ fun t -> t.scid); 467 - (f_src_or_dest $ fun t -> t.src_or_dest); 468 - (f_vcid $ fun t -> t.vcid); 469 - (f_map_id $ fun t -> t.map_id); 470 - (f_eofph $ fun t -> t.eofph); 471 - (f_frame_len $ fun t -> t.frame_len); 472 - (f_bypass_flag $ fun t -> t.bypass_flag); 473 - (f_prot_ctrl_cmd $ fun t -> t.prot_ctrl_cmd); 474 - (f_reserved $ fun _ -> 0); 475 - (f_ocf_flag $ fun t -> t.ocf_flag); 476 - (f_vcfc_len $ fun t -> t.vcfc_len); 239 + f_tfvn; 240 + f_scid; 241 + f_src_or_dest; 242 + f_vcid; 243 + f_map_id; 244 + f_eofph; 245 + f_frame_len; 246 + f_bypass_flag; 247 + f_prot_ctrl_cmd; 248 + f_reserved; 249 + f_ocf_flag; 250 + f_vcfc_len; 477 251 ] 478 252 253 + (* {1 Full-frame Wire Codec} 254 + 255 + The frame codec models the entire USLP frame (header + data zone). The 256 + fixed 7-byte header is parsed by the existing Wire codec; the data zone 257 + (all remaining bytes after the header + variable VCFC) is captured and 258 + then post-processed to extract: insert_zone + data + optional OCF + 259 + optional FECF. *) 260 + 261 + type packed_frame = { 262 + pf_tfvn : int; 263 + pf_scid : int; 264 + pf_src_or_dest : src_or_dest; 265 + pf_vcid : int; 266 + pf_map_id : int; 267 + pf_eofph : bool; 268 + pf_frame_len : int; 269 + pf_bypass_flag : bool; 270 + pf_prot_ctrl_cmd : bool; 271 + pf_ocf_flag : bool; 272 + pf_vcfc_len : int; 273 + pf_vcfc : int; 274 + pf_data_zone : string; 275 + } 276 + 277 + let f_data_zone = Wire.Codec.(w_data_zone $ fun t -> t.pf_data_zone) 278 + 279 + let decode_packed_frame ~vcfc_len buf = 280 + let len = String.length buf in 281 + let hdr_len = min_header_len + vcfc_len in 282 + if len < hdr_len then 283 + Error (Wire.Unexpected_eof { expected = hdr_len; got = len }) 284 + else 285 + let bytes_buf = Bytes.unsafe_of_string buf in 286 + match Wire.Codec.decode codec bytes_buf 0 with 287 + | Error e -> Error e 288 + | Ok packed -> 289 + let vcfc = if vcfc_len > 0 then var_uint_be buf 7 vcfc_len else 0 in 290 + let data_zone = String.sub buf hdr_len (len - hdr_len) in 291 + Ok 292 + { 293 + pf_tfvn = packed.tfvn; 294 + pf_scid = packed.scid; 295 + pf_src_or_dest = packed.src_or_dest; 296 + pf_vcid = packed.vcid; 297 + pf_map_id = packed.map_id; 298 + pf_eofph = packed.eofph; 299 + pf_frame_len = packed.frame_len; 300 + pf_bypass_flag = packed.bypass_flag; 301 + pf_prot_ctrl_cmd = packed.prot_ctrl_cmd; 302 + pf_ocf_flag = packed.ocf_flag; 303 + pf_vcfc_len = packed.vcfc_len; 304 + pf_vcfc = vcfc; 305 + pf_data_zone = data_zone; 306 + } 307 + 308 + let encode_packed_frame pf = 309 + let packed : packed_header = 310 + { 311 + tfvn = pf.pf_tfvn; 312 + scid = pf.pf_scid; 313 + src_or_dest = pf.pf_src_or_dest; 314 + vcid = pf.pf_vcid; 315 + map_id = pf.pf_map_id; 316 + eofph = pf.pf_eofph; 317 + frame_len = pf.pf_frame_len; 318 + bypass_flag = pf.pf_bypass_flag; 319 + prot_ctrl_cmd = pf.pf_prot_ctrl_cmd; 320 + ocf_flag = pf.pf_ocf_flag; 321 + vcfc_len = pf.pf_vcfc_len; 322 + } 323 + in 324 + let hdr_len = min_header_len + pf.pf_vcfc_len in 325 + let buf = Bytes.create hdr_len in 326 + Wire.Codec.encode codec packed buf 0; 327 + if pf.pf_vcfc_len > 0 then set_var_uint_be buf 7 pf.pf_vcfc_len pf.pf_vcfc; 328 + Bytes.unsafe_to_string buf ^ pf.pf_data_zone 329 + 479 330 let struct_ = Wire.Everparse.struct_of_codec codec 480 331 481 332 let module_ = ··· 551 402 (* FFI Code Generation *) 552 403 let c_stubs () = Wire_stubs.to_c_stubs [ struct_ ] 553 404 let ml_stubs () = Wire_stubs.to_ml_stubs [ struct_ ] 405 + 406 + (* {1 Header decoding via Wire codec} *) 407 + 408 + let decode_header ~vcfc_len buf = 409 + let len = String.length buf in 410 + let hdr_len = min_header_len + vcfc_len in 411 + if len < hdr_len then Error (Truncated { need = hdr_len; have = len }) 412 + else 413 + let bytes_buf = Bytes.unsafe_of_string buf in 414 + match Wire.Codec.decode codec bytes_buf 0 with 415 + | Error (Wire.Invalid_tag v) -> Error (Invalid_version v) 416 + | Error _ -> Error (Truncated { need = min_header_len; have = len }) 417 + | Ok packed -> ( 418 + if packed.tfvn <> tfvn_uslp then Error (Invalid_version packed.tfvn) 419 + else if packed.vcid > 63 then Error (Invalid_vcid packed.vcid) 420 + else if packed.map_id > 15 then Error (Invalid_map_id packed.map_id) 421 + else 422 + match of_packed_header packed with 423 + | Error `Invalid_scid -> Error (Invalid_scid packed.scid) 424 + | Error `Invalid_vcid -> Error (Invalid_vcid packed.vcid) 425 + | Error `Invalid_map_id -> Error (Invalid_map_id packed.map_id) 426 + | Ok header -> 427 + (* Read variable-length VCFC after the fixed header *) 428 + let vcfc = 429 + if vcfc_len > 0 then var_uint_be buf 7 vcfc_len else 0 430 + in 431 + Ok { header with vcfc }) 432 + 433 + (* {1 Frame decoding using full-frame Wire codec} 434 + 435 + The header is decoded via the Wire codec + VCFC extraction, then the data 436 + zone (all remaining bytes) is captured and post-processed to extract: 437 + insert_zone + data + optional OCF + optional FECF. *) 438 + 439 + let verify_fecf ~compute buf fecf_off fecf_val = 440 + let expected = compute (String.sub buf 0 fecf_off) in 441 + if expected <> fecf_val then 442 + Error 443 + (Fecf_mismatch 444 + { expected = Int64.of_int expected; actual = Int64.of_int fecf_val }) 445 + else Ok () 446 + 447 + let frame header insert_zone data ocf fecf = 448 + Ok { header; insert_zone; data; ocf; fecf } 449 + 450 + let decode_fecf ~compute ~get buf fecf_off check_fecf header insert_zone data 451 + ocf = 452 + let fecf_val = get buf fecf_off in 453 + let fecf = Some (Int64.of_int fecf_val) in 454 + if check_fecf then 455 + match verify_fecf ~compute buf fecf_off fecf_val with 456 + | Error e -> Error e 457 + | Ok () -> frame header insert_zone data ocf fecf 458 + else frame header insert_zone data ocf fecf 459 + 460 + let decode ?(vcfc_len = 0) ?(insert_zone_len = 0) ?(expect_ocf = false) 461 + ?(expect_fecf = No_fecf) ?(check_fecf = true) buf = 462 + let buf_len = String.length buf in 463 + match decode_packed_frame ~vcfc_len buf with 464 + | Error (Wire.Invalid_tag v) -> Error (Invalid_version v) 465 + | Error _ -> 466 + let hdr_len = min_header_len + vcfc_len in 467 + Error (Truncated { need = hdr_len; have = buf_len }) 468 + | Ok pf -> ( 469 + if pf.pf_tfvn <> tfvn_uslp then Error (Invalid_version pf.pf_tfvn) 470 + else if pf.pf_vcid > 63 then Error (Invalid_vcid pf.pf_vcid) 471 + else if pf.pf_map_id > 15 then Error (Invalid_map_id pf.pf_map_id) 472 + else 473 + match 474 + of_packed_header 475 + { 476 + tfvn = pf.pf_tfvn; 477 + scid = pf.pf_scid; 478 + src_or_dest = pf.pf_src_or_dest; 479 + vcid = pf.pf_vcid; 480 + map_id = pf.pf_map_id; 481 + eofph = pf.pf_eofph; 482 + frame_len = pf.pf_frame_len; 483 + bypass_flag = pf.pf_bypass_flag; 484 + prot_ctrl_cmd = pf.pf_prot_ctrl_cmd; 485 + ocf_flag = pf.pf_ocf_flag; 486 + vcfc_len = pf.pf_vcfc_len; 487 + } 488 + with 489 + | Error `Invalid_scid -> Error (Invalid_scid pf.pf_scid) 490 + | Error `Invalid_vcid -> Error (Invalid_vcid pf.pf_vcid) 491 + | Error `Invalid_map_id -> Error (Invalid_map_id pf.pf_map_id) 492 + | Ok header -> ( 493 + let header = { header with vcfc = pf.pf_vcfc } in 494 + let hdr_len = min_header_len + vcfc_len in 495 + let data_zone = pf.pf_data_zone in 496 + let ocf_size = if expect_ocf then ocf_len else 0 in 497 + let fecf_size = 498 + match expect_fecf with No_fecf -> 0 | Crc16 -> 2 | Crc32 -> 4 499 + in 500 + (* Frame length field is total length - 1 *) 501 + let frame_len = header.frame_len + 1 in 502 + if buf_len < frame_len then 503 + Error (Truncated { need = frame_len; have = buf_len }) 504 + else 505 + let dz_len = frame_len - hdr_len in 506 + let data_len = dz_len - insert_zone_len - ocf_size - fecf_size in 507 + if data_len < 0 then 508 + Error 509 + (Truncated 510 + { 511 + need = hdr_len + insert_zone_len + ocf_size + fecf_size; 512 + have = frame_len; 513 + }) 514 + else 515 + let insert_zone = 516 + if insert_zone_len > 0 then 517 + Some (String.sub data_zone 0 insert_zone_len) 518 + else None 519 + in 520 + let data_off = insert_zone_len in 521 + let data = String.sub data_zone data_off data_len in 522 + let ocf_off = data_off + data_len in 523 + let ocf = 524 + if ocf_size > 0 then Some (u32_be data_zone ocf_off) else None 525 + in 526 + let fecf_off = ocf_off + ocf_size in 527 + match expect_fecf with 528 + | No_fecf -> frame header insert_zone data ocf None 529 + | Crc16 -> 530 + decode_fecf ~compute:compute_crc16 ~get:u16_be buf 531 + (hdr_len + fecf_off) check_fecf header insert_zone data 532 + ocf 533 + | Crc32 -> 534 + decode_fecf ~compute:compute_crc32 ~get:u32_be buf 535 + (hdr_len + fecf_off) check_fecf header insert_zone data 536 + ocf)) 537 + 538 + (* {1 Frame encoding using full-frame Wire codec} *) 539 + 540 + let encode_header buf off hdr = 541 + (* Encode fixed 7-byte header via Wire codec *) 542 + let packed = to_packed_header hdr in 543 + Wire.Codec.encode codec packed buf off; 544 + (* Encode variable-length VCFC after the fixed header *) 545 + if hdr.vcfc_len > 0 then set_var_uint_be buf (off + 7) hdr.vcfc_len hdr.vcfc 546 + 547 + let encode ?(insert_zone_len = 0) ?(with_ocf = false) ?(fecf = No_fecf) frame = 548 + let ocf_size = if with_ocf then ocf_len else 0 in 549 + let fecf_size = match fecf with No_fecf -> 0 | Crc16 -> 2 | Crc32 -> 4 in 550 + let data_len = String.length frame.data in 551 + let dz_len = insert_zone_len + data_len + ocf_size + fecf_size in 552 + let data_zone = Bytes.make dz_len '\000' in 553 + (* Insert Zone *) 554 + (match frame.insert_zone with 555 + | Some iz when insert_zone_len > 0 -> 556 + let copy_len = min (String.length iz) insert_zone_len in 557 + Bytes.blit_string iz 0 data_zone 0 copy_len 558 + | _ -> ()); 559 + (* Data *) 560 + Bytes.blit_string frame.data 0 data_zone insert_zone_len data_len; 561 + (* OCF *) 562 + (if with_ocf then 563 + let ocf_off = insert_zone_len + data_len in 564 + match frame.ocf with 565 + | Some ocf -> set_u32_be data_zone ocf_off ocf 566 + | None -> ()); 567 + (* Build packed frame and encode *) 568 + let hdr_len = min_header_len + frame.header.vcfc_len in 569 + let total_len = hdr_len + dz_len in 570 + let pf = 571 + { 572 + pf_tfvn = frame.header.tfvn; 573 + pf_scid = scid_to_int frame.header.scid; 574 + pf_src_or_dest = frame.header.src_or_dest; 575 + pf_vcid = vcid_to_int frame.header.vcid; 576 + pf_map_id = map_id_to_int frame.header.map_id; 577 + pf_eofph = frame.header.eofph; 578 + pf_frame_len = total_len - 1; 579 + pf_bypass_flag = frame.header.bypass_flag; 580 + pf_prot_ctrl_cmd = frame.header.prot_ctrl_cmd; 581 + pf_ocf_flag = with_ocf; 582 + pf_vcfc_len = frame.header.vcfc_len; 583 + pf_vcfc = frame.header.vcfc; 584 + pf_data_zone = Bytes.unsafe_to_string data_zone; 585 + } 586 + in 587 + let result = encode_packed_frame pf in 588 + (* FECF — computed over the entire frame minus the FECF itself *) 589 + let fecf_off = total_len - fecf_size in 590 + match fecf with 591 + | No_fecf -> result 592 + | Crc16 -> 593 + let crc = compute_crc16 (String.sub result 0 fecf_off) in 594 + let buf = Bytes.of_string result in 595 + set_u16_be buf fecf_off crc; 596 + Bytes.to_string buf 597 + | Crc32 -> 598 + let crc = compute_crc32 (String.sub result 0 fecf_off) in 599 + let buf = Bytes.of_string result in 600 + set_u32_be buf fecf_off crc; 601 + Bytes.to_string buf 602 + 603 + let encoded_len ?(insert_zone_len = 0) ?(with_ocf = false) ?(fecf = No_fecf) 604 + frame = 605 + let ocf_size = if with_ocf then ocf_len else 0 in 606 + let fecf_size = match fecf with No_fecf -> 0 | Crc16 -> 2 | Crc32 -> 4 in 607 + let hdr_len = min_header_len + frame.header.vcfc_len in 608 + hdr_len + insert_zone_len + String.length frame.data + ocf_size + fecf_size 609 + 610 + (* {1 Predicates} *) 611 + 612 + let is_idle frame = vcid_to_int frame.header.vcid = idle_vcid 613 + 614 + (* {1 Pretty-printing} *) 615 + 616 + let pp_src_or_dest ppf = function 617 + | Source -> Fmt.pf ppf "Source" 618 + | Dest -> Fmt.pf ppf "Dest" 619 + 620 + let pp_header ppf (hdr : header) = 621 + Fmt.pf ppf 622 + "@[<hv 2>{ tfvn=%d;@ scid=%d;@ %a;@ vcid=%d;@ map_id=%d;@ vcfc=%d }@]" 623 + hdr.tfvn hdr.scid pp_src_or_dest hdr.src_or_dest hdr.vcid hdr.map_id 624 + hdr.vcfc 625 + 626 + let pp ppf (frame : t) = 627 + Fmt.pf ppf "@[<v 2>USLP_frame %a@ data[%d bytes]%a%a%a@]" pp_header 628 + frame.header (String.length frame.data) 629 + (fun ppf -> function 630 + | Some iz -> Fmt.pf ppf "@ insert_zone[%d bytes]" (String.length iz) 631 + | None -> ()) 632 + frame.insert_zone 633 + (fun ppf -> function 634 + | Some ocf -> Fmt.pf ppf "@ ocf=0x%08X" ocf | None -> ()) 635 + frame.ocf 636 + (fun ppf -> function Some f -> Fmt.pf ppf "@ fecf=0x%Lx" f | None -> ()) 637 + frame.fecf 638 + 639 + let equal_header (a : header) (b : header) = 640 + a.tfvn = b.tfvn && a.scid = b.scid 641 + && a.src_or_dest = b.src_or_dest 642 + && a.vcid = b.vcid && a.map_id = b.map_id && a.eofph = b.eofph 643 + && a.bypass_flag = b.bypass_flag 644 + && a.prot_ctrl_cmd = b.prot_ctrl_cmd 645 + && a.vcfc_len = b.vcfc_len && a.vcfc = b.vcfc 646 + 647 + let equal a b = 648 + let ocf_equal o1 o2 = 649 + match (o1, o2) with 650 + | None, None -> true 651 + | Some x, Some y -> x = y 652 + | None, Some 0 | Some 0, None -> true 653 + | _ -> false 654 + in 655 + equal_header a.header b.header 656 + && a.insert_zone = b.insert_zone 657 + && a.data = b.data && ocf_equal a.ocf b.ocf 554 658 555 659 (* {1 Constructors} *) 556 660

+52

lib/uslp.mli

··· 245 245 246 246 val codec : packed_header Wire.Codec.t 247 247 248 + (** {1 Full-frame Wire Codec} 249 + 250 + The frame codec models the entire USLP frame (header + data zone). The fixed 251 + 7-byte header is parsed by the existing Wire codec; the data zone captures 252 + all remaining bytes after the header + variable VCFC. Post-processing then 253 + splits the data zone into: insert_zone + data + optional OCF + optional 254 + FECF. *) 255 + 256 + type packed_frame = { 257 + pf_tfvn : int; 258 + pf_scid : int; 259 + pf_src_or_dest : src_or_dest; 260 + pf_vcid : int; 261 + pf_map_id : int; 262 + pf_eofph : bool; 263 + pf_frame_len : int; 264 + pf_bypass_flag : bool; 265 + pf_prot_ctrl_cmd : bool; 266 + pf_ocf_flag : bool; 267 + pf_vcfc_len : int; 268 + pf_vcfc : int; 269 + pf_data_zone : string; 270 + } 271 + (** USLP frame with header fields and raw data zone. *) 272 + 273 + val f_data_zone : (string, packed_frame) Wire.Codec.field 274 + (** Data zone field handle. *) 275 + 276 + val decode_packed_frame : 277 + vcfc_len:int -> string -> (packed_frame, Wire.parse_error) result 278 + (** Decode a full USLP frame into header fields + raw data zone. *) 279 + 280 + val encode_packed_frame : packed_frame -> string 281 + (** Encode a packed frame (header + data zone) to a string. *) 282 + 248 283 val struct_ : Wire.Everparse.struct_ 249 284 (** Wire struct definition for a USLP header. *) 250 285 251 286 val module_ : Wire.Everparse.module_ 252 287 (** Wire module definition for USLP. *) 288 + 289 + (** {1 Wire Fields} 290 + 291 + Bound field handles for zero-copy access via {!Wire.Codec.get} / 292 + {!Wire.Codec.set} and batch bitfield reads via {!Wire.Codec.bitfield}. *) 293 + 294 + val f_tfvn : (int, packed_header) Wire.Codec.field 295 + val f_scid : (int, packed_header) Wire.Codec.field 296 + val f_src_or_dest : (src_or_dest, packed_header) Wire.Codec.field 297 + val f_vcid : (int, packed_header) Wire.Codec.field 298 + val f_map_id : (int, packed_header) Wire.Codec.field 299 + val f_eofph : (bool, packed_header) Wire.Codec.field 300 + val f_frame_len : (int, packed_header) Wire.Codec.field 301 + val f_bypass_flag : (bool, packed_header) Wire.Codec.field 302 + val f_prot_ctrl_cmd : (bool, packed_header) Wire.Codec.field 303 + val f_ocf_flag : (bool, packed_header) Wire.Codec.field 304 + val f_vcfc_len : (int, packed_header) Wire.Codec.field 253 305 254 306 (** {1 Wire Parse/Encode} *) 255 307

+1 -2

test/test_uslp.ml

··· 53 53 let scid = Uslp.scid_exn 300 in 54 54 let vcid = Uslp.vcid_exn 3 in 55 55 let map_id = Uslp.map_id_exn 0 in 56 - let clcw_vcid = Clcw.vcid_exn 3 in 57 - let clcw = Clcw.v ~vcid:clcw_vcid ~report_value:99 () in 56 + let clcw = Clcw.v ~vcid:3 ~report_value:99 () in 58 57 let frame = 59 58 Uslp.with_clcw ~scid ~vcid ~map_id ~vcfc:0 ~vcfc_len:0 ~clcw "CLCW test" 60 59 in

Configure Feed

Configure Feed