summaryrefslogtreecommitdiff
path: root/gemini/geminiTransaction.ml
diff options
context:
space:
mode:
authorRyan Kavanagh <rak@rak.ac>2020-06-12 22:45:26 -0400
committerRyan Kavanagh <rak@rak.ac>2020-06-12 22:45:26 -0400
commit08df6e9d4c46276bbdca66e7622c0a0fc70f50f4 (patch)
tree5717f548064c1267eaab9422363a56fa07dce6b4 /gemini/geminiTransaction.ml
parentBetter error handling (diff)
handle cross-domain redirectsHEADdevel
Diffstat (limited to 'gemini/geminiTransaction.ml')
-rw-r--r--gemini/geminiTransaction.ml7
1 files changed, 5 insertions, 2 deletions
diff --git a/gemini/geminiTransaction.ml b/gemini/geminiTransaction.ml
index 1221177..329b8bc 100644
--- a/gemini/geminiTransaction.ml
+++ b/gemini/geminiTransaction.ml
@@ -241,11 +241,11 @@ struct
let transaction r =
let open Angstrom_lwt_unix in
+ let authenticator = r.authenticator in
let host = Base.Option.value_exn (Uri.host r.url)
~message:"URL with no host?" in
let port = Base.Option.value_exn (Uri.port r.url)
~message:"URL with no port?" in
- let authenticator = r.authenticator in
try%lwt
let%lwt (ic, oc) = TlsUtils.TlsUtils.connect ~authenticator
~peer_name:host (host, port) in
@@ -263,7 +263,10 @@ struct
| Ok (SUCCESS (m, r)) -> Lwt.return (Ok (SUCCESS (m, r)))
| Ok (REDIR_TEMP url)
| Ok (REDIR_PERM url) ->
- if req.max_redirects > 1 then
+ let target = Uri.of_string url in
+ if (Uri.host req.url) != (Uri.host target) then
+ Lwt.return (Error (X_DOMAIN_REDIR (req.url, target)))
+ else if req.max_redirects > 1 then
match update_request ~url
~max_redirects:(req.max_redirects - 1) req with
| Ok req -> session req