+2 -2

fuzz/fuzz_gpt.ml

reviewed

··· 48 48 | Error _ -> fail "failed to create partition" 49 49 in 50 50 let gpt = 51 51 - match Gpt.make ~disk_sectors:2097152L ~sector_size:512 [ p1 ] with 51 51 + match Gpt.v ~disk_sectors:2097152L ~sector_size:512 [ p1 ] with 52 52 | Ok g -> g 53 53 | Error _ -> fail "failed to create GPT" 54 54 in ··· 89 89 match p1 with 90 90 | Error _ -> () 91 91 | Ok p1 -> 92 92 - let _ = Gpt.make ~disk_sectors ~sector_size [ p1 ] in 92 92 + let _ = Gpt.v ~disk_sectors ~sector_size [ p1 ] in 93 93 () 94 94 95 95 (** CVE-2011-1776 pattern: GPT with crafted num_partition_entries. Parser must

+132 -159

lib/gpt.ml

reviewed

··· 147 147 partitions_crc32 : int32; 148 148 } 149 149 150 150 + let make_raw_header _sig revision header_size header_crc32 reserved current_lba 151 151 + backup_lba first_usable_lba last_usable_lba disk_guid partition_entry_lba 152 152 + num_partition_entries partition_size partitions_crc32 = 153 153 + { 154 154 + revision; 155 155 + header_size; 156 156 + header_crc32; 157 157 + reserved; 158 158 + current_lba; 159 159 + backup_lba; 160 160 + first_usable_lba; 161 161 + last_usable_lba; 162 162 + disk_guid; 163 163 + partition_entry_lba; 164 164 + num_partition_entries; 165 165 + partition_size; 166 166 + partitions_crc32; 167 167 + } 168 168 + 150 169 let header_codec = 151 170 let open Wire.Codec in 152 152 - record "GptHeader" 153 153 - (fun 154 154 - _sig 155 155 - revision 156 156 - header_size 157 157 - header_crc32 158 158 - reserved 159 159 - current_lba 160 160 - backup_lba 161 161 - first_usable_lba 162 162 - last_usable_lba 163 163 - disk_guid 164 164 - partition_entry_lba 165 165 - num_partition_entries 166 166 - partition_size 167 167 - partitions_crc32 168 168 - -> 169 169 - { 170 170 - revision; 171 171 - header_size; 172 172 - header_crc32; 173 173 - reserved; 174 174 - current_lba; 175 175 - backup_lba; 176 176 - first_usable_lba; 177 177 - last_usable_lba; 178 178 - disk_guid; 179 179 - partition_entry_lba; 180 180 - num_partition_entries; 181 181 - partition_size; 182 182 - partitions_crc32; 183 183 - }) 171 171 + record "GptHeader" make_raw_header 184 172 |+ field "signature" 185 173 (Wire.byte_array ~size:(Wire.int 8)) 186 174 (fun _ -> "EFI PART") ··· 219 207 partitions : Partition.t list; 220 208 } 221 209 210 210 + let pp ppf t = 211 211 + Format.fprintf ppf "@[<v>GPT rev=%lx disk=%a lba=[%Ld..%Ld] partitions=%d@]" 212 212 + t.revision Uuidm.pp t.disk_guid t.first_usable_lba t.last_usable_lba 213 213 + (List.length t.partitions) 214 214 + 222 215 let signature = "EFI PART" 223 216 224 217 let raw_header_of_t t = ··· 268 261 in 269 262 loop crc (num_partitions - List.length partitions) 270 263 271 271 - let make ?disk_guid ~disk_sectors ~sector_size partitions = 272 272 - (* Security: validate sector_size *) 273 273 - let* () = 274 274 - if sector_size < min_sector_size || sector_size > max_sector_size then 275 275 - Error 276 276 - (Printf.sprintf "sector_size %d out of range [%d, %d]" sector_size 277 277 - min_sector_size max_sector_size) 278 278 - else if sector_size land (sector_size - 1) <> 0 then 279 279 - Error (Printf.sprintf "sector_size %d must be a power of 2" sector_size) 280 280 - else Ok () 264 264 + let validate_sector_size sector_size = 265 265 + if sector_size < min_sector_size || sector_size > max_sector_size then 266 266 + Error 267 267 + (Printf.sprintf "sector_size %d out of range [%d, %d]" sector_size 268 268 + min_sector_size max_sector_size) 269 269 + else if sector_size land (sector_size - 1) <> 0 then 270 270 + Error (Printf.sprintf "sector_size %d must be a power of 2" sector_size) 271 271 + else Ok () 272 272 + 273 273 + let validate_partition_lbas ~first_usable_lba ~last_usable_lba partitions = 274 274 + List.fold_left 275 275 + (fun r p -> 276 276 + let* () = r in 277 277 + if Int64.compare p.Partition.starting_lba first_usable_lba < 0 then 278 278 + Error 279 279 + (Printf.sprintf 280 280 + "Partition starting_lba %Ld is before first_usable_lba %Ld" 281 281 + p.Partition.starting_lba first_usable_lba) 282 282 + else if Int64.compare p.Partition.ending_lba last_usable_lba > 0 then 283 283 + Error 284 284 + (Printf.sprintf "Partition ending_lba %Ld exceeds last_usable_lba %Ld" 285 285 + p.Partition.ending_lba last_usable_lba) 286 286 + else if Int64.compare p.Partition.starting_lba p.Partition.ending_lba > 0 287 287 + then 288 288 + Error 289 289 + (Printf.sprintf "Partition starting_lba %Ld > ending_lba %Ld" 290 290 + p.Partition.starting_lba p.Partition.ending_lba) 291 291 + else Ok ()) 292 292 + (Ok ()) partitions 293 293 + 294 294 + let check_partition_overlap ~first_usable_lba partitions = 295 295 + let* _last_partition_lba = 296 296 + List.fold_left 297 297 + (fun r p -> 298 298 + let* offset = r in 299 299 + if Int64.unsigned_compare offset p.Partition.starting_lba <= 0 then 300 300 + Ok p.Partition.ending_lba 301 301 + else Error "Partitions overlap") 302 302 + (Ok first_usable_lba) partitions 281 303 in 304 304 + Ok () 305 305 + 306 306 + let v ?disk_guid ~disk_sectors ~sector_size partitions = 307 307 + let* () = validate_sector_size sector_size in 282 308 (* Security: validate disk_sectors is positive *) 283 309 let* () = 284 310 if Int64.compare disk_sectors 0L <= 0 then ··· 310 336 Int64.(add partition_entry_lba (of_int partition_table_sectors)) 311 337 in 312 338 let last_usable_lba = Int64.sub disk_sectors 2L in 313 313 - (* Security: validate partition LBAs are within disk bounds *) 314 339 let* () = 315 315 - List.fold_left 316 316 - (fun r p -> 317 317 - let* () = r in 318 318 - if Int64.compare p.Partition.starting_lba first_usable_lba < 0 then 319 319 - Error 320 320 - (Printf.sprintf 321 321 - "Partition starting_lba %Ld is before first_usable_lba %Ld" 322 322 - p.Partition.starting_lba first_usable_lba) 323 323 - else if Int64.compare p.Partition.ending_lba last_usable_lba > 0 then 324 324 - Error 325 325 - (Printf.sprintf 326 326 - "Partition ending_lba %Ld exceeds last_usable_lba %Ld" 327 327 - p.Partition.ending_lba last_usable_lba) 328 328 - else if 329 329 - Int64.compare p.Partition.starting_lba p.Partition.ending_lba > 0 330 330 - then 331 331 - Error 332 332 - (Printf.sprintf "Partition starting_lba %Ld > ending_lba %Ld" 333 333 - p.Partition.starting_lba p.Partition.ending_lba) 334 334 - else Ok ()) 335 335 - (Ok ()) partitions 340 340 + validate_partition_lbas ~first_usable_lba ~last_usable_lba partitions 336 341 in 337 337 - (* Check for overlapping partitions *) 338 338 - let* _last_partition_lba = 339 339 - List.fold_left 340 340 - (fun r p -> 341 341 - let* offset = r in 342 342 - if Int64.unsigned_compare offset p.Partition.starting_lba <= 0 then 343 343 - Ok p.Partition.ending_lba 344 344 - else Error "Partitions overlap") 345 345 - (Ok first_usable_lba) partitions 346 346 - in 342 342 + let* () = check_partition_overlap ~first_usable_lba partitions in 347 343 let current_lba = 1L in 348 344 let backup_lba = Int64.sub disk_sectors 1L in 349 345 let disk_guid = ··· 379 375 let header_crc32 = Optint.to_int32 (calculate_header_crc32 header) in 380 376 Ok { header with header_crc32 } 381 377 378 378 + let validate_header_crc32 buf (raw : raw_header) = 379 379 + let header_size_int = Int32.to_int raw.header_size in 380 380 + let buf_str = Bytes.to_string buf in 381 381 + let crc32 = 382 382 + Checkseum.Crc32.digest_string buf_str 0 16 Checkseum.Crc32.default 383 383 + in 384 384 + let crc32 = Checkseum.Crc32.digest_string "\000\000\000\000" 0 4 crc32 in 385 385 + let crc32 = 386 386 + Checkseum.Crc32.digest_string buf_str 20 (header_size_int - 20) crc32 387 387 + in 388 388 + let header_crc32' = Checkseum.Crc32.to_int32 crc32 in 389 389 + if header_crc32' = raw.header_crc32 then Ok () 390 390 + else Error "Bad GPT header checksum" 391 391 + 392 392 + let parse_partition_table (raw : raw_header) num_partition_entries_int table_buf 393 393 + = 394 394 + let table_size = num_partition_entries_int * Partition.sizeof in 395 395 + if Bytes.length table_buf < table_size then 396 396 + Printf.ksprintf invalid_arg "partition table buffer too small"; 397 397 + let table_str = Bytes.sub_string table_buf 0 table_size in 398 398 + let partitions_crc32' = 399 399 + Checkseum.Crc32.digest_string table_str 0 table_size Checkseum.Crc32.default 400 400 + |> Checkseum.Crc32.to_int32 401 401 + in 402 402 + let* () = 403 403 + if Int32.equal partitions_crc32' raw.partitions_crc32 then Ok () 404 404 + else Error "Bad partition table checksum" 405 405 + in 406 406 + let rev_partitions = 407 407 + List.fold_left 408 408 + (fun acc i -> 409 409 + let entry = Partition.unmarshal table_buf (i * Partition.sizeof) in 410 410 + if Partition.is_zero_partition entry then acc else entry :: acc) 411 411 + [] 412 412 + (List.init num_partition_entries_int Fun.id) 413 413 + in 414 414 + let partitions = List.rev rev_partitions in 415 415 + (* Security: validate partition LBAs are within usable range *) 416 416 + let* () = 417 417 + validate_partition_lbas ~first_usable_lba:raw.first_usable_lba 418 418 + ~last_usable_lba:raw.last_usable_lba partitions 419 419 + in 420 420 + Ok 421 421 + { 422 422 + revision = raw.revision; 423 423 + header_size = raw.header_size; 424 424 + header_crc32 = raw.header_crc32; 425 425 + reserved = raw.reserved; 426 426 + current_lba = raw.current_lba; 427 427 + backup_lba = raw.backup_lba; 428 428 + first_usable_lba = raw.first_usable_lba; 429 429 + last_usable_lba = raw.last_usable_lba; 430 430 + disk_guid = raw.disk_guid; 431 431 + partition_entry_lba = raw.partition_entry_lba; 432 432 + num_partition_entries = raw.num_partition_entries; 433 433 + partitions; 434 434 + partition_size = raw.partition_size; 435 435 + partitions_crc32 = raw.partitions_crc32; 436 436 + } 437 437 + 382 438 let unmarshal_bytes buf ~sector_size = 383 439 if Bytes.length buf < sizeof then 384 440 Printf.ksprintf invalid_arg "GPT too small: %d < %d" (Bytes.length buf) ··· 401 457 (Printf.sprintf "Unknown revision; expected 0x10000, got 0x%08lx" 402 458 raw.revision) 403 459 in 404 404 - (* Validate header CRC32 (CRC field at offset 16 is zeroed for calculation) *) 405 405 - let* () = 406 406 - let header_size_int = Int32.to_int raw.header_size in 407 407 - let buf_str = Bytes.to_string buf in 408 408 - let crc32 = 409 409 - Checkseum.Crc32.digest_string buf_str 0 16 Checkseum.Crc32.default 410 410 - in 411 411 - let crc32 = Checkseum.Crc32.digest_string "\000\000\000\000" 0 4 crc32 in 412 412 - let crc32 = 413 413 - Checkseum.Crc32.digest_string buf_str 20 (header_size_int - 20) crc32 414 414 - in 415 415 - let header_crc32' = Checkseum.Crc32.to_int32 crc32 in 416 416 - if header_crc32' = raw.header_crc32 then Ok () 417 417 - else Error "Bad GPT header checksum" 418 418 - in 460 460 + let* () = validate_header_crc32 buf raw in 419 461 (* Security: validate LBA ordering *) 420 462 let* () = 421 463 if Int64.compare raw.first_usable_lba raw.last_usable_lba > 0 then ··· 447 489 in 448 490 Ok 449 491 ( `Read_partition_table (raw.partition_entry_lba, partition_entry_sectors), 450 450 - fun table_buf -> 451 451 - let table_size = num_partition_entries_int * Partition.sizeof in 452 452 - if Bytes.length table_buf < table_size then 453 453 - Printf.ksprintf invalid_arg "partition table buffer too small"; 454 454 - let table_str = Bytes.sub_string table_buf 0 table_size in 455 455 - let partitions_crc32' = 456 456 - Checkseum.Crc32.digest_string table_str 0 table_size 457 457 - Checkseum.Crc32.default 458 458 - |> Checkseum.Crc32.to_int32 459 459 - in 460 460 - let* () = 461 461 - if Int32.equal partitions_crc32' raw.partitions_crc32 then Ok () 462 462 - else Error "Bad partition table checksum" 463 463 - in 464 464 - let rev_partitions = 465 465 - List.fold_left 466 466 - (fun acc i -> 467 467 - let entry = 468 468 - Partition.unmarshal table_buf (i * Partition.sizeof) 469 469 - in 470 470 - if Partition.is_zero_partition entry then acc else entry :: acc) 471 471 - [] 472 472 - (List.init num_partition_entries_int Fun.id) 473 473 - in 474 474 - let partitions = List.rev rev_partitions in 475 475 - (* Security: validate partition LBAs are within usable range *) 476 476 - let* () = 477 477 - List.fold_left 478 478 - (fun r p -> 479 479 - let* () = r in 480 480 - if Int64.compare p.Partition.starting_lba raw.first_usable_lba < 0 481 481 - then 482 482 - Error 483 483 - (Printf.sprintf 484 484 - "Partition starting_lba %Ld < first_usable_lba %Ld" 485 485 - p.Partition.starting_lba raw.first_usable_lba) 486 486 - else if 487 487 - Int64.compare p.Partition.ending_lba raw.last_usable_lba > 0 488 488 - then 489 489 - Error 490 490 - (Printf.sprintf 491 491 - "Partition ending_lba %Ld > last_usable_lba %Ld" 492 492 - p.Partition.ending_lba raw.last_usable_lba) 493 493 - else if 494 494 - Int64.compare p.Partition.starting_lba p.Partition.ending_lba 495 495 - > 0 496 496 - then 497 497 - Error 498 498 - (Printf.sprintf "Partition starting_lba %Ld > ending_lba %Ld" 499 499 - p.Partition.starting_lba p.Partition.ending_lba) 500 500 - else Ok ()) 501 501 - (Ok ()) partitions 502 502 - in 503 503 - Ok 504 504 - { 505 505 - revision = raw.revision; 506 506 - header_size = raw.header_size; 507 507 - header_crc32 = raw.header_crc32; 508 508 - reserved = raw.reserved; 509 509 - current_lba = raw.current_lba; 510 510 - backup_lba = raw.backup_lba; 511 511 - first_usable_lba = raw.first_usable_lba; 512 512 - last_usable_lba = raw.last_usable_lba; 513 513 - disk_guid = raw.disk_guid; 514 514 - partition_entry_lba = raw.partition_entry_lba; 515 515 - num_partition_entries = raw.num_partition_entries; 516 516 - partitions; 517 517 - partition_size = raw.partition_size; 518 518 - partitions_crc32 = raw.partitions_crc32; 519 519 - } ) 492 492 + parse_partition_table raw num_partition_entries_int ) 520 493 521 494 let of_string s ~sector_size = unmarshal_bytes (Bytes.of_string s) ~sector_size 522 495

+6 -3

lib/gpt.mli

reviewed

··· 96 96 } 97 97 (** A GPT header with partition table. *) 98 98 99 99 - val make : 99 99 + val pp : Format.formatter -> t -> unit 100 100 + (** [pp fmt t] pretty-prints the GPT header. *) 101 101 + 102 102 + val v : 100 103 ?disk_guid:Uuidm.t -> 101 104 disk_sectors:int64 -> 102 105 sector_size:int -> 103 106 Partition.t list -> 104 107 (t, string) result 105 105 - (** [make ?disk_guid ~disk_sectors ~sector_size partitions] constructs a GPT. 106 106 - The header is written at LBA 1, partition table from LBA 2 with 128 entries. 108 108 + (** [v ?disk_guid ~disk_sectors ~sector_size partitions] constructs a GPT. The 109 109 + header is written at LBA 1, partition table from LBA 2 with 128 entries. 107 110 Returns [Error _] if partitions exceed 128 or overlap. *) 108 111 109 112 val sizeof : int

+1 -1

test/dune

reviewed

··· 1 1 (test 2 2 - (name test_gpt) 2 2 + (name test) 3 3 (libraries gpt wire alcotest fmt))

+1

test/test.ml

reviewed

··· 1 1 + let () = Alcotest.run "gpt" Test_gpt.suite

+24 -27

test/test_gpt.ml

reviewed

··· 1 1 (*let ( let* ) = Result.bind *) 2 2 3 3 - let get_ok = function 3 3 + let ok = function 4 4 | Ok x -> x 5 5 | Error s -> Alcotest.failf "expected Ok, got Error \"%S\"" s 6 6 ··· 120 120 let test_make_gpt_no_partitions () = 121 121 (* Disk needs space for: MBR + GPT header + partition table (34 sectors) 122 122 + backup partition table + backup GPT header *) 123 123 - match Gpt.make ~disk_sectors:2048L ~sector_size:512 [] with 123 123 + match Gpt.v ~disk_sectors:2048L ~sector_size:512 [] with 124 124 | Ok _ -> () 125 125 | Error e -> Alcotest.failf "Expected Ok, got %s" e 126 126 127 127 - let test_make_gpt_too_many_partitions () = 127 127 + let test_gpt_too_many_partitions () = 128 128 let type_guid = 129 129 Option.get (Uuidm.of_string "12345678-1234-1234-1234-123456789abc") 130 130 in ··· 145 145 in 146 146 (* Use a large enough disk - but it should still fail due to partition count *) 147 147 match 148 148 - Gpt.make ~disk_sectors:1000000L ~sector_size:512 (Array.to_list partitions) 148 148 + Gpt.v ~disk_sectors:1000000L ~sector_size:512 (Array.to_list partitions) 149 149 with 150 150 | Ok _ -> Alcotest.fail "Expected too many partitons error" 151 151 | Error _ -> () ··· 156 156 in 157 157 (* Create two overlapping partitions with valid LBA ranges *) 158 158 let p1 = 159 159 - get_ok 159 159 + ok 160 160 (Gpt.Partition.make ~type_guid 161 161 ~name:(name_of_ascii "Partition 1") 162 162 ~attributes:255L 2048L 4096L) 163 163 in 164 164 let p2 = 165 165 - get_ok 165 165 + ok 166 166 (Gpt.Partition.make ~type_guid 167 167 ~name:(name_of_ascii "Partition 2") 168 168 ~attributes:255L 3048L 5096L) 169 169 in 170 170 (* Use a larger disk *) 171 171 match 172 172 - ( Gpt.make ~disk_sectors:16384L ~sector_size:512 [ p1; p2 ], 173 173 - Gpt.make ~disk_sectors:16384L ~sector_size:512 [ p2; p1 ] ) 172 172 + ( Gpt.v ~disk_sectors:16384L ~sector_size:512 [ p1; p2 ], 173 173 + Gpt.v ~disk_sectors:16384L ~sector_size:512 [ p2; p1 ] ) 174 174 with 175 175 | Ok _, _ | _, Ok _ -> Alcotest.fail "Expected overlapping error" 176 176 | Error _, Error _ -> () ··· 181 181 in 182 182 (* Use a larger disk to fit partitions, and ensure ending_lba > starting_lba *) 183 183 let p1 = 184 184 - get_ok 184 184 + ok 185 185 (Gpt.Partition.make ~type_guid 186 186 ~name:(name_of_ascii "Partition 1") 187 187 ~attributes:255L 2048L 4095L) 188 188 in 189 189 let p2 = 190 190 - get_ok 190 190 + ok 191 191 (Gpt.Partition.make ~type_guid 192 192 ~name:(name_of_ascii "Partition 2") 193 193 ~attributes:255L 4096L 8191L) 194 194 in 195 195 (* Need disk large enough: partitions end at 8191, plus backup GPT *) 196 196 - let m1 = get_ok (Gpt.make ~disk_sectors:16384L ~sector_size:512 [ p1; p2 ]) in 197 197 - let m2 = get_ok (Gpt.make ~disk_sectors:16384L ~sector_size:512 [ p2; p1 ]) in 196 196 + let m1 = ok (Gpt.v ~disk_sectors:16384L ~sector_size:512 [ p1; p2 ]) in 197 197 + let m2 = ok (Gpt.v ~disk_sectors:16384L ~sector_size:512 [ p2; p1 ]) in 198 198 (* polymorphic compare :`( *) 199 199 Alcotest.( 200 200 check (list partition) "partitons equal" m1.partitions m2.partitions) ··· 205 205 in 206 206 (* Use valid partitions: ending_lba > starting_lba *) 207 207 let p1 = 208 208 - get_ok 208 208 + ok 209 209 (Gpt.Partition.make ~type_guid 210 210 ~name:(name_of_ascii "Partition 1") 211 211 ~attributes:255L 2048L 4095L) 212 212 in 213 213 let p2 = 214 214 - get_ok 214 214 + ok 215 215 (Gpt.Partition.make ~type_guid 216 216 ~name:(name_of_ascii "Partition 2") 217 217 ~attributes:255L 4096L 8191L) 218 218 in 219 219 (* Need disk large enough for partitions ending at 8191 plus backup GPT *) 220 220 - let morig = 221 221 - get_ok (Gpt.make ~disk_sectors:16384L ~sector_size:512 [ p1; p2 ]) 222 222 - in 220 220 + let morig = ok (Gpt.v ~disk_sectors:16384L ~sector_size:512 [ p1; p2 ]) in 223 221 let header_str = 224 222 Gpt.marshal_header_to_bytes ~sector_size:512 ~primary:true morig 225 223 in ··· 250 248 let gpt_header_test_collection = 251 249 [ 252 250 ("gpt-empty-partitions", `Quick, test_make_gpt_no_partitions); 253 253 - ("gpt-too-many-partitions", `Quick, test_make_gpt_too_many_partitions); 251 251 + ("gpt-too-many-partitions", `Quick, test_gpt_too_many_partitions); 254 252 ("gpt-overlapping-partitions", `Quick, test_make_gpt_overlapping_partitions); 255 253 ("gpt-sorted-partitions", `Quick, test_make_gpt_sorted_partitions); 256 254 ] ··· 273 271 Option.get (Uuidm.of_string "12345678-1234-1234-1234-123456789abc") 274 272 in 275 273 let p = 276 276 - get_ok 274 274 + ok 277 275 (Gpt.Partition.make ~type_guid 278 276 ~name:(name_of_ascii "Wire Test") 279 277 ~attributes:0x80L 2048L 4095L) ··· 343 341 ("header wire roundtrip", `Quick, test_header_wire_roundtrip); 344 342 ] 345 343 346 346 - let () = 347 347 - Alcotest.run "Ocaml Gpt" 348 348 - [ 349 349 - ("Test GPT Partitions", partition_test_collection); 350 350 - ("Test GPT Header", gpt_header_test_collection); 351 351 - ("Test GPT", gpt_test_collection); 352 352 - ("Wire", wire_test_collection); 353 353 - ] 344 344 + let suite = 345 345 + [ 346 346 + ("Test GPT Partitions", partition_test_collection); 347 347 + ("Test GPT Header", gpt_header_test_collection); 348 348 + ("Test GPT", gpt_test_collection); 349 349 + ("Wire", wire_test_collection); 350 350 + ]

+1

test/test_gpt.mli

reviewed

··· 1 1 + val suite : (string * unit Alcotest.test_case list) list