cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-25 09:17:45 +01:00
Code Issues

- added password protected TLS key, for kami protocol.

Browse Source
This commit is contained in:
cage 2024-02-17 13:01:12 +01:00
parent e0589e56f1
commit b8f49eb66b
3 changed files with 53 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/gemini-viewer.lisp
View File

@ -759,7 +759,6 @@
:certificate-key-password "" :certificate-key-password ""
:certificate cached-certificate)) :certificate cached-certificate))
(cached-key-password (cached-key-password
(misc:dbg "trovata password ~a" cached-key-password)
(request iri (request iri
:do-nothing-if-exists-in-db do-nothing-if-exists-in-db :do-nothing-if-exists-in-db do-nothing-if-exists-in-db
:certificate-key cached-key :certificate-key cached-key

15
src/kami/client.lisp
View File

@ -17,7 +17,8 @@
(defmacro with-open-ssl-stream ((ssl-stream socket host port (defmacro with-open-ssl-stream ((ssl-stream socket host port
client-certificate client-certificate
certificate-key) certificate-key
certificate-key-password)
&body body) &body body)
(alexandria:with-gensyms (tls-context socket-stream ssl-hostname) (alexandria:with-gensyms (tls-context socket-stream ssl-hostname)
`(let ((,tls-context (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+))) `(let ((,tls-context (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
@ -29,6 +30,7 @@
(cl+ssl:make-ssl-client-stream ,socket-stream (cl+ssl:make-ssl-client-stream ,socket-stream
:certificate ,client-certificate :certificate ,client-certificate
:key ,certificate-key :key ,certificate-key
:password ,certificate-key-password
:external-format nil ; unsigned byte 8 :external-format nil ; unsigned byte 8
:unwrap-stream-p t :unwrap-stream-p t
:verify nil :verify nil
@ -215,8 +217,8 @@
(defun generate-filesystem-window-handlers (path host port (defun generate-filesystem-window-handlers (path host port
query fragment query fragment
client-certificate client-key) client-certificate client-key certificate-key-password)
(with-open-ssl-stream (stream socket host port client-certificate client-key) (with-open-ssl-stream (stream socket host port client-certificate client-key certificate-key-password)
(let* ((9p:*tag* 10) (let* ((9p:*tag* 10)
(9p:*fid* 1) (9p:*fid* 1)
(9p:*messages-sent* '()) (9p:*messages-sent* '())
@ -242,8 +244,8 @@
(defun iri->filesystem-window-handlers (kami-iri) (defun iri->filesystem-window-handlers (kami-iri)
(a:when-let ((parsed-iri (iri:iri-parse kami-iri :null-on-error t))) (a:when-let ((parsed-iri (iri:iri-parse kami-iri :null-on-error t)))
(multiple-value-bind (cached-certificate cached-key) (multiple-value-bind (cached-certificate cached-key cached-key-password)
(gemini-client:fetch-cached-certificate kami-iri :if-does-not-exist :create) (gemini-client:fetch-cached-certificate kami-iri :if-does-not-exist nil)
(multiple-value-bind (actual-iri host path query port fragment scheme) (multiple-value-bind (actual-iri host path query port fragment scheme)
(gemini-client:displace-iri parsed-iri) (gemini-client:displace-iri parsed-iri)
(declare (ignore actual-iri scheme)) (declare (ignore actual-iri scheme))
@ -253,4 +255,5 @@
query query
fragment fragment
cached-certificate cached-certificate
cached-key))))) cached-key
cached-key-password)))))

37
src/ui-goodies.lisp
View File

@ -3056,10 +3056,7 @@ printed, on the main window."
(filesystem-tree-window:init actual-root) (filesystem-tree-window:init actual-root)
(focus-to-filesystem-explorer-window)))) (focus-to-filesystem-explorer-window))))
(defun open-kami-address (url) (defun init-kami-window (url handlers)
(with-enqueued-process ()
(with-notify-kami-error
(let ((handlers (kami:iri->filesystem-window-handlers url)))
(if handlers (if handlers
(let* ((path (uri:path (iri:iri-parse url))) (let* ((path (uri:path (iri:iri-parse url)))
(path-to-dir-p (fs:path-referencing-dir-p path)) (path-to-dir-p (fs:path-referencing-dir-p path))
@ -3074,7 +3071,37 @@ printed, on the main window."
(file-explorer-close-path)))) (file-explorer-close-path))))
(error-message (format nil (error-message (format nil
(_ "~s is not a valid kami address") (_ "~s is not a valid kami address")
url))))))) url))))
(defun open-kami-address (url)
(flet ((init-window ()
(let ((handlers (kami:iri->filesystem-window-handlers url)))
(init-kami-window url handlers))))
(with-enqueued-process ()
(with-notify-kami-error
(tui:with-notify-errors
(db-utils:with-ready-database (:connect nil)
(multiple-value-bind (cached-certificate cached-key cached-key-password just-created)
(gemini-client:fetch-cached-certificate url :if-does-not-exist :create)
(if (or just-created
(os-utils:ssl-key-has-empty-password-p cached-key)
cached-key-password)
(init-window)
(progn
(flet ((on-input-complete (password)
(db-utils:with-ready-database (:connect nil)
(tui:with-notify-errors
(gemini-client:save-cache-certificate-password cached-certificate
password)
(let ((handlers (kami:iri->filesystem-window-handlers url)))
(init-kami-window url handlers))))))
(let ((error-message
(format nil
(_"a password to unlock certificate for ~a is needed: ")
url)))
(ui:ask-string-input #'on-input-complete
:priority program-events:+minimum-event-priority+
:prompt error-message))))))))))))
(defun file-explorer-expand-path () (defun file-explorer-expand-path ()
(when-let* ((win *filesystem-explorer-window*) (when-let* ((win *filesystem-explorer-window*)