summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--bin/leda.ml18
-rw-r--r--gemini/geminiTransaction.ml23
-rw-r--r--gemini/geminiTransaction.mli8
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)