gazagnaire.org / ocaml-gpt
upstream: https://github.com/mirage/ocaml-gpt
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Port monorepo to latest ocaml-wire (opam pin)

Migrate all consumers to the new wire API:
- wire.c library → wire.3d (Wire_c → Wire_3d)
- Wire.struct_/module_ → Wire.Everparse.struct_/module_
- Wire.Codec: record/|+/seal → Codec.v with Field.v and $
- Wire.bf_uint* → Wire.U8/U16/U16be/U32/U32be
- Wire.UInt32 → Wire.Private.UInt32
- Wire.cases → Wire.lookup, Wire.map now uses labeled args
- Wire.Codec.decode now returns result
- Add wire pin to root.opam.template

Thomas Gazagnaire 1bbf83e3 d1848273

+79 -46
+68 -40
lib/gpt.ml
··· 35 35 (* Wire type helpers *) 36 36 let uuid_typ = 37 37 Wire.map 38 - (fun s -> Option.get (Uuidm.of_mixed_endian_binary_string s)) 39 - Uuidm.to_mixed_endian_binary_string 38 + ~decode:(fun s -> Option.get (Uuidm.of_mixed_endian_binary_string s)) 39 + ~encode:Uuidm.to_mixed_endian_binary_string 40 40 (Wire.byte_array ~size:(Wire.int 16)) 41 41 42 42 let uint32_as_int32 = 43 43 Wire.map 44 - (fun u -> Int32.of_int (Wire.UInt32.to_int u)) 45 - (fun i -> Wire.UInt32.of_int (Int32.to_int i)) 44 + ~decode:(fun u -> Int32.of_int (Wire.Private.UInt32.to_int u)) 45 + ~encode:(fun i -> Wire.Private.UInt32.of_int (Int32.to_int i)) 46 46 Wire.uint32 47 47 48 48 module Reader = Bytesrw.Bytes.Reader ··· 100 100 && String.for_all (Char.equal '\000') p.name 101 101 102 102 let sizeof = 128 103 + let f_type_guid = Wire.Field.v "type_guid" uuid_typ 104 + let f_partition_guid = Wire.Field.v "partition_guid" uuid_typ 105 + let f_starting_lba = Wire.Field.v "starting_lba" Wire.uint64 106 + let f_ending_lba = Wire.Field.v "ending_lba" Wire.uint64 107 + let f_attributes = Wire.Field.v "attributes" Wire.uint64 108 + let f_name = Wire.Field.v "name" (Wire.byte_array ~size:(Wire.int 72)) 103 109 104 110 let codec = 105 - let open Wire.Codec in 106 - record "GptPartition" 111 + Wire.Codec.v "GptPartition" 107 112 (fun type_guid partition_guid starting_lba ending_lba attributes name -> 108 113 { 109 114 type_guid; ··· 113 118 attributes; 114 119 name; 115 120 }) 116 - |+ field "type_guid" uuid_typ (fun t -> t.type_guid) 117 - |+ field "partition_guid" uuid_typ (fun t -> t.partition_guid) 118 - |+ field "starting_lba" Wire.uint64 (fun t -> t.starting_lba) 119 - |+ field "ending_lba" Wire.uint64 (fun t -> t.ending_lba) 120 - |+ field "attributes" Wire.uint64 (fun t -> t.attributes) 121 - |+ field "name" (Wire.byte_array ~size:(Wire.int 72)) (fun t -> t.name) 122 - |> seal 121 + Wire.Codec. 122 + [ 123 + (f_type_guid $ fun t -> t.type_guid); 124 + (f_partition_guid $ fun t -> t.partition_guid); 125 + (f_starting_lba $ fun t -> t.starting_lba); 126 + (f_ending_lba $ fun t -> t.ending_lba); 127 + (f_attributes $ fun t -> t.attributes); 128 + (f_name $ fun t -> t.name); 129 + ] 123 130 124 - let struct_ = Wire.Codec.to_struct codec 131 + let struct_ = Wire.Everparse.struct_of_codec codec 125 132 126 133 let unmarshal buf off = 127 134 if Bytes.length buf < off + sizeof then ··· 129 136 (Bytes.length buf - off) 130 137 sizeof; 131 138 Wire.Codec.decode codec buf off 139 + |> Result.map_error (Fmt.str "%a" Wire.pp_parse_error) 132 140 133 141 let marshal (buf : bytes) off t = Wire.Codec.encode codec t buf off 134 142 ··· 173 181 partition_size; 174 182 partitions_crc32; 175 183 } 184 + 185 + let f_signature = Wire.Field.v "signature" (Wire.byte_array ~size:(Wire.int 8)) 186 + let f_revision = Wire.Field.v "revision" uint32_as_int32 187 + let f_header_size = Wire.Field.v "header_size" uint32_as_int32 188 + let f_header_crc32 = Wire.Field.v "header_crc32" uint32_as_int32 189 + let f_reserved = Wire.Field.v "reserved" uint32_as_int32 190 + let f_current_lba = Wire.Field.v "current_lba" Wire.uint64 191 + let f_backup_lba = Wire.Field.v "backup_lba" Wire.uint64 192 + let f_first_usable_lba = Wire.Field.v "first_usable_lba" Wire.uint64 193 + let f_last_usable_lba = Wire.Field.v "last_usable_lba" Wire.uint64 194 + let f_disk_guid = Wire.Field.v "disk_guid" uuid_typ 195 + let f_partition_entry_lba = Wire.Field.v "partition_entry_lba" Wire.uint64 196 + 197 + let f_num_partition_entries = 198 + Wire.Field.v "num_partition_entries" uint32_as_int32 199 + 200 + let f_partition_size = Wire.Field.v "partition_size" uint32_as_int32 201 + let f_partitions_crc32 = Wire.Field.v "partitions_crc32" uint32_as_int32 176 202 177 203 let header_codec = 178 - let open Wire.Codec in 179 - record "GptHeader" raw_header 180 - |+ field "signature" 181 - (Wire.byte_array ~size:(Wire.int 8)) 182 - (fun _ -> "EFI PART") 183 - |+ field "revision" uint32_as_int32 (fun h -> h.revision) 184 - |+ field "header_size" uint32_as_int32 (fun h -> h.header_size) 185 - |+ field "header_crc32" uint32_as_int32 (fun h -> h.header_crc32) 186 - |+ field "reserved" uint32_as_int32 (fun h -> h.reserved) 187 - |+ field "current_lba" Wire.uint64 (fun h -> h.current_lba) 188 - |+ field "backup_lba" Wire.uint64 (fun h -> h.backup_lba) 189 - |+ field "first_usable_lba" Wire.uint64 (fun h -> h.first_usable_lba) 190 - |+ field "last_usable_lba" Wire.uint64 (fun h -> h.last_usable_lba) 191 - |+ field "disk_guid" uuid_typ (fun h -> h.disk_guid) 192 - |+ field "partition_entry_lba" Wire.uint64 (fun h -> h.partition_entry_lba) 193 - |+ field "num_partition_entries" uint32_as_int32 (fun h -> 194 - h.num_partition_entries) 195 - |+ field "partition_size" uint32_as_int32 (fun h -> h.partition_size) 196 - |+ field "partitions_crc32" uint32_as_int32 (fun h -> h.partitions_crc32) 197 - |> seal 204 + Wire.Codec.v "GptHeader" raw_header 205 + Wire.Codec. 206 + [ 207 + (f_signature $ fun _ -> "EFI PART"); 208 + (f_revision $ fun h -> h.revision); 209 + (f_header_size $ fun h -> h.header_size); 210 + (f_header_crc32 $ fun h -> h.header_crc32); 211 + (f_reserved $ fun h -> h.reserved); 212 + (f_current_lba $ fun h -> h.current_lba); 213 + (f_backup_lba $ fun h -> h.backup_lba); 214 + (f_first_usable_lba $ fun h -> h.first_usable_lba); 215 + (f_last_usable_lba $ fun h -> h.last_usable_lba); 216 + (f_disk_guid $ fun h -> h.disk_guid); 217 + (f_partition_entry_lba $ fun h -> h.partition_entry_lba); 218 + (f_num_partition_entries $ fun h -> h.num_partition_entries); 219 + (f_partition_size $ fun h -> h.partition_size); 220 + (f_partitions_crc32 $ fun h -> h.partitions_crc32); 221 + ] 198 222 199 - let header_struct_ = Wire.Codec.to_struct header_codec 223 + let header_struct_ = Wire.Everparse.struct_of_codec header_codec 200 224 201 225 type t = { 202 226 revision : int32; ··· 427 451 if Int32.equal partitions_crc32' raw.partitions_crc32 then Ok () 428 452 else Error "Bad partition table checksum" 429 453 in 430 - let rev_partitions = 454 + let* rev_partitions = 431 455 List.fold_left 432 456 (fun acc i -> 433 - let entry = Partition.unmarshal table_buf (i * Partition.sizeof) in 434 - if Partition.is_zero_partition entry then acc else entry :: acc) 435 - [] 457 + let* acc = acc in 458 + let* entry = Partition.unmarshal table_buf (i * Partition.sizeof) in 459 + if Partition.is_zero_partition entry then Ok acc else Ok (entry :: acc)) 460 + (Ok []) 436 461 (List.init num_partition_entries_int Fun.id) 437 462 in 438 463 let partitions = List.rev rev_partitions in ··· 491 516 if Bytes.length buf < sizeof then 492 517 Fmt.kstr invalid_arg "GPT too small: %d < %d" (Bytes.length buf) sizeof; 493 518 let* () = validate_signature buf in 494 - let raw = Wire.Codec.decode header_codec buf 0 in 519 + let* raw = 520 + Wire.Codec.decode header_codec buf 0 521 + |> Result.map_error (Fmt.str "%a" Wire.pp_parse_error) 522 + in 495 523 let* () = validate_revision raw in 496 524 let* () = validate_header_crc32 buf raw in 497 525 let* () = validate_lba_ordering raw in
+2 -2
lib/gpt.mli
··· 49 49 val codec : t Wire.Codec.t 50 50 (** Wire codec for a 128-byte GPT partition entry. *) 51 51 52 - val struct_ : Wire.struct_ 52 + val struct_ : Wire.Everparse.struct_ 53 53 (** Wire struct definition for a partition entry. *) 54 54 end 55 55 ··· 75 75 val header_codec : raw_header Wire.Codec.t 76 76 (** Wire codec for a 92-byte GPT header. *) 77 77 78 - val header_struct_ : Wire.struct_ 78 + val header_struct_ : Wire.Everparse.struct_ 79 79 (** Wire struct definition for a GPT header. *) 80 80 81 81 type t = private {
+9 -4
test/test_gpt.ml
··· 254 254 let gpt_test_collection = 255 255 [ ("gpt marshal then unmarshal", `Quick, test_marshal_unmarshal) ] 256 256 257 + let decode_exn codec buf off = 258 + match Wire.Codec.decode codec buf off with 259 + | Ok v -> v 260 + | Error e -> Alcotest.failf "decode: %a" Wire.pp_parse_error e 261 + 257 262 let test_partition_wire_size () = 258 263 Alcotest.(check int) 259 264 "partition wire_size" 128 ··· 276 281 in 277 282 let buf = Bytes.create 128 in 278 283 Wire.Codec.encode Gpt.Partition.codec p buf 0; 279 - let p' = Wire.Codec.decode Gpt.Partition.codec buf 0 in 284 + let p' = decode_exn Gpt.Partition.codec buf 0 in 280 285 Alcotest.(check bool) "type_guid" true (Uuidm.equal p.type_guid p'.type_guid); 281 286 Alcotest.(check bool) 282 287 "partition_guid" true ··· 309 314 in 310 315 let buf = Bytes.create 92 in 311 316 Wire.Codec.encode Gpt.header_codec raw buf 0; 312 - let raw' = Wire.Codec.decode Gpt.header_codec buf 0 in 317 + let raw' = decode_exn Gpt.header_codec buf 0 in 313 318 Alcotest.(check int32) "revision" raw.revision raw'.revision; 314 319 Alcotest.(check int32) "header_size" raw.header_size raw'.header_size; 315 320 Alcotest.(check int32) "header_crc32" raw.header_crc32 raw'.header_crc32; ··· 416 421 in 417 422 let buf = Bytes.create 128 in 418 423 Wire.Codec.encode Gpt.Partition.codec p buf 0; 419 - let p' = Wire.Codec.decode Gpt.Partition.codec buf 0 in 424 + let p' = decode_exn Gpt.Partition.codec buf 0 in 420 425 Alcotest.(check bool) 421 426 (Fmt.str "%s GUID survives roundtrip" label) 422 427 true ··· 480 485 let s = Mbr.to_string mbr in 481 486 let buf = Bytes.of_string s in 482 487 (* Decode the first partition entry using the wire codec *) 483 - let part = Wire.Codec.decode Mbr.Partition.codec buf 446 in 488 + let part = decode_exn Mbr.Partition.codec buf 446 in 484 489 Alcotest.(check int) "partition type 0xEE" 0xEE part.Mbr.Partition.ty; 485 490 Alcotest.(check int32) 486 491 "partition starts at LBA 1" 1l part.Mbr.Partition.first_absolute_sector_lba