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

- [gemini] added support for proxy.

This commit is contained in:
cage 2024-06-23 20:30:53 +02:00
parent c636fd8edb
commit 1f58010447
4 changed files with 86 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/default-theme.conf
View File

@ -522,7 +522,7 @@ open-message-link-window.input.selected.foreground = #FF00FF
# gemini browser # gemini browser
# the default search engine # absolute address for a search engine used in tinmop (both TUI and GUI)
gemini.search-engine.uri = "gemini://kennedy.gemi.dev/search" gemini.search-engine.uri = "gemini://kennedy.gemi.dev/search"

86
src/gemini/client.lisp
View File

@ -447,46 +447,52 @@
(client-certificate nil) (client-certificate nil)
(certificate-key nil) (certificate-key nil)
(certificate-key-password nil)) (certificate-key-password nil))
(let* ((iri (make-gemini-iri (idn:host-unicode->ascii host) (multiple-value-bind (proxy-host proxy-port)
(percent-encode-path path) (swconf:config-gemini-proxy)
:query (percent-encode-query query) (let* ((iri (make-gemini-iri (idn:host-unicode->ascii host)
:port port (percent-encode-path path)
:fragment (percent-encode-fragment fragment))) :query (percent-encode-query query)
(ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+))) :port port
(cl+ssl:with-global-context (ctx :auto-free-p t) :fragment (percent-encode-fragment fragment)))
(handler-case (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
(let ((socket (open-tls-socket host port))) (cl+ssl:with-global-context (ctx :auto-free-p t)
(hooks:run-hooks 'hooks:*after-gemini-socket*) (handler-case
(let* ((stream (usocket:socket-stream socket)) (let* ((actual-host (or proxy-host
(ssl-hostname (if (or (iri:ipv4-address-p host) host))
(iri:ipv6-address-p host)) (actual-port (or proxy-port
nil port))
host)) (socket (open-tls-socket actual-host actual-port)))
(ssl-stream (cl+ssl:make-ssl-client-stream stream (hooks:run-hooks 'hooks:*after-gemini-socket*)
:certificate client-certificate (let* ((stream (usocket:socket-stream socket))
:key certificate-key (ssl-hostname (if (or (iri:ipv4-address-p actual-host)
:password (iri:ipv6-address-p actual-host))
certificate-key-password nil
:external-format nil ; unsigned byte 8 actual-host))
:unwrap-stream-p t (ssl-stream (cl+ssl:make-ssl-client-stream stream
:verify nil :certificate client-certificate
:hostname ssl-hostname)) :key certificate-key
(request (format nil "~a~a~a" iri #\return #\newline)) :password
(cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream)))) certificate-key-password
(debug-gemini "sending request ~a" request) :external-format nil ; unsigned byte 8
(if (not (db:tofu-passes-p host cert-hash)) :unwrap-stream-p t
(error 'gemini-tofu-error :host host) :verify nil
(progn :hostname ssl-hostname))
(write-sequence (string->octets request) ssl-stream) (request (format nil "~a~a~a" iri #\return #\newline))
(force-output ssl-stream) (cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
(hooks:run-hooks 'hooks:*after-gemini-request-sent*) (debug-gemini "sending request ~a" request)
(multiple-value-bind (status description meta response) (if (not (db:tofu-passes-p actual-host cert-hash))
#+sbcl (sb-sys:with-deadline (:seconds +read-response-deadline+) (error 'gemini-tofu-error :host actual-host)
(parse-response ssl-stream)) (progn
#-sbcl (parse-response ssl-stream) (write-sequence (string->octets request) ssl-stream)
(values status description meta response socket)))))) (force-output ssl-stream)
(error (e) (hooks:run-hooks 'hooks:*after-gemini-request-sent*)
(error e)))))) (multiple-value-bind (status description meta response)
#+sbcl (sb-sys:with-deadline (:seconds +read-response-deadline+)
(parse-response ssl-stream))
#-sbcl (parse-response ssl-stream)
(values status description meta response socket))))))
(error (e)
(error e)))))))
(defun missing-dispath-function (status code-description meta response socket iri parsed-iri) (defun missing-dispath-function (status code-description meta response socket iri parsed-iri)
(declare (ignore response socket parsed-iri)) (declare (ignore response socket parsed-iri))

1
src/package.lisp
View File

@ -1481,6 +1481,7 @@
:config-default-post-language :config-default-post-language
:config-announcements-separator :config-announcements-separator
:config-announcements-icon :config-announcements-icon
:config-gemini-proxy
:config-gemini-search-engine-iri :config-gemini-search-engine-iri
:link-regex->program-to-use :link-regex->program-to-use
:link-regex->program-to-use-buffer-size :link-regex->program-to-use-buffer-size

66
src/software-configuration.lisp
View File

@ -597,6 +597,7 @@
gemini gemini
gemlog gemlog
gempub gempub
proxy
library library
sync sync
favicon favicon
@ -1684,6 +1685,15 @@
+key-announcements+ +key-announcements+
+key-icon+) +key-icon+)
(defun config-gemini-proxy ()
(when-let* ((iri (access:accesses *software-configuration*
+key-gemini+
+key-proxy+
+key-uri+))
(parsed-iri (iri:iri-parse iri :null-on-error t)))
(values (uri:host parsed-iri)
(uri:port parsed-iri))))
(defun config-gemini-search-engine-iri () (defun config-gemini-search-engine-iri ()
(let ((iri (access:accesses *software-configuration* (let ((iri (access:accesses *software-configuration*
+key-gemini+ +key-gemini+
@ -1695,36 +1705,36 @@
;;;;;; tests ;;;;;; tests
(defun trivial-configuration-missing-value-check () (defun trivial-configuration-missing-value-check ()
(loop for fn in (list (loop for fn in (list #'gemini-downloading-animation
#'gemini-downloading-animation #'gemini-default-favicon
#'gemini-default-favicon #'gemini-link-prefix-to-gemini
#'gemini-link-prefix-to-gemini #'gemini-link-prefix-to-other
#'gemini-link-prefix-to-other #'gemini-quote-prefix
#'gemini-quote-prefix #'gemini-h1-prefix
#'gemini-h1-prefix #'gemini-h2-prefix
#'gemini-h2-prefix #'gemini-h3-prefix
#'gemini-h3-prefix #'gemini-bullet-prefix
#'gemini-bullet-prefix #'gemini-subscription-url-fg
#'gemini-subscription-url-fg #'gemini-subscription-count-fg
#'gemini-subscription-count-fg #'signature-file-path
#'signature-file-path #'window-titles-ends
#'window-titles-ends #'tags-new-message-mark
#'tags-new-message-mark #'config-server-name
#'config-server-name #'config-username
#'config-username #'config-password-echo-character
#'config-password-echo-character #'config-win-focus-mark
#'config-win-focus-mark #'command-separator-config-values
#'command-separator-config-values #'message-window-locked-account-mark
#'message-window-locked-account-mark #'message-window-unlocked-account-mark
#'message-window-unlocked-account-mark #'message-window-line-mark-values
#'message-window-line-mark-values #'message-window-attachments-header
#'message-window-attachments-header #'config-post-allowed-language
#'config-post-allowed-language #'config-default-post-language
#'config-default-post-language #'config-announcements-separator)
#'config-announcements-separator)
do do
(funcall fn))) (funcall fn)))
(defun trivial-configuration-checks () (defun trivial-configuration-checks ()
(assert (length= (config-username) (assert (length= (config-username)
(config-server-name)))) (config-server-name)))
(config-gemini-proxy))