diff options
| author | Ryan Kavanagh <rak@rak.ac> | 2020-06-12 22:45:26 -0400 |
|---|---|---|
| committer | Ryan Kavanagh <rak@rak.ac> | 2020-06-12 22:45:26 -0400 |
| commit | 08df6e9d4c46276bbdca66e7622c0a0fc70f50f4 (patch) | |
| tree | 5717f548064c1267eaab9422363a56fa07dce6b4 /gemini | |
| parent | Better error handling (diff) | |
Diffstat (limited to 'gemini')
| -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 |