cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [gemini] added support for favicon.txt 

the       implementation       more       or       less       follow
  gemini://mozz.us/files/rfc_gemini_favicon.gmi but it does render the
  first  character  of   the  file  instead  of   checking  for  emoji
  characters.
This commit is contained in:
cage 2021-01-28 15:35:26 +01:00
parent c66a71881e
commit 17401274b5
8 changed files with 67 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/default-theme.conf
View File

@ -471,7 +471,7 @@ open-message-link-window.input.selected.foreground = #FFB200
# gemini browser
gemini.current.url.prefix = "🌍 "
gemini.favicon = "🌍"
gemini.link.scheme.gemini.prefix = "→ "

27
src/gemini-viewer.lisp
View File

@ -312,8 +312,27 @@
:payload response
:append-text append-text))))
(let ((cache ()))
(defun fetch-favicon (parsed-url)
(flet ((fetch-from-cache (key)
(assoc-value cache key :test #'string=)))
(multiple-value-bind (actual-iri host path query port fragment)
(displace-iri parsed-url)
(declare (ignore actual-iri path query fragment))
(or (fetch-from-cache host)
(ignore-errors
(let* ((favicon-url (gemini-parser:make-gemini-iri host
"/favicon.txt"
:port port))
(response-body (gemini-client:slurp-gemini-url favicon-url))
(favicon (misc:safe-subseq (babel:octets-to-string response-body :errorp t)
0 1)))
(setf cache (acons host favicon cache))
(fetch-favicon parsed-url)))
(swconf:gemini-default-favicon))))))
(defun request-stream-gemini-document-thread (wrapper-object host
port path query fragment)
port path query fragment favicon)
(with-accessors ((download-socket download-socket)
(download-stream download-stream)
(octect-count octect-count)
@ -328,7 +347,7 @@
:query query
:port port
:fragment fragment))
(url-header (format nil "-> ~a~%" url))
(url-header (format nil "~a ~a~2%" favicon url))
(parsed-url (gemini-parser:parse-gemini-file url-header))
(url-response (gemini-client:make-gemini-file-response nil
nil
@ -559,13 +578,15 @@
:stream-status starting-status
:download-stream response
:download-socket socket))
(favicon (fetch-favicon parsed-iri))
(thread-fn
(request-stream-gemini-document-thread gemini-stream
host
port
path
query
fragment))
fragment
favicon))
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
:payload gemini-stream)))
(program-events:push-event enqueue-event)

29
src/gemini/client.lisp
View File

@ -368,3 +368,32 @@
(defmethod build-redirect-iri (meta (iri-from string))
(build-redirect-iri meta (iri:iri-parse iri-from)))
(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: Add client certificate."
(let ((iri (iri:iri-parse url)))
(multiple-value-bind (status description meta response socket)
(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))
(close-ssl-socket socket)
data))
((and (response-redirect-p status)
(< redirect-count +maximum-redirections+))
(slurp-gemini-url (build-redirect-iri meta iri) (1+ redirect-count)))))))

4
src/gemini/package.lisp
View File

@ -92,6 +92,7 @@
:error-code
:error-description
:gemini-tofu-error
:*gemini-page-theme*
:make-gemini-file-response
:host
:response-certificate-requested-p
@ -117,7 +118,8 @@
:request
:gemini-file-stream-p
:fetch-cached-certificate
:build-redirect-iri))
:build-redirect-iri
:slurp-gemini-url))
(defpackage :gemini-subscription
(:use

29
src/gemini/subscription.lisp
View File

@ -16,35 +16,6 @@
(in-package :gemini-subscription)
(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: 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 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

2
src/package.lisp
View File

@ -1072,6 +1072,7 @@
:perform-missing-value-check
:load-config-file
:external-editor
:gemini-default-favicon
:gemini-link-prefix-to-gemini
:gemini-link-prefix-to-other
:gemini-quote-prefix
@ -2175,6 +2176,7 @@
:abort-download-stream
:db-entry-to-foreground
:gemini-metadata-p
:maybe-initialize-metadata
:make-gemini-metadata
:gemini-metadata-links
:gemini-metadata-source-file

4
src/program-events.lisp
View File

@ -1212,8 +1212,8 @@
(uri:host url)
(uri:port url)
(uri:path url)))
(theme gemini-client::*gemini-page-theme*))
(gemini-viewer::maybe-initialize-metadata specials:*message-window*)
(theme gemini-client:*gemini-page-theme*))
(gemini-viewer:maybe-initialize-metadata specials:*message-window*)
(refresh-gemini-message-window links
gemini-page
(gemini-parser:sexp->text parsed theme)

6
src/software-configuration.lisp
View File

@ -397,6 +397,7 @@
command-window
command-separator
gemini
favicon
tree
branch
arrow
@ -475,6 +476,11 @@
keys)))
value)))
(defun gemini-default-favicon ()
(access-non-null-conf-value *software-configuration*
+key-gemini+
+key-favicon+))
(defun gemini-link-prefix (scheme)
(access-non-null-conf-value *software-configuration*
+key-gemini+