gazagnaire.org / ocaml-btree
Pure OCaml B-tree implementation for persistent storage
0
fork

Configure Feed

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

Add CVE-inspired hostile-input tests across 10 packages

160 new tests exercising security-critical code paths identified by
mapping known CVEs from C/reference implementations to our OCaml code:

- ocaml-sqlite (9): cyclic pages, oversized varints, record overflow,
wrong page kind, truncated WAL, out-of-bounds root, garbage files
- ocaml-cbort (12): deep nesting (CVE-2025-24302), indefinite-length
DoS, integer overflow in lengths, truncated input, invalid types
- ocaml-tar (10): path traversal (CVE-2021-32803), symlink escape
(CVE-2025-45582), oversized octal, truncated headers, checksum
- ocaml-http (14): CRLF header injection (CWE-113), null bytes,
Content-Length overflow, empty/duplicate headers
Also hardens validate_header_name_str to reject null bytes/empty names
- ocaml-jsonwt (21): "none" algorithm bypass (CVE-2015-9235) case
variations, algorithm confusion (CVE-2016-10555), malformed headers,
empty segments, extra dots, large payloads
- ocaml-cose (8): algorithm substitution, missing algorithm header,
malformed CBOR, wrong types, label overlap (RFC 9052)
- ocaml-git (18): tree path traversal, null bytes, symlink mode,
malformed tree data, pack delta attacks, pack format validation
- ocaml-tomlt (25): duplicate keys, integer overflow, malformed dates
(invalid month/day/hour/minute), deep nesting, long strings
- ocaml-squashfs (20): symlink traversal edge cases, fragment table
bounds, inode self-reference, compression bomb limits, bad superblock
- ocaml-cpio (23): symlink target validation, null bytes in filenames,
oversized filesize, truncated archives, invalid magic numbers

Thomas Gazagnaire dceade7a 04399d72

