1 (in-package #:phos/gemini)
3 (defparameter *default-port* 1965
4 "The default port for gemini URL.")
6 (defparameter *code-to-keyword* '((10 :input)
10 (31 :permanent-redirect)
11 (40 :temporary-failure)
12 (41 :server-unavailable)
16 (50 :permanent-failure)
19 (53 :proxy-request-refused)
21 (60 :client-certificate-required)
22 (61 :certificate-not-authorised)
23 (62 :certificate-not-valid))
24 "Maps status code to keyword name.")
26 (define-condition malformed-response (error)
27 ((reason :initarg :reason :reader reason)))
29 (defun parse-status (s)
30 (let* ((n (parse-integer s))
31 (x (cadr (assoc n *code-to-keyword*))))
33 (return-from parse-status x))
34 (let* ((l (* (floor (/ n 10))
36 (x (cadr (assoc l *code-to-keyword*))))
39 (error 'malformed-response :reason (format nil "unknown response number ~a" s))))))
41 (defun parse-response (res)
42 (unless (uiop:string-suffix-p res (format nil "~c~c" #\return #\newline))
43 (error 'malformed-response :reason "response doesn't and with CRLF"))
44 (unless (< (length res) 1024)
45 (error 'malformed-response :reason "response is longer than 1024 bytes"))
46 (setf res (string-trim '(#\return #\newline) res))
47 (destructuring-bind (status &optional meta) (cl-ppcre:split "\\s+" res :limit 2)
49 (error 'malformed-response :reason "missing meta"))
50 (list (parse-status status) meta)))
52 (defun read-all-stream (in)
53 (with-output-to-string (out)
54 (loop with buffer = (make-array 1024 :element-type 'character)
55 for n-chars = (read-sequence buffer in)
57 do (write-sequence buffer out :start 0
60 (defun read-until (in char)
61 (with-output-to-string (out)
62 (loop for ch = (read-char in)
65 do (write-char ch out))
66 (write-char char out)))
68 (defun do-request (host port req)
69 "Perform the request REQ to HOST on PORT, blocking until the
70 response is fetched, then return the meta and the (decoded) body."
71 (usocket:with-client-socket (socket stream host port)
72 (let ((ssl-stream (cl+ssl:make-ssl-client-stream
73 stream :unwrap-stream-p t
74 :external-format '(:utf8 :eol-style :lf)
77 (format ssl-stream "~a~c~c" req #\return #\newline)
78 (force-output ssl-stream)
79 (let ((resp (parse-response (read-until ssl-stream #\newline))))
80 (values resp (read-all-stream ssl-stream))))))
82 (defgeneric request (url)
83 (:documentation "Perform a request for the URL"))
85 (defmethod request ((url string))
86 (request (quri:uri url)))
88 (defmethod request ((url quri:uri))
89 (let* ((u (quri:uri url))
90 (port (or (quri:uri-port u) 1965))
91 (host (quri:uri-host u)))
92 (do-request host port url)))