1
0
Fork 0

- [gemini] made fetching of favicon opt-in

by default tinmop  will not fetch favicon.txt  anymore, this feature
  must be enabled by user using a configuration directive.
This commit is contained in:
cage 2021-02-21 12:23:01 +01:00
parent cb55b56c13
commit 8230056152
4 changed files with 32 additions and 16 deletions

View File

@ -155,6 +155,10 @@ color-regexp = ":rendering" cyan
# ignore-user-regexp = "^user-name@domain-name"
# Use gemini favicon?
# see gemini://mozz.us/files/rfc_gemini_favicon.gm
# gemini.fetch.favicon = no
# you can instruct the program to open some non gemini link with a
# program installed with your system like below
# syntax open "REGEXP" with "PROGRAM-NAME" [use cache]

View File

@ -314,22 +314,25 @@
(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)
(gemini-client: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))))))
(if (not (swconf:gemini-fetch-favicon-p))
(swconf:gemini-default-favicon)
(flet ((fetch-from-cache (key)
(assoc-value cache key :test #'string=)))
(multiple-value-bind (actual-iri host path query port fragment)
(gemini-client: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 favicon)

View File

@ -1077,6 +1077,7 @@
:load-config-file
:external-editor
:gemini-default-favicon
:gemini-fetch-favicon-p
:gemini-link-prefix-to-gemini
:gemini-link-prefix-to-other
:gemini-quote-prefix

View File

@ -488,6 +488,7 @@
input
read
unread
fetch
password-echo-character
color-re
ignore-user-re
@ -554,6 +555,13 @@
+key-gemini+
+key-favicon+))
(defun gemini-fetch-favicon-p ()
(let ((fetchp (access:accesses *software-configuration*
+key-gemini+
+key-fetch+
+key-favicon+)))
(db-utils:db-not-nil-p fetchp)))
(defun gemini-link-prefix (scheme)
(access-non-null-conf-value *software-configuration*
+key-gemini+