mirror of
https://codeberg.org/cage/tinmop/
synced 2024-12-22 23:47:56 +01:00
- [gemini] added support for proxy.
This commit is contained in:
cage
parent
c636fd8edb
commit
1f58010447
@ -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"
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user