1 (in-package #:phos/gemini)
2 
3 (defparameter *default-port* 1965
4   "The default port for gemini URL.")
5 
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.")
25 
26 (define-condition malformed-response (error)
27   ((reason :initarg :reason :reader reason)))
28 
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))))))
40 
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)))
51 
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)
56           while (< 0 n-chars)
57           do (write-sequence buffer out :start 0
58                                         :end n-chars))))
59 
60 (defun read-until (in char)
61   (with-output-to-string (out)
62     (loop for ch = (read-char in)
63           when (char= ch char)
64             return nil
65           do (write-char ch out))
66     (write-char char out)))
67 
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)
75                               :verify nil
76                               :hostname host)))
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))))))
81 
82 (defgeneric request (url)
83   (:documentation "Perform a request for the URL"))
84 
85 (defmethod request ((url string))
86   (request (quri:uri url)))
87 
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)))