blob: 282d6e7590b28c4b81685b1fe473dc755345a311 (
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
module type GEMINI_TRANSACTION =
sig
type request
module M : MimeType.MIME_TYPE
type status =
| INPUT
| SUCCESS
| SUCCESS_EOCSS
| REDIR_TEMP
| REDIR_PERM
| TEMP_FAIL
| SERVER_UNAVAILABLE
| CGI_ERROR
| PROXY_ERROR
| SLOW_DOWN
| PERM_FAIL
| NOT_FOUND
| GONE
| PROXY_REQ_REFUSED
| BAD_REQ
| CLIENT_CERT_REQUIRED
| TRANSIENT_CERT_REQUESTED
| AUTHORISED_CERT_REQUIRED
| CERT_NOT_ACCEPTED
| FUTURE_CERT_REJECTED
| EXPIRED_CERT_REJECTED
type mime_type = M.t
type response = status * mime_type * string
val string_to_request : string -> request
val int_to_status : int -> status option
val transaction : request -> response option Lwt.t
end
module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION
with module M = M =
struct
exception InvalidRequest
type request = { host : string; port : int; url : string; }
module M = M
type mime_type = M.t
type status =
| INPUT
| SUCCESS
| SUCCESS_EOCSS
| REDIR_TEMP
| REDIR_PERM
| TEMP_FAIL
| SERVER_UNAVAILABLE
| CGI_ERROR
| PROXY_ERROR
| SLOW_DOWN
| PERM_FAIL
| NOT_FOUND
| GONE
| PROXY_REQ_REFUSED
| BAD_REQ
| CLIENT_CERT_REQUIRED
| TRANSIENT_CERT_REQUESTED
| AUTHORISED_CERT_REQUIRED
| CERT_NOT_ACCEPTED
| FUTURE_CERT_REJECTED
| EXPIRED_CERT_REJECTED
type response = status * mime_type * string
let string_to_request r =
let url = Uri.of_string r in
let () = match Uri.scheme url with
| Some "gemini" -> ()
| _ -> raise InvalidRequest in
let host = match Uri.host url with
| Some h -> h
| _ -> raise InvalidRequest in
let port = match Uri.port url with
| Some p -> p
| _ -> 1965 in
{ host = host; port = port; url = r; }
let int_to_status = function
| 10 -> Some INPUT
| 20 -> Some SUCCESS
| 21 -> Some SUCCESS_EOCSS
| 30 -> Some REDIR_TEMP
| 31 -> Some REDIR_PERM
| 40 -> Some TEMP_FAIL
| 41 -> Some SERVER_UNAVAILABLE
| 42 -> Some CGI_ERROR
| 43 -> Some PROXY_ERROR
| 44 -> Some SLOW_DOWN
| 50 -> Some PERM_FAIL
| 51 -> Some NOT_FOUND
| 52 -> Some GONE
| 53 -> Some PROXY_REQ_REFUSED
| 54 -> Some BAD_REQ
| 60 -> Some CLIENT_CERT_REQUIRED
| 61 -> Some TRANSIENT_CERT_REQUESTED
| 62 -> Some AUTHORISED_CERT_REQUIRED
| 63 -> Some CERT_NOT_ACCEPTED
| 64 -> Some FUTURE_CERT_REJECTED
| 65 -> Some EXPIRED_CERT_REJECTED
| _ -> None
let transaction r =
let authenticator ~host:_ _ = Ok None in
let ()= ignore r in
let%lwt (ic, oc) = Tls_lwt.connect_ext
Tls.Config.(client ~authenticator ~ciphers:Ciphers.default ())
(r.host, r.port) in
let%lwt () = Lwt_io.write oc r.url in
let%lwt response = Lwt_io.read ic in
Lwt.return (Some (PERM_FAIL, M.from_string "text/plain", response))
end
|
