Blob


1 (in-package #:phos/gemini)
3 (defparameter *default-port* 1965
4 "The default port for gemini URL.")
6 (defparameter *code-to-keyword* '((10 :input)
7 (11 :sensitive-input)
8 (20 :success)
9 (30 :redirect)
10 (31 :permanent-redirect)
11 (40 :temporary-failure)
12 (41 :server-unavailable)
13 (42 :cgi-error)
14 (43 :proxy-error)
15 (44 :slow-down)
16 (50 :permanent-failure)
17 (51 :not-found)
18 (52 :gone)
19 (53 :proxy-request-refused)
20 (59 :bad-request)
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*))))
32 (when x
33 (return-from parse-status x))
34 (let* ((l (* (floor (/ n 10))
35 10))
36 (x (cadr (assoc l *code-to-keyword*))))
37 (if x
38 x
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)
48 (when (and (< (parse-integer status) 40) (not meta))
49 (error 'malformed-response :reason "missing meta"))
50 (list (parse-status status) meta)))
52 (defun read-all-string (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)
56 while (< 0 n-chars)
57 do (write-sequence buffer out :start 0
58 :end n-chars))))
60 (defun read-all-bytes (in)
61 (let ((data (make-array 0 :element-type '(unsigned-byte 8) :adjustable t :fill-pointer 0)))
62 (loop with buffer = (make-array 1024 :element-type '(unsigned-byte 8))
63 for n-bytes = (read-sequence buffer in)
64 for data-size = (array-dimension data 0)
65 while (< 0 n-bytes)
66 do (adjust-array data (+ data-size n-bytes))
67 do (incf (fill-pointer data) n-bytes)
68 do (replace data buffer :start1 data-size :end2 n-bytes))
69 data))
71 (defun read-until (in char)
72 (with-output-to-string (out)
73 (loop for ch = (read-char in)
74 when (char= ch char)
75 return nil
76 do (write-char ch out))
77 (write-char char out)))
79 (defun do-request (host port req)
80 "Perform the request REQ to HOST on PORT, blocking until the
81 response is fetched, then return the meta and the (decoded) body."
82 (usocket:with-client-socket (socket stream host port)
83 (let ((ssl-stream (cl+ssl:make-ssl-client-stream
84 stream :unwrap-stream-p t
85 :external-format '(:utf8 :eol-style :lf)
86 :verify nil
87 :hostname host)))
88 (format ssl-stream "~a~c~c" req #\return #\newline)
89 (force-output ssl-stream)
90 (let ((resp (parse-response (read-until ssl-stream #\newline))))
91 (values resp (if (and (eq (first resp) :success)
92 (second resp)
93 (string= (subseq (second resp) 0 5) "text/"))
94 (read-all-string ssl-stream)
95 (read-all-bytes ssl-stream)))))))
97 (defgeneric request (url)
98 (:documentation "Perform a request for the URL"))
100 (defmethod request ((url string))
101 (request (quri:uri url)))
103 (defmethod request ((url quri:uri))
104 (let* ((u (quri:uri url))
105 (port (or (quri:uri-port u) 1965))
106 (host (quri:uri-host u)))
107 (do-request host port url)))