OAuth 2.0 authorization and token exchange
Reject custom providers whose slug collides with built-in providers
custom_provider now checks that path_safe(name) does not equal
"github", "google", or "gitlab". A collision would make callback
routes ambiguous, allowing an attacker-controlled custom provider
to intercept authorization callbacks for a legitimate built-in one.
3 new tests: rejects "GitHub" and "Google" slugs, accepts non-colliding.
+80
-24
+29
-18
lib/oauth.ml
+29
-18
lib/oauth.ml
···
16
16
uid_field : string;
17
17
}
18
18
19
-
let is_https url =
20
-
String.length url >= 8
21
-
&& String.sub (String.lowercase_ascii url) 0 8 = "https://"
22
-
23
-
let require_https label url =
24
-
if is_https url then Ok ()
25
-
else Error (`Msg (Fmt.str "%s must use HTTPS, got: %s" label url))
26
-
27
-
let custom_provider ~name ~authorize_url ~token_url ~userinfo_url ~uid_field =
28
-
match
29
-
( require_https "authorize_url" authorize_url,
30
-
require_https "token_url" token_url,
31
-
require_https "userinfo_url" userinfo_url )
32
-
with
33
-
| Ok (), Ok (), Ok () ->
34
-
Ok { name; authorize_url; token_url; userinfo_url; uid_field }
35
-
| (Error _ as e), _, _ | _, (Error _ as e), _ | _, _, (Error _ as e) -> e
36
-
37
19
(* Sanitize a string for use as a URL path segment per RFC 3986 §3.3:
38
20
lowercase, keep only unreserved chars [a-z0-9-], collapse runs of
39
21
dashes, strip leading/trailing dashes. Non-ASCII bytes (UTF-8) are
···
59
41
else result
60
42
in
61
43
if result = "" then "custom" else result
44
+
45
+
let builtin_slugs = [ "github"; "google"; "gitlab" ]
46
+
47
+
let is_https url =
48
+
String.length url >= 8
49
+
&& String.sub (String.lowercase_ascii url) 0 8 = "https://"
50
+
51
+
let require_https label url =
52
+
if is_https url then Ok ()
53
+
else Error (`Msg (Fmt.str "%s must use HTTPS, got: %s" label url))
54
+
55
+
let custom_provider ~name ~authorize_url ~token_url ~userinfo_url ~uid_field =
56
+
let slug = path_safe name in
57
+
if List.mem slug builtin_slugs then
58
+
Error
59
+
(`Msg
60
+
(Fmt.str
61
+
"custom provider name %S produces slug %S which collides with \
62
+
built-in provider"
63
+
name slug))
64
+
else
65
+
match
66
+
( require_https "authorize_url" authorize_url,
67
+
require_https "token_url" token_url,
68
+
require_https "userinfo_url" userinfo_url )
69
+
with
70
+
| Ok (), Ok (), Ok () ->
71
+
Ok { name; authorize_url; token_url; userinfo_url; uid_field }
72
+
| (Error _ as e), _, _ | _, (Error _ as e), _ | _, _, (Error _ as e) -> e
62
73
63
74
let provider_name = function
64
75
| Github -> "github"
+9
-6
lib/oauth.mli
+9
-6
lib/oauth.mli
···
77
77
uid_field:string ->
78
78
(custom_provider, [ `Msg of string ]) result
79
79
(** [custom_provider ~name ~authorize_url ~token_url ~userinfo_url ~uid_field]
80
-
constructs a custom provider configuration after validating that all
81
-
endpoint URLs use HTTPS, as required by RFC 6749 §3.1–3.2.
80
+
constructs a custom provider configuration after validating that:
81
+
- All endpoint URLs use HTTPS (RFC 6749 §3.1–3.2).
82
+
- The slug derived from [name] does not collide with a built-in provider
83
+
(["github"], ["google"], ["gitlab"]), which would make callback routes
84
+
ambiguous.
82
85
83
-
Returns [Error (`Msg reason)] if any URL does not start with ["https://"].
84
-
*)
86
+
Returns [Error (`Msg reason)] if validation fails. *)
85
87
86
88
val provider_name : provider -> string
87
89
(** [provider_name p] is the canonical provider identifier used for identity
···
95
97
built-in providers this equals {!provider_name}; for custom providers it is
96
98
sanitized to [[a-z0-9-]].
97
99
98
-
{b Warning}: distinct custom providers may produce the same slug. Do not use
99
-
this for identity lookup — use {!provider_name} instead. *)
100
+
{!custom_provider} rejects names whose slug collides with a built-in
101
+
provider. Distinct custom providers may still produce the same slug — use
102
+
{!provider_name} for identity lookup. *)
100
103
101
104
val authorize_url : provider -> string
102
105
(** [authorize_url p] is the authorization endpoint URL. *)
+42
test/test_regressions.ml
+42
test/test_regressions.ml
···
231
231
| Ok p -> Alcotest.(check string) "name" "good" p.name
232
232
| Error (`Msg msg) -> Alcotest.failf "unexpected error: %s" msg
233
233
234
+
let test_custom_provider_rejects_builtin_slug_collision () =
235
+
(* "Git Hub" slugifies to "git-hub", not "github", so it should be OK *)
236
+
(* But "GitHub" slugifies to "github" — collision with built-in *)
237
+
match
238
+
Oauth.custom_provider ~name:"GitHub" ~authorize_url:"https://evil.com/auth"
239
+
~token_url:"https://evil.com/token" ~userinfo_url:"https://evil.com/user"
240
+
~uid_field:"id"
241
+
with
242
+
| Error (`Msg msg) ->
243
+
Alcotest.(check bool)
244
+
"mentions collision" true
245
+
(contains msg ~substring:"collides")
246
+
| Ok _ -> Alcotest.fail "expected Error for slug colliding with built-in"
247
+
248
+
let test_custom_provider_rejects_google_slug_collision () =
249
+
match
250
+
Oauth.custom_provider ~name:"Google" ~authorize_url:"https://evil.com/auth"
251
+
~token_url:"https://evil.com/token" ~userinfo_url:"https://evil.com/user"
252
+
~uid_field:"id"
253
+
with
254
+
| Error (`Msg msg) ->
255
+
Alcotest.(check bool)
256
+
"mentions collision" true
257
+
(contains msg ~substring:"collides")
258
+
| Ok _ -> Alcotest.fail "expected Error for slug colliding with built-in"
259
+
260
+
let test_custom_provider_allows_non_colliding_slug () =
261
+
match
262
+
Oauth.custom_provider ~name:"My Corp SSO"
263
+
~authorize_url:"https://sso.corp.com/auth"
264
+
~token_url:"https://sso.corp.com/token"
265
+
~userinfo_url:"https://sso.corp.com/user" ~uid_field:"sub"
266
+
with
267
+
| Ok p -> Alcotest.(check string) "name" "My Corp SSO" p.name
268
+
| Error (`Msg msg) -> Alcotest.failf "unexpected error: %s" msg
269
+
234
270
(* ── Redirect URI validation ─────────────────────────────────────── *)
235
271
236
272
let test_redirect_uri_rejects_http () =
···
299
335
test_custom_provider_rejects_http_userinfo_url;
300
336
Alcotest.test_case "custom_provider accepts https://" `Quick
301
337
test_custom_provider_accepts_https;
338
+
Alcotest.test_case "custom_provider rejects github slug collision" `Quick
339
+
test_custom_provider_rejects_builtin_slug_collision;
340
+
Alcotest.test_case "custom_provider rejects google slug collision" `Quick
341
+
test_custom_provider_rejects_google_slug_collision;
342
+
Alcotest.test_case "custom_provider allows non-colliding slug" `Quick
343
+
test_custom_provider_allows_non_colliding_slug;
302
344
Alcotest.test_case "redirect_uri rejects http://" `Quick
303
345
test_redirect_uri_rejects_http;
304
346
Alcotest.test_case "redirect_uri accepts https://" `Quick