OAuth 2.0 authorization and token exchange
Fix JSON injection in token roundtrip fuzz test
The fuzz test interpolated raw bytes into JSON strings via Fmt.str,
producing malformed JSON for inputs containing quotes or backslashes.
The test then silently accepted parse errors, hiding the breakage.
Replace string interpolation with Jsont encoding, restrict fuzzed
input to printable ASCII for lossless roundtrips, and require parse
success (only empty access_token may fail).
+36
-14
+36
-14
fuzz/fuzz_github_oauth.ml
+36
-14
fuzz/fuzz_github_oauth.ml
···
35
35
let _ = Oauth.parse_token_response input in
36
36
check true
37
37
38
-
(* Test roundtrip: encode a valid token response, then parse it *)
38
+
(* Encode a token response as proper JSON using Jsont to avoid injection
39
+
from fuzzed strings containing quotes or backslashes. *)
40
+
let token_response_jsont =
41
+
Jsont.Object.map ~kind:"token_response"
42
+
(fun access_token expires_in refresh_token ->
43
+
(access_token, expires_in, refresh_token))
44
+
|> Jsont.Object.mem "access_token" Jsont.string ~enc:(fun (at, _, _) -> at)
45
+
|> Jsont.Object.opt_mem "expires_in" Jsont.int ~enc:(fun (_, ei, _) -> ei)
46
+
|> Jsont.Object.opt_mem "refresh_token" Jsont.string ~enc:(fun (_, _, rt) ->
47
+
rt)
48
+
|> Jsont.Object.finish
49
+
50
+
(* Restrict fuzzed bytes to printable ASCII so JSON encode/decode roundtrips
51
+
are lossless. JSON strings are Unicode; arbitrary bytes may not survive
52
+
the encode-decode cycle due to UTF-8/surrogate normalization. *)
53
+
let to_ascii s =
54
+
String.init (String.length s) (fun i ->
55
+
let c = (Char.code s.[i] mod 94) + 33 in
56
+
Char.chr c)
57
+
39
58
let test_token_roundtrip access_token expires_in refresh_token =
59
+
let access_token = to_ascii access_token in
60
+
let refresh_token = Option.map to_ascii refresh_token in
61
+
let expires_in = Option.map (fun n -> n land max_int mod 100000) expires_in in
40
62
let json =
41
-
let parts =
42
-
[ Fmt.str {|"access_token":"%s"|} access_token ]
43
-
@ (match expires_in with
44
-
| None -> []
45
-
| Some n -> [ Fmt.str {|"expires_in":%d|} (abs n mod 100000) ])
46
-
@
47
-
match refresh_token with
48
-
| None -> []
49
-
| Some rt -> [ Fmt.str {|"refresh_token":"%s"|} rt ]
50
-
in
51
-
"{" ^ String.concat "," parts ^ "}"
63
+
match
64
+
Jsont_bytesrw.encode_string token_response_jsont
65
+
(access_token, expires_in, refresh_token)
66
+
with
67
+
| Ok s -> s
68
+
| Error _ -> failwith "jsont encode failed"
52
69
in
53
70
match Oauth.parse_token_response json with
54
-
| Ok t -> check (t.access_token = access_token)
55
-
| Error _ -> check true
71
+
| Ok t ->
72
+
check (t.access_token = access_token);
73
+
check (t.expires_in = expires_in);
74
+
check (t.refresh_token = refresh_token)
75
+
| Error _ ->
76
+
(* Empty access_token is rejected by the parser — that is correct. *)
77
+
check (access_token = "")
56
78
57
79
(* Test that code_challenge never crashes and produces non-empty output *)
58
80
let test_code_challenge_no_crash verifier =