+64 -42
+33 -22
lib/index.ml
··· 22 22 let read_overflow_chain pager first_page ~remaining_size = 23 23 let usable = Pager.page_size pager in 24 24 let overflow_content_size = usable - 4 in 25 - let buf = Buffer.create remaining_size in 25 + if remaining_size < 0 then failwith "corrupt cell: negative overflow size"; 26 + let buf = Buffer.create (min remaining_size (1024 * 1024)) in 27 + let visited = Hashtbl.create 8 in 26 28 let rec read page_num remaining = 27 29 if remaining <= 0 || page_num = 0 then () 30 + else if Hashtbl.mem visited page_num then 31 + failwith "corrupt overflow chain: cycle detected" 28 32 else begin 33 + Hashtbl.replace visited page_num (); 29 34 let page = Pager.read pager page_num in 30 35 let next_page = Page.u32_be page 0 in 31 36 let to_read = min remaining overflow_content_size in ··· 731 736 let delete_by_prefix t prefix = delete_by_prefix_in_page t t.root_page prefix 732 737 733 738 let iter t f = 739 + let visited = Hashtbl.create 16 in 734 740 let rec iter_page page_num = 735 - let page = Pager.read t.pager page_num in 736 - let header = Page.parse_header page 0 in 737 - let ptrs = cell_pointers page header in 738 - let usable = usable_size t in 739 - match header.Page.kind with 740 - | Page.Leaf_index -> 741 - for i = 0 to header.Page.cell_count - 1 do 742 - let full_payload = 743 - read_full_payload t page ptrs.(i) ~usable_size:usable 744 - in 745 - f full_payload 746 - done 747 - | Page.Interior_index -> 748 - for i = 0 to header.Page.cell_count - 1 do 749 - let cell, _ = 750 - Cell.parse_index_interior page ptrs.(i) ~usable_size:usable 751 - in 752 - iter_page cell.Cell.left_child 753 - done; 754 - Option.iter iter_page header.Page.right_child 755 - | _ -> failwith "Invalid page type" 741 + if Hashtbl.mem visited page_num then 742 + failwith "corrupt B-tree: cyclic page reference" 743 + else begin 744 + Hashtbl.replace visited page_num (); 745 + let page = Pager.read t.pager page_num in 746 + let header = Page.parse_header page 0 in 747 + let ptrs = cell_pointers page header in 748 + let usable = usable_size t in 749 + match header.Page.kind with 750 + | Page.Leaf_index -> 751 + for i = 0 to header.Page.cell_count - 1 do 752 + let full_payload = 753 + read_full_payload t page ptrs.(i) ~usable_size:usable 754 + in 755 + f full_payload 756 + done 757 + | Page.Interior_index -> 758 + for i = 0 to header.Page.cell_count - 1 do 759 + let cell, _ = 760 + Cell.parse_index_interior page ptrs.(i) ~usable_size:usable 761 + in 762 + iter_page cell.Cell.left_child 763 + done; 764 + Option.iter iter_page header.Page.right_child 765 + | _ -> failwith "Invalid page type" 766 + end 756 767 in 757 768 iter_page t.root_page 758 769
+31 -20
lib/table.ml
··· 31 31 | Some first_overflow -> 32 32 let usable = usable_size t in 33 33 let remaining = cell.payload_size - String.length cell.payload in 34 - let buf = Buffer.create cell.payload_size in 34 + if remaining < 0 then failwith "corrupt cell: payload_size < local size"; 35 + let buf = Buffer.create (min cell.payload_size (1024 * 1024)) in 35 36 Buffer.add_string buf cell.payload; 36 37 let overflow_payload_size = usable - 4 in 38 + let visited = Hashtbl.create 8 in 37 39 let rec follow page_num left = 38 40 if left <= 0 then () 41 + else if Hashtbl.mem visited page_num then 42 + failwith "corrupt overflow chain: cycle detected" 39 43 else begin 44 + Hashtbl.replace visited page_num (); 40 45 let page = Pager.read t.pager page_num in 41 46 let next = Page.u32_be page 0 in 42 47 let chunk = min left overflow_payload_size in ··· 515 520 traverse t.root_page 516 521 517 522 let iter t f = 523 + let visited = Hashtbl.create 16 in 518 524 let rec iter_page page_num = 519 - let page = Pager.read t.pager page_num in 520 - let header = Page.parse_header page 0 in 521 - let ptrs = Page.cell_pointers page 0 header in 522 - let usable = usable_size t in 523 - match header.Page.kind with 524 - | Page.Leaf_table -> 525 - for i = 0 to header.Page.cell_count - 1 do 526 - let cell, _ = 527 - Cell.parse_table_leaf page ptrs.(i) ~usable_size:usable 528 - in 529 - f cell.Cell.rowid (full_payload t cell) 530 - done 531 - | Page.Interior_table -> 532 - for i = 0 to header.Page.cell_count - 1 do 533 - let cell, _ = Cell.parse_table_interior page ptrs.(i) in 534 - iter_page cell.Cell.left_child 535 - done; 536 - Option.iter iter_page header.Page.right_child 537 - | _ -> failwith "Invalid page type" 525 + if Hashtbl.mem visited page_num then 526 + failwith "corrupt B-tree: cyclic page reference" 527 + else begin 528 + Hashtbl.replace visited page_num (); 529 + let page = Pager.read t.pager page_num in 530 + let header = Page.parse_header page 0 in 531 + let ptrs = Page.cell_pointers page 0 header in 532 + let usable = usable_size t in 533 + match header.Page.kind with 534 + | Page.Leaf_table -> 535 + for i = 0 to header.Page.cell_count - 1 do 536 + let cell, _ = 537 + Cell.parse_table_leaf page ptrs.(i) ~usable_size:usable 538 + in 539 + f cell.Cell.rowid (full_payload t cell) 540 + done 541 + | Page.Interior_table -> 542 + for i = 0 to header.Page.cell_count - 1 do 543 + let cell, _ = Cell.parse_table_interior page ptrs.(i) in 544 + iter_page cell.Cell.left_child 545 + done; 546 + Option.iter iter_page header.Page.right_child 547 + | _ -> failwith "Invalid page type" 548 + end 538 549 in 539 550 iter_page t.root_page 540 551