cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2024-12-20 23:34:40 +01:00
Code Issues

- [gemini] made slurp-gemini-url works with redirect;

Browse Source 
- [gemini] made some refactoring for building redirect IRIs.
This commit is contained in:
cage 2021-01-23 16:25:37 +01:00
parent 3962af0256
commit ecec01f285
4 changed files with 59 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/gemini-viewer.lisp
View File

@ -519,10 +519,8 @@
((gemini-client:response-redirect-p status)
(flet ((on-input-complete (maybe-accepted)
(when (ui::boolean-input-accepted-p maybe-accepted)
(let ((new-url (gemini-parser:absolutize-link meta
(uri:host parsed-iri)
(uri:port parsed-iri)
(uri:path parsed-iri))))
(let ((new-url (gemini-client:build-redirect-iri meta
parsed-iri)))
(db-utils:with-ready-database (:connect nil)
(request new-url
:certificate-key certificate-key

32
src/gemini/client.lisp
View File

@ -336,3 +336,35 @@
(multiple-value-bind (status description meta response)
(parse-response ssl-stream)
(values status description meta response socket)))))))))))
(defun gemini-file-stream-p (meta)
(gemini-client:mime-gemini-p meta))
(defun fetch-cached-certificate (url)
(let ((certificate nil)
(key nil))
(multiple-value-bind (certificate-cache key-cache)
(db:ssl-cert-find url)
(if (and certificate-cache
key-cache)
(setf certificate certificate-cache
key key-cache)
(multiple-value-bind (certificate-new key-new)
(gemini-client:make-client-certificate url)
(setf certificate certificate-new
key key-new)))
(assert certificate)
(assert key)
(values certificate key))))
(defgeneric build-redirect-iri (meta iri-from))
(defmethod build-redirect-iri (meta (iri-from iri:iri))
(let ((new-url (gemini-parser:absolutize-link meta
(uri:host iri-from)
(uri:port iri-from)
(uri:path iri-from))))
new-url))
(defmethod build-redirect-iri (meta (iri-from string))
(build-redirect-iri meta (iri:iri-parse iri-from)))

5
src/gemini/package.lisp
View File

@ -114,7 +114,10 @@
:gemini-file-response-p
:close-ssl-socket
:make-client-certificate
:request))
:request
:gemini-file-stream-p
:fetch-cached-certificate
:build-redirect-iri))
(defpackage :gemini-subscription
(:use

36
src/gemini/subscription.lisp
View File

@ -16,28 +16,34 @@
(in-package :gemini-subscription)
(defun slurp-gemini-url (url)
(define-constant +maximum-redirections+ 5 :test `=)
(defun slurp-gemini-url (url &optional (redirect-count 0))
"Read 'full' data from gemini address `url'; note that specs says
that gemini flow is streamed by default so this function has limited
use as there is a chance that it would not returns. Anyway for gemlog
subscription (for example) could be used.
TODO: No redirection is followed"
TODO: Add client certificate."
(let ((iri (iri:iri-parse url)))
(multiple-value-bind (status description meta response socket)
(gemini-client:request (uri:host iri)
(uri:path iri)
:query (uri:query iri)
:port (uri:port iri)
:fragment (uri:fragment iri))
(declare (ignore meta description))
(when (response-success-p status)
(let ((data (misc:make-fresh-array 0 0 '(unsigned-byte 8) nil)))
(loop for new-byte = (read-byte response nil nil)
while new-byte do
(vector-push-extend new-byte data))
(gemini-client:close-ssl-socket socket)
data)))))
(gemini-client:request (uri:host iri)
(uri:path iri)
:query (uri:query iri)
:port (uri:port iri)
:fragment (uri:fragment iri))
(declare (ignore description))
(cond
((response-success-p status)
(let ((data (misc:make-fresh-array 0 0 '(unsigned-byte 8) nil)))
(loop for new-byte = (read-byte response nil nil)
while new-byte do
(vector-push-extend new-byte data))
(gemini-client:close-ssl-socket socket)
data))
((and (response-redirect-p status)
(< redirect-count +maximum-redirections+))
(slurp-gemini-url (gemini-client:build-redirect-iri meta iri) (1+ redirect-count)))))))
(defun link-post-timestamp (link-text)
"Returns a local-time object parsing a gemlog entry's link text