summaryrefslogtreecommitdiff
path: root/gemini/request.ml
diff options
context:
space:
mode:
authorRyan Kavanagh <rak@rak.ac>2020-06-02 12:09:42 -0400
committerRyan Kavanagh <rak@rak.ac>2020-06-07 11:39:58 -0400
commit301c28f2157d5822b60499c93e7ee77a92b8cfe8 (patch)
treeddee1b64412b7c50cf52017ffab896a3f9f639bc /gemini/request.ml
parentMime type parsing (diff)
Rename request to geminiTransaction
Diffstat (limited to 'gemini/request.ml')
-rw-r--r--gemini/request.ml123
1 files changed, 0 insertions, 123 deletions
diff --git a/gemini/request.ml b/gemini/request.ml
deleted file mode 100644
index 282d6e7..0000000
--- a/gemini/request.ml
+++ /dev/null
@@ -1,123 +0,0 @@
-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