From 1f5801044792a1e03735659f451ce8241f023a08 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 23 Jun 2024 20:30:53 +0200 Subject: [PATCH] - [gemini] added support for proxy. --- etc/default-theme.conf | 2 +- src/gemini/client.lisp | 86 ++++++++++++++++++--------------- src/package.lisp | 1 + src/software-configuration.lisp | 66 ++++++++++++++----------- 4 files changed, 86 insertions(+), 69 deletions(-) diff --git a/etc/default-theme.conf b/etc/default-theme.conf index 0cdf9d2..cc7e73a 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -522,7 +522,7 @@ open-message-link-window.input.selected.foreground = #FF00FF # 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" diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index 24d6f96..0ac2342 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -447,46 +447,52 @@ (client-certificate nil) (certificate-key nil) (certificate-key-password nil)) - (let* ((iri (make-gemini-iri (idn:host-unicode->ascii host) - (percent-encode-path path) - :query (percent-encode-query query) - :port port - :fragment (percent-encode-fragment fragment))) - (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+))) - (cl+ssl:with-global-context (ctx :auto-free-p t) - (handler-case - (let ((socket (open-tls-socket host port))) - (hooks:run-hooks 'hooks:*after-gemini-socket*) - (let* ((stream (usocket:socket-stream socket)) - (ssl-hostname (if (or (iri:ipv4-address-p host) - (iri:ipv6-address-p host)) - nil - host)) - (ssl-stream (cl+ssl:make-ssl-client-stream stream - :certificate client-certificate - :key certificate-key - :password - certificate-key-password - :external-format nil ; unsigned byte 8 - :unwrap-stream-p t - :verify nil - :hostname ssl-hostname)) - (request (format nil "~a~a~a" iri #\return #\newline)) - (cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream)))) - (debug-gemini "sending request ~a" request) - (if (not (db:tofu-passes-p host cert-hash)) - (error 'gemini-tofu-error :host host) - (progn - (write-sequence (string->octets request) ssl-stream) - (force-output ssl-stream) - (hooks:run-hooks 'hooks:*after-gemini-request-sent*) - (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)))))) + (multiple-value-bind (proxy-host proxy-port) + (swconf:config-gemini-proxy) + (let* ((iri (make-gemini-iri (idn:host-unicode->ascii host) + (percent-encode-path path) + :query (percent-encode-query query) + :port port + :fragment (percent-encode-fragment fragment))) + (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+))) + (cl+ssl:with-global-context (ctx :auto-free-p t) + (handler-case + (let* ((actual-host (or proxy-host + host)) + (actual-port (or proxy-port + port)) + (socket (open-tls-socket actual-host actual-port))) + (hooks:run-hooks 'hooks:*after-gemini-socket*) + (let* ((stream (usocket:socket-stream socket)) + (ssl-hostname (if (or (iri:ipv4-address-p actual-host) + (iri:ipv6-address-p actual-host)) + nil + actual-host)) + (ssl-stream (cl+ssl:make-ssl-client-stream stream + :certificate client-certificate + :key certificate-key + :password + certificate-key-password + :external-format nil ; unsigned byte 8 + :unwrap-stream-p t + :verify nil + :hostname ssl-hostname)) + (request (format nil "~a~a~a" iri #\return #\newline)) + (cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream)))) + (debug-gemini "sending request ~a" request) + (if (not (db:tofu-passes-p actual-host cert-hash)) + (error 'gemini-tofu-error :host actual-host) + (progn + (write-sequence (string->octets request) ssl-stream) + (force-output ssl-stream) + (hooks:run-hooks 'hooks:*after-gemini-request-sent*) + (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) (declare (ignore response socket parsed-iri)) diff --git a/src/package.lisp b/src/package.lisp index 83604f2..771a943 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1481,6 +1481,7 @@ :config-default-post-language :config-announcements-separator :config-announcements-icon + :config-gemini-proxy :config-gemini-search-engine-iri :link-regex->program-to-use :link-regex->program-to-use-buffer-size diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 4578d6c..7ccd1b9 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -597,6 +597,7 @@ gemini gemlog gempub + proxy library sync favicon @@ -1684,6 +1685,15 @@ +key-announcements+ +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 () (let ((iri (access:accesses *software-configuration* +key-gemini+ @@ -1695,36 +1705,36 @@ ;;;;;; tests (defun trivial-configuration-missing-value-check () - (loop for fn in (list - #'gemini-downloading-animation - #'gemini-default-favicon - #'gemini-link-prefix-to-gemini - #'gemini-link-prefix-to-other - #'gemini-quote-prefix - #'gemini-h1-prefix - #'gemini-h2-prefix - #'gemini-h3-prefix - #'gemini-bullet-prefix - #'gemini-subscription-url-fg - #'gemini-subscription-count-fg - #'signature-file-path - #'window-titles-ends - #'tags-new-message-mark - #'config-server-name - #'config-username - #'config-password-echo-character - #'config-win-focus-mark - #'command-separator-config-values - #'message-window-locked-account-mark - #'message-window-unlocked-account-mark - #'message-window-line-mark-values - #'message-window-attachments-header - #'config-post-allowed-language - #'config-default-post-language - #'config-announcements-separator) + (loop for fn in (list #'gemini-downloading-animation + #'gemini-default-favicon + #'gemini-link-prefix-to-gemini + #'gemini-link-prefix-to-other + #'gemini-quote-prefix + #'gemini-h1-prefix + #'gemini-h2-prefix + #'gemini-h3-prefix + #'gemini-bullet-prefix + #'gemini-subscription-url-fg + #'gemini-subscription-count-fg + #'signature-file-path + #'window-titles-ends + #'tags-new-message-mark + #'config-server-name + #'config-username + #'config-password-echo-character + #'config-win-focus-mark + #'command-separator-config-values + #'message-window-locked-account-mark + #'message-window-unlocked-account-mark + #'message-window-line-mark-values + #'message-window-attachments-header + #'config-post-allowed-language + #'config-default-post-language + #'config-announcements-separator) do (funcall fn))) (defun trivial-configuration-checks () (assert (length= (config-username) - (config-server-name)))) + (config-server-name))) + (config-gemini-proxy))