OAuth 2.0 authorization and token exchange
Use Uri.of_string for HTTPS validation instead of string prefix check
The previous is_https used a raw prefix check that accepted malformed
URLs like "https://\x00evil.com". Now uses Uri.of_string + Uri.scheme
matching, consistent with redirect_uri validation. Also rejects URLs
with no host component.
+10
-6
+10
-6
lib/oauth.ml
+10
-6
lib/oauth.ml
···
44
44
45
45
let builtin_slugs = [ "github"; "google"; "gitlab" ]
46
46
47
-
let is_https url =
48
-
String.length url >= 8
49
-
&& String.sub (String.lowercase_ascii url) 0 8 = "https://"
50
-
51
47
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))
48
+
let uri = Uri.of_string url in
49
+
match Uri.scheme uri with
50
+
| Some "https" ->
51
+
if Uri.host uri = None then
52
+
Error (`Msg (Fmt.str "%s has no host: %s" label url))
53
+
else Ok ()
54
+
| Some scheme ->
55
+
Error (`Msg (Fmt.str "%s must use HTTPS, got %s://: %s" label scheme url))
56
+
| None ->
57
+
Error (`Msg (Fmt.str "%s must be an absolute HTTPS URL: %s" label url))
54
58
55
59
let is_valid_json_field_name s =
56
60
String.length s > 0