summaryrefslogtreecommitdiff
path: root/gemini/geminiTransaction.ml
diff options
context:
space:
mode:
Diffstat (limited to '')
-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