diff options
Diffstat (limited to 'gemini')
| -rw-r--r-- | gemini/dune | 2 | ||||
| -rw-r--r-- | gemini/request.ml | 120 | ||||
| -rw-r--r-- | gemini/request.mli | 37 |
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 |