diff options
| -rw-r--r-- | bin/leda.ml | 23 | ||||
| -rw-r--r-- | gemini/dune | 2 | ||||
| -rw-r--r-- | gemini/request.ml | 120 | ||||
| -rw-r--r-- | gemini/request.mli | 37 |
4 files changed, 165 insertions, 17 deletions
diff --git a/bin/leda.ml b/bin/leda.ml index 07fe43c..40074ff 100644 --- a/bin/leda.ml +++ b/bin/leda.ml @@ -1,20 +1,11 @@ module M = Gemini.MimeTextGemini.MimeTextGemini -let test_gemini = "=> /blah mylink\r\n\ - => /blah\r\n\ - ```\r\n\ - preformatted 1\r\n\ - preformatted 2\r\n\ - ``` ending preformatted text\r\n\ - some text\r\n\ - more text\r\n\ - \r\n\ - * unordered list\r\n" - -let _ = print_endline test_gemini - -let _ = print_endline "\n\n...gets parsed as...\n\n" - let test_parse s = M.gemini_to_canon_str (M.str_to_gemini s) -let main = print_endline (test_parse test_gemini) +module T = Gemini.MimeType.MimeType +module R = Gemini.Request.GeminiTransaction(T) + +let main = + match R.request "gemini://gemini.circumlunar.space/\r\n" with + | Some (_, _, s) -> print_endline s + | _ -> print_endline "oops" 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 |