summaryrefslogtreecommitdiff
path: root/gemini
diff options
context:
space:
mode:
Diffstat (limited to 'gemini')
-rw-r--r--gemini/dune2
-rw-r--r--gemini/request.ml120
-rw-r--r--gemini/request.mli37
3 files changed, 158 insertions, 1 deletions
diff --git a/gemini/dune b/gemini/dune
index cf041d8..7b93751 100644
--- a/gemini/dune
+++ b/gemini/dune
@@ -1,3 +1,3 @@
(library
(name gemini)
- (libraries base angstrom))
+ (libraries base angstrom lwt tls.lwt uri))
diff --git a/gemini/request.ml b/gemini/request.ml
new file mode 100644
index 0000000..f67f6f2
--- /dev/null
+++ b/gemini/request.ml
@@ -0,0 +1,120 @@
+open Lwt.Infix
+
+module type GEMINI_TRANSACTION =
+sig
+ module M : MimeType.MIME_TYPE
+
+ 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
+
+ val int_to_status : int -> status option
+
+ val request : string -> response option
+end
+
+module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION
+ with module M = M =
+struct
+ exception InvalidRequest
+
+ 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 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 do_request host port request =
+ let authenticator ~host:_ _ = Ok None in
+ Lwt_main.run (
+ Tls_lwt.connect_ext
+ Tls.Config.(client ~authenticator ~ciphers:Ciphers.default ())
+ (host, port) >>= fun (ic, oc) ->
+ Lwt_io.(write oc request >>= fun () ->
+ read ic >>= Lwt.return))
+
+ let 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 s -> s
+ | _ -> raise InvalidRequest in
+ let port = match Uri.port url with
+ | Some p -> p
+ | _ -> 1965 in
+ let response = do_request host port r in
+ Some (PERM_FAIL, M.from_string "text/plain", response)
+
+end
diff --git a/gemini/request.mli b/gemini/request.mli
new file mode 100644
index 0000000..b96a5ae
--- /dev/null
+++ b/gemini/request.mli
@@ -0,0 +1,37 @@
+module type GEMINI_TRANSACTION =
+sig
+ 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 int_to_status : int -> status option
+
+ val request : string -> response option
+end
+
+module GeminiTransaction (M : MimeType.MIME_TYPE) : GEMINI_TRANSACTION with module M = M