diff options
| -rw-r--r-- | gemini/geminiTransaction.ml | 7 |
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 |