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