gazagnaire.org
Git object storage and pack files for Eio
1(** Fuzz tests for Git config parsing. *)
2
3open Alcobar
4
5let truncate ?(max_len = 4096) buf =
6 if String.length buf > max_len then String.sub buf 0 max_len else buf
7
8(** Parse - must not crash on arbitrary input. *)
9let test_parse_crash_safety buf =
10 let buf = truncate buf in
11 let _ = Git.Config.of_string buf in
12 ()
13
14(** Roundtrip - parsed config must serialize and re-parse. *)
15let test_roundtrip buf =
16 let buf = truncate buf in
17 let config = Git.Config.of_string buf in
18 let serialized = Git.Config.to_string config in
19 let reparsed = Git.Config.of_string serialized in
20 let orig_sections = Git.Config.all_sections config in
21 let reparsed_sections = Git.Config.all_sections reparsed in
22 if List.length orig_sections <> List.length reparsed_sections then
23 fail "section count mismatch after roundtrip"
24
25(** Set/get consistency - value must be retrievable after set. *)
26let test_set_get sec_buf key_buf value_buf =
27 (* Sanitize section name to be valid *)
28 let sec_name = truncate ~max_len:32 sec_buf in
29 let sec_name =
30 String.map
31 (fun c ->
32 if (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') then c else 'x')
33 sec_name
34 in
35 let sec_name = if String.length sec_name = 0 then "core" else sec_name in
36 (* Sanitize key name *)
37 let key = truncate ~max_len:32 key_buf in
38 let key =
39 String.map
40 (fun c ->
41 if
42 (c >= 'a' && c <= 'z')
43 || (c >= 'A' && c <= 'Z')
44 || (c >= '0' && c <= '9')
45 then c
46 else 'x')
47 key
48 in
49 let key = if String.length key = 0 then "key" else key in
50 (* Sanitize value (no newlines) *)
51 let value = truncate ~max_len:256 value_buf in
52 let value = String.map (fun c -> if c = '\n' then ' ' else c) value in
53 let section = Git.Config.section sec_name in
54 let config = Git.Config.set Git.Config.empty ~section ~key ~value in
55 match Git.Config.find config section key with
56 | None -> fail "key not found after set"
57 | Some v ->
58 let v = String.trim v in
59 let value = String.trim value in
60 if v <> value then failf "value mismatch: got '%s', expected '%s'" v value
61
62(** Unset - value must not be retrievable after unset. *)
63let test_unset sec_buf key_buf =
64 let sec_name = truncate ~max_len:32 sec_buf in
65 let sec_name =
66 String.map
67 (fun c ->
68 if (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') then c else 'x')
69 sec_name
70 in
71 let sec_name = if String.length sec_name = 0 then "core" else sec_name in
72 let key = truncate ~max_len:32 key_buf in
73 let key = String.map (fun c -> if c >= 'a' && c <= 'z' then c else 'x') key in
74 let key = if String.length key = 0 then "key" else key in
75 let section = Git.Config.section sec_name in
76 let config = Git.Config.set Git.Config.empty ~section ~key ~value:"test" in
77 let config = Git.Config.unset config ~section ~key in
78 if Option.is_some (Git.Config.find config section key) then
79 fail "key still present after unset"
80
81(** Boolean parsing - true/false/yes/no/on/off/1/0 all work. *)
82let test_bool_values n =
83 let values = [| "true"; "false"; "yes"; "no"; "on"; "off"; "1"; "0" |] in
84 let expected = [| true; false; true; false; true; false; true; false |] in
85 let idx = n mod 8 in
86 let value = values.(idx) in
87 let section = Git.Config.section "test" in
88 let config = Git.Config.set Git.Config.empty ~section ~key:"flag" ~value in
89 match Git.Config.bool config section "flag" with
90 | None -> fail "failed to parse boolean"
91 | Some parsed ->
92 if parsed <> expected.(idx) then
93 failf "boolean mismatch for '%s': got %b, expected %b" value parsed
94 expected.(idx)
95
96(** Integer parsing - valid integers parse correctly. *)
97let test_int_values n =
98 let section = Git.Config.section "test" in
99 let value = string_of_int n in
100 let config = Git.Config.set Git.Config.empty ~section ~key:"count" ~value in
101 match Git.Config.int config section "count" with
102 | None -> fail "failed to parse integer"
103 | Some parsed ->
104 if parsed <> n then failf "integer mismatch: got %d, expected %d" parsed n
105
106(** Add supports multi-valued keys. *)
107let test_multivalue n =
108 let section = Git.Config.section "test" in
109 let count = (n mod 5) + 1 in
110 let config =
111 List.fold_left
112 (fun cfg i ->
113 Git.Config.add cfg ~section ~key:"item" ~value:(string_of_int i))
114 Git.Config.empty (List.init count Fun.id)
115 in
116 let all = Git.Config.all config section "item" in
117 if List.length all <> count then
118 failf "multivalue count mismatch: got %d, expected %d" (List.length all)
119 count
120
121(** Section with subsection. *)
122let test_subsection name_buf sub_buf =
123 let name = truncate ~max_len:32 name_buf in
124 let name =
125 String.map (fun c -> if c >= 'a' && c <= 'z' then c else 'x') name
126 in
127 let name = if String.length name = 0 then "remote" else name in
128 let sub = truncate ~max_len:32 sub_buf in
129 let sub =
130 String.map (fun c -> if c = '"' || c = '\\' || c = '\n' then '_' else c) sub
131 in
132 let sub = if String.length sub = 0 then "origin" else sub in
133 let section = Git.Config.section_sub name sub in
134 let config =
135 Git.Config.set Git.Config.empty ~section ~key:"url"
136 ~value:"https://example.com"
137 in
138 match Git.Config.find config section "url" with
139 | None -> fail "key not found in subsection"
140 | Some v ->
141 if v <> "https://example.com" then fail "value mismatch in subsection"
142
143(** Get remotes from config. *)
144let test_get_remotes () =
145 let config_content =
146 {|[remote "origin"]
147 url = https://github.com/user/repo.git
148[remote "upstream"]
149 url = https://github.com/other/repo.git
150|}
151 in
152 let config = Git.Config.of_string config_content in
153 let remotes = Git.Config.remotes config in
154 if List.length remotes <> 2 then
155 failf "expected 2 remotes, got %d" (List.length remotes)
156
157(** Get branches from config. *)
158let test_get_branches () =
159 let config_content =
160 {|[branch "main"]
161 remote = origin
162 merge = refs/heads/main
163[branch "feature"]
164 remote = upstream
165|}
166 in
167 let config = Git.Config.of_string config_content in
168 let branches = Git.Config.branches config in
169 if List.length branches <> 2 then
170 failf "expected 2 branches, got %d" (List.length branches)
171
172let suite =
173 ( "config",
174 [
175 test_case "parse crash safety" [ bytes ] test_parse_crash_safety;
176 test_case "roundtrip" [ bytes ] test_roundtrip;
177 test_case "set/get" [ bytes; bytes; bytes ] test_set_get;
178 test_case "unset" [ bytes; bytes ] test_unset;
179 test_case "bool values" [ uint8 ] test_bool_values;
180 test_case "int values" [ int ] test_int_values;
181 test_case "multivalue" [ uint8 ] test_multivalue;
182 test_case "subsection" [ bytes; bytes ] test_subsection;
183 test_case "get_remotes" [ const () ] test_get_remotes;
184 test_case "get_branches" [ const () ] test_get_branches;
185 ] )