diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index d8a1f6e..cc625ee 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -436,30 +436,35 @@ :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) - (let* ((socket (open-tls-socket host port)) - (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 - :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) - (multiple-value-bind (status description meta response) - (parse-response ssl-stream) - (values status description meta response socket)))))))) + (let ((socket (open-tls-socket host port))) + (when hooks:*after-gemini-socket* + (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 + :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) + (misc:dbg "client hook ~a" hooks:*after-gemini-request-sent*) + (when hooks:*after-gemini-request-sent* + (hooks:run-hooks 'hooks:*after-gemini-request-sent*)) + (multiple-value-bind (status description meta response) + (parse-response ssl-stream) + (values status description meta response socket))))))))) (defun missing-dispath-function (status code-description meta response socket iri parsed-iri) (declare (ignore response socket parsed-iri)) diff --git a/src/gui/client/bookmark-window.lisp b/src/gui/client/bookmark-window.lisp index 5c9c6d9..bb3a275 100644 --- a/src/gui/client/bookmark-window.lisp +++ b/src/gui/client/bookmark-window.lisp @@ -27,12 +27,31 @@ (description-text nil)) (gui:with-toplevel (toplevel :master master :title (_ "Streams")) (gui:transient toplevel master) - (let* ((iri-label (make-instance 'gui:label :master toplevel :text (_ "Address"))) - (section-label (make-instance 'gui:label :master toplevel :text (_ "Section"))) - (description-label (make-instance 'gui:label :master toplevel :text (_ "Description"))) - (iri-entry (make-instance 'gui:entry :master toplevel :text iri)) - (section-entry (make-instance 'gui:entry :master toplevel :text section-text)) - (description-entry (make-instance 'gui:entry :master toplevel :text description-text)) + (let* ((entries-width (gui-goodies:quite-good-dialog-width)) + (iri-label (make-instance 'gui:label + :width entries-width + :master toplevel + :text (_ "Address"))) + (section-label (make-instance 'gui:label + :width entries-width + :master toplevel + :text (_ "Section"))) + (description-label (make-instance 'gui:label + :width entries-width + :master toplevel + :text (_ "Description"))) + (iri-entry (make-instance 'gui:entry + :width entries-width + :master toplevel + :text iri)) + (section-entry (make-instance 'gui:entry + :width entries-width + :master toplevel + :text section-text)) + (description-entry (make-instance 'gui:entry + :width entries-width + :master toplevel + :text description-text)) (buttons-frame (make-instance 'gui:frame :master toplevel)) (add-button (make-instance 'gui:button :master buttons-frame @@ -117,8 +136,7 @@ :command (update-bookmark-clsr toplevel searchbox bookmarks)))) - (let ((searchbox-width (truncate (min (/ (gui:screen-width) 2 - (gui:font-measure gui:+tk-text-font+ "0")))))) + (let ((searchbox-width (gui-goodies:quite-good-dialog-width))) (gui:configure (gui:listbox searchbox) :width searchbox-width)) (gui:grid searchbox 0 0 :padx (* 2 +minimum-padding+) :pady (* 2 +minimum-padding+)) (gui:grid delete-button 0 0 :sticky :s) diff --git a/src/gui/client/gui-goodies.lisp b/src/gui/client/gui-goodies.lisp index 0bcb033..d8c0991 100644 --- a/src/gui/client/gui-goodies.lisp +++ b/src/gui/client/gui-goodies.lisp @@ -127,3 +127,9 @@ :accessor rows :initform '() :initarg :rows))) + +(defun quite-good-dialog-width (&optional (chars-unit t)) + (if chars-unit + (truncate (min (/ (gui:screen-width) 2 + (gui:font-measure gui:+tk-text-font+ "0")))) + (truncate (/ (gui:screen-width) 2)))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 75b59ba..ca38d81 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -154,6 +154,7 @@ next-start-fetching)))))))) (loop-fetch) (ev:with-enqueued-process-and-unblock () + (print-info-message (_ "Stream finished")) (render-toc main-window iri)) (if (cev:enqueue-request-and-wait-results :gemini-bookmarked-p 1 @@ -181,6 +182,7 @@ (push-db-stream stream-wrapper)) (flet ((aborting-function () (eq (status stream-wrapper) +stream-status-canceled+))) + (print-info-message (_ "Stream started")) (let ((stream-thread (bt:make-thread (lambda () (slurp-gemini-stream main-window iri diff --git a/src/gui/client/tour-window.lisp b/src/gui/client/tour-window.lisp index 384d598..cf98867 100644 --- a/src/gui/client/tour-window.lisp +++ b/src/gui/client/tour-window.lisp @@ -33,8 +33,7 @@ :pack '(:side :top :expand t :fill :both) :columns (list (_ "Description"))))) (setf tree treeview) - (gui:treeview-heading tree gui:+treeview-first-column-id+ - :text (_ "Address")) + (gui:treeview-heading tree gui:+treeview-first-column-id+ :text (_ "Address")) (resync-rows object new-rows) object))) diff --git a/src/hooks.lisp b/src/hooks.lisp index 356d4ff..f58f6df 100644 --- a/src/hooks.lisp +++ b/src/hooks.lisp @@ -127,3 +127,9 @@ open the links") (defparameter *after-delete-char-from-command-window* '() "Run this hooks after deleting a character from the input of the command-window.") + +(defparameter *after-gemini-socket* '() + "Run these hooks after a gemini socket has been estabilshed") + +(defparameter *after-gemini-request-sent* '() + "Run these hooks after a gemini request has been sent") diff --git a/src/package.lisp b/src/package.lisp index 64e47e5..bda248c 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1856,7 +1856,9 @@ :*before-displaying-links-hook* :*after-char-to-command-window* :*before-fire-string-event-command-window* - :*after-delete-char-from-command-window*)) + :*after-delete-char-from-command-window* + :*after-gemini-socket* + :*after-gemini-request-sent*)) (defpackage :keybindings (:use @@ -3389,7 +3391,8 @@ :password-dialog :table-frame :tree - :rows)) + :rows + :quite-good-dialog-width)) (defpackage :client-menu-command (:use