diff options
Diffstat (limited to '')
| -rw-r--r-- | bin/leda.ml | 18 | ||||
| -rw-r--r-- | gemini/geminiTransaction.ml | 23 | ||||
| -rw-r--r-- | gemini/geminiTransaction.mli | 8 |
3 files changed, 38 insertions, 11 deletions
diff --git a/bin/leda.ml b/bin/leda.ml index 98e6244..c32f3a5 100644 --- a/bin/leda.ml +++ b/bin/leda.ml @@ -16,7 +16,7 @@ module R = Gemini.GeminiTransaction.GeminiTransaction(T)(Gemini.TlsUtils.TlsUtil let () = Lwt_main.run begin let%lwt () = Mirage_crypto_rng_lwt.initialize () in - let request : (R.request, string) Base.Result.t = R.make_request (Sys.get_argv()).(1) in + let request = R.make_request (Sys.get_argv()).(1) in let rec loop t = match%lwt Lwt_stream.next (Term.events t) with | `Key _ -> Lwt.return () @@ -44,8 +44,18 @@ let () = let%lwt () = Term.image t (h <-> c) in let%lwt () = Term.refresh t in loop t - | Error m -> + | Error R.TOO_MANY_REDIRECTS -> let%lwt () = Term.release t in - Lwt_io.printl m) - | Error m -> Lwt_io.printl m + Lwt_io.printl "Too many redirects" + | Error (R.X_DOMAIN_REDIR _) -> + let%lwt () = Term.release t in + Lwt_io.printl ("Attempted to redirect across domains") + | Error (UNKNOWN_RESPONSE s) -> + let%lwt () = Term.release t in + Lwt_io.printl ("Unknown response: " ^ s) + | Error (MISC s) -> + let%lwt () = Term.release t in + Lwt_io.printl ("Error: " ^ s)) + | Error m -> + Lwt_io.printl m end diff --git a/gemini/geminiTransaction.ml b/gemini/geminiTransaction.ml index 9f079af..1221177 100644 --- a/gemini/geminiTransaction.ml +++ b/gemini/geminiTransaction.ml @@ -32,6 +32,12 @@ sig | FUTURE_CERT_REJECTED | EXPIRED_CERT_REJECTED + type session_error = + | TOO_MANY_REDIRECTS + | X_DOMAIN_REDIR of Uri.t * Uri.t + | UNKNOWN_RESPONSE of string + | MISC of string + val make_request : ?authenticator:T.authenticator -> ?max_redirects:int -> string -> (request, string) Base.Result.t @@ -49,7 +55,7 @@ sig val transaction : request -> (response, string) Base.Result.t Lwt.t - val session : request -> (response, string) Base.Result.t Lwt.t + val session : request -> (response, session_error) Base.Result.t Lwt.t end module GeminiTransaction (M : MimeType.MIME_TYPE) (T : TlsUtils.TLS_UTILS) @@ -89,6 +95,12 @@ struct | FUTURE_CERT_REJECTED | EXPIRED_CERT_REJECTED + type session_error = + | TOO_MANY_REDIRECTS + | X_DOMAIN_REDIR of Uri.t * Uri.t + | UNKNOWN_RESPONSE of string + | MISC of string + let url_of_string r = let url = Uri.of_string r in let open Base.Result.Monad_infix in @@ -255,10 +267,9 @@ struct match update_request ~url ~max_redirects:(req.max_redirects - 1) req with | Ok req -> session req - | Error m -> Lwt.return (Error m) + | Error m -> Lwt.return (Error (MISC m)) else - Lwt.return (Error "Too many redirects") - | Ok r -> Lwt.return (Error ("Unhandled response " - ^ (header_of_response r))) - | Error m -> Lwt.return (Error m) + Lwt.return (Error TOO_MANY_REDIRECTS) + | Ok r -> Lwt.return (Error (UNKNOWN_RESPONSE (header_of_response r))) + | Error m -> Lwt.return (Error (MISC m)) end diff --git a/gemini/geminiTransaction.mli b/gemini/geminiTransaction.mli index 4a89ab1..d103afe 100644 --- a/gemini/geminiTransaction.mli +++ b/gemini/geminiTransaction.mli @@ -32,6 +32,12 @@ sig | FUTURE_CERT_REJECTED | EXPIRED_CERT_REJECTED + type session_error = + | TOO_MANY_REDIRECTS + | X_DOMAIN_REDIR of Uri.t * Uri.t + | UNKNOWN_RESPONSE of string + | MISC of string + val make_request : ?authenticator:T.authenticator -> ?max_redirects:int -> string -> (request, string) Base.Result.t @@ -49,7 +55,7 @@ sig val transaction : request -> (response, string) Base.Result.t Lwt.t - val session : request -> (response, string) Base.Result.t Lwt.t + val session : request -> (response, session_error) Base.Result.t Lwt.t end module GeminiTransaction (M : MimeType.MIME_TYPE) (T : TlsUtils.TLS_UTILS) |