blob: c32f3a535d2b2a61c62f60196a5122c5d0954c7b (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
open Base
open Base.Result
open Notty
open Notty.Infix
open Notty_lwt
module M = Gemini.MimeTextGemini.MimeTextGemini
let test_parse s = M.gemini_to_canon_str (M.str_to_gemini s)
module T = Gemini.MimeType.MimeType
module R = Gemini.GeminiTransaction.GeminiTransaction(T)(Gemini.TlsUtils.TlsUtils)
let () =
Lwt_main.run begin
let%lwt () = Mirage_crypto_rng_lwt.initialize () 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 ()
| _ -> loop t in
match request with
| Ok request ->
let t = Term.create () in
(match%lwt R.session request with
| Ok r ->
let h = (I.string A.empty ("STATUS: " ^ (R.name_of_response r)))
<-> (I.string A.empty ("STATUS LINE: " ^ (R.header_of_response r))) in
let c = match r with
| SUCCESS (_, c) | SUCCESS_EOCSS (_, c) ->
(try
let parsed = M.str_to_gemini c in
List.fold parsed
~init:I.empty
~f:(fun acc -> fun l ->
acc <-> (I.string A.empty (M.gemini_line_to_str l)))
with
| M.ParseError m ->
I.string A.empty ("Failed to parse contents: " ^ m))
| _ -> I.empty in
let _ = (fun _ -> ()) (h, c) in
let%lwt () = Term.image t (h <-> c) in
let%lwt () = Term.refresh t in
loop t
| Error R.TOO_MANY_REDIRECTS ->
let%lwt () = Term.release t in
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
|
