Blame
Date:
Mon Jan 17 11:21:05 2022 UTC
Message:
gemini: Add with-gemini-request macro.

This also includes a minor refactoring of the code to be less
duplicative and rely on multiple values instead of list return values.
001
2020-11-09
op
(in-package #:phos/gemini)
002
2020-11-09
op
003
2020-11-09
op
(defparameter *default-port* 1965
004
2020-11-09
op
"The default port for gemini URL.")
005
2020-11-09
op
006
2020-11-09
op
(defparameter *code-to-keyword* '((10 :input)
007
2020-11-09
op
(11 :sensitive-input)
008
2020-11-09
op
(20 :success)
009
2020-11-09
op
(30 :redirect)
010
2020-11-09
op
(31 :permanent-redirect)
011
2020-11-09
op
(40 :temporary-failure)
012
2020-11-09
op
(41 :server-unavailable)
013
2020-11-09
op
(42 :cgi-error)
014
2020-11-09
op
(43 :proxy-error)
015
2020-11-09
op
(44 :slow-down)
016
2020-11-09
op
(50 :permanent-failure)
017
2020-11-09
op
(51 :not-found)
018
2020-11-09
op
(52 :gone)
019
2020-11-09
op
(53 :proxy-request-refused)
020
2020-11-09
op
(59 :bad-request)
021
2020-11-09
op
(60 :client-certificate-required)
022
2020-11-09
op
(61 :certificate-not-authorised)
023
2020-11-09
op
(62 :certificate-not-valid))
024
2020-11-09
op
"Maps status code to keyword name.")
025
2020-11-09
op
026
2020-11-09
op
(define-condition malformed-response (error)
027
2020-11-09
op
((reason :initarg :reason :reader reason)))
028
2020-11-09
op
029
2020-11-09
op
(defun parse-status (s)
030
2020-11-09
op
(let* ((n (parse-integer s))
031
2020-11-09
op
(x (cadr (assoc n *code-to-keyword*))))
032
2020-11-09
op
(when x
033
2020-11-09
op
(return-from parse-status x))
034
2020-11-09
op
(let* ((l (* (floor (/ n 10))
035
2020-11-09
op
10))
036
2020-11-09
op
(x (cadr (assoc l *code-to-keyword*))))
037
2020-11-09
op
(if x
038
2020-11-09
op
x
039
2020-11-09
op
(error 'malformed-response :reason (format nil "unknown response number ~a" s))))))
040
2020-11-09
op
041
2020-11-09
op
(defun parse-response (res)
042
2020-11-09
op
(unless (uiop:string-suffix-p res (format nil "~c~c" #\return #\newline))
043
2020-11-09
op
(error 'malformed-response :reason "response doesn't and with CRLF"))
044
2020-11-09
op
(unless (< (length res) 1024)
045
2020-11-09
op
(error 'malformed-response :reason "response is longer than 1024 bytes"))
046
2020-11-09
op
(setf res (string-trim '(#\return #\newline) res))
047
2020-11-09
op
(destructuring-bind (status &optional meta) (cl-ppcre:split "\\s+" res :limit 2)
048
2022-01-14
op
(when (and (< (parse-integer status) 40) (not meta))
049
2020-11-09
op
(error 'malformed-response :reason "missing meta"))
050
2022-01-17
op
(values (parse-status status) meta)))
051
2020-11-09
op
052
2022-01-15
noreply
(defun read-all-string (in)
053
2020-11-09
op
(with-output-to-string (out)
054
2020-11-09
op
(loop with buffer = (make-array 1024 :element-type 'character)
055
2020-11-09
op
for n-chars = (read-sequence buffer in)
056
2020-11-09
op
while (< 0 n-chars)
057
2020-11-09
op
do (write-sequence buffer out :start 0
058
2020-11-09
op
:end n-chars))))
059
2020-11-09
op
060
2022-01-15
noreply
(defun read-all-bytes (in)
061
2022-01-15
noreply
(let ((data (make-array 0 :element-type '(unsigned-byte 8) :adjustable t :fill-pointer 0)))
062
2022-01-15
noreply
(loop with buffer = (make-array 1024 :element-type '(unsigned-byte 8))
063
2022-01-15
noreply
for n-bytes = (read-sequence buffer in)
064
2022-01-15
noreply
for data-size = (array-dimension data 0)
065
2022-01-15
noreply
while (< 0 n-bytes)
066
2022-01-15
noreply
do (adjust-array data (+ data-size n-bytes))
067
2022-01-15
noreply
do (incf (fill-pointer data) n-bytes)
068
2022-01-15
noreply
do (replace data buffer :start1 data-size :end2 n-bytes))
069
2022-01-15
noreply
data))
070
2022-01-15
noreply
071
2020-11-09
op
(defun read-until (in char)
072
2020-11-09
op
(with-output-to-string (out)
073
2020-11-09
op
(loop for ch = (read-char in)
074
2020-11-09
op
when (char= ch char)
075
2020-11-09
op
return nil
076
2020-11-09
op
do (write-char ch out))
077
2020-11-09
op
(write-char char out)))
078
2020-11-09
op
079
2022-01-17
op
(defmacro with-gemini-request (((status meta stream) url) &body body)
080
2022-01-17
op
"Expose a stream (STREAM) with Gemini response contents, available in BODY.
081
2020-11-09
op
082
2022-01-17
op
STATUS and META are bound to the status code (as keyword from
083
2022-01-17
op
`*code-to-keyword*') and meta info (as optional/nullable string.)
084
2020-11-09
op
085
2022-01-17
op
URL should be a well-formed string/`quri:uri' URL."
086
2022-01-17
op
(let* ((socket-var (gensym "SOCKET"))
087
2022-01-17
op
(socket-stream-var (gensym "SOCKET-STREAM"))
088
2022-01-17
op
(host-var (gensym "HOST"))
089
2022-01-17
op
(port-var (gensym "PORT"))
090
2022-01-17
op
(url-var (gensym "URL")))
091
2022-01-17
op
`(let* ((,url-var (quri:uri ,url))
092
2022-01-17
op
(,host-var (quri:uri-host ,url-var))
093
2022-01-17
op
(,port-var (or (quri:uri-port ,url-var) phos/gemini:*default-port*)))
094
2022-01-17
op
(usocket:with-client-socket (,socket-var ,socket-stream-var ,host-var ,port-var)
095
2022-01-17
op
(let ((,stream (cl+ssl:make-ssl-client-stream
096
2022-01-17
op
,socket-stream-var :unwrap-stream-p t
097
2022-01-17
op
:external-format '(:utf8 :eol-style :lf)
098
2022-01-17
op
:verify nil
099
2022-01-17
op
:hostname ,host-var)))
100
2022-01-17
op
(format ,stream "~a~c~c" (quri:render-uri ,url-var) #\return #\newline)
101
2022-01-17
op
(force-output ,stream)
102
2022-01-17
op
(multiple-value-bind (,status ,meta)
103
2022-01-17
op
(parse-response (read-until ,stream #\newline))
104
2022-01-17
op
,@body))))))
105
2020-11-09
op
106
2022-01-17
op
(defgeneric request (url)
107
2022-01-17
op
(:method (url)
108
2022-01-17
op
(with-gemini-request ((status meta stream) url)
109
2022-01-17
op
(values status meta (if (and (eq status :success)
110
2022-01-17
op
meta (string= (subseq meta 0 5) "text/"))
111
2022-01-17
op
(read-all-string stream)
112
2022-01-17
op
(read-all-bytes stream)))))
113
2022-01-17
op
(:documentation "Perform a request for the URL."))
Omar Polo