Blame


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