mirror of https://codeberg.org/cage/tinmop/
- added password protected TLS key, for kami protocol.
This commit is contained in:
cage
parent
e0589e56f1
commit
b8f49eb66b
|
|
@ -759,7 +759,6 @@
|
|||
:certificate-key-password ""
|
||||
:certificate cached-certificate))
|
||||
(cached-key-password
|
||||
(misc:dbg "trovata password ~a" cached-key-password)
|
||||
(request iri
|
||||
:do-nothing-if-exists-in-db do-nothing-if-exists-in-db
|
||||
:certificate-key cached-key
|
||||
|
|
|
|||
|
|
@ -17,7 +17,8 @@
|
|||
|
||||
(defmacro with-open-ssl-stream ((ssl-stream socket host port
|
||||
client-certificate
|
||||
certificate-key)
|
||||
certificate-key
|
||||
certificate-key-password)
|
||||
&body body)
|
||||
(alexandria:with-gensyms (tls-context socket-stream ssl-hostname)
|
||||
`(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
|
||||
:certificate ,client-certificate
|
||||
:key ,certificate-key
|
||||
:password ,certificate-key-password
|
||||
:external-format nil ; unsigned byte 8
|
||||
:unwrap-stream-p t
|
||||
:verify nil
|
||||
|
|
@ -215,8 +217,8 @@
|
|||
|
||||
(defun generate-filesystem-window-handlers (path host port
|
||||
query fragment
|
||||
client-certificate client-key)
|
||||
(with-open-ssl-stream (stream socket host port client-certificate client-key)
|
||||
client-certificate client-key certificate-key-password)
|
||||
(with-open-ssl-stream (stream socket host port client-certificate client-key certificate-key-password)
|
||||
(let* ((9p:*tag* 10)
|
||||
(9p:*fid* 1)
|
||||
(9p:*messages-sent* '())
|
||||
|
|
@ -242,8 +244,8 @@
|
|||
|
||||
(defun iri->filesystem-window-handlers (kami-iri)
|
||||
(a:when-let ((parsed-iri (iri:iri-parse kami-iri :null-on-error t)))
|
||||
(multiple-value-bind (cached-certificate cached-key)
|
||||
(gemini-client:fetch-cached-certificate kami-iri :if-does-not-exist :create)
|
||||
(multiple-value-bind (cached-certificate cached-key cached-key-password)
|
||||
(gemini-client:fetch-cached-certificate kami-iri :if-does-not-exist nil)
|
||||
(multiple-value-bind (actual-iri host path query port fragment scheme)
|
||||
(gemini-client:displace-iri parsed-iri)
|
||||
(declare (ignore actual-iri scheme))
|
||||
|
|
@ -253,4 +255,5 @@
|
|||
query
|
||||
fragment
|
||||
cached-certificate
|
||||
cached-key)))))
|
||||
cached-key
|
||||
cached-key-password)))))
|
||||
|
|
|
|||
|
|
@ -3056,25 +3056,52 @@ printed, on the main window."
|
|||
(filesystem-tree-window:init actual-root)
|
||||
(focus-to-filesystem-explorer-window))))
|
||||
|
||||
(defun init-kami-window (url handlers)
|
||||
(if handlers
|
||||
(let* ((path (uri:path (iri:iri-parse url)))
|
||||
(path-to-dir-p (fs:path-referencing-dir-p path))
|
||||
(init-path (if path-to-dir-p
|
||||
path
|
||||
(fs:parent-dir-path path))))
|
||||
(filesystem-tree-window:init init-path handlers)
|
||||
(if path-to-dir-p
|
||||
(focus-to-filesystem-explorer-window)
|
||||
(progn
|
||||
(%file-explorer-download-path path)
|
||||
(file-explorer-close-path))))
|
||||
(error-message (format nil
|
||||
(_ "~s is not a valid kami address")
|
||||
url))))
|
||||
|
||||
(defun open-kami-address (url)
|
||||
(with-enqueued-process ()
|
||||
(with-notify-kami-error
|
||||
(let ((handlers (kami:iri->filesystem-window-handlers url)))
|
||||
(if handlers
|
||||
(let* ((path (uri:path (iri:iri-parse url)))
|
||||
(path-to-dir-p (fs:path-referencing-dir-p path))
|
||||
(init-path (if path-to-dir-p
|
||||
path
|
||||
(fs:parent-dir-path path))))
|
||||
(filesystem-tree-window:init init-path handlers)
|
||||
(if path-to-dir-p
|
||||
(focus-to-filesystem-explorer-window)
|
||||
(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
|
||||
(%file-explorer-download-path path)
|
||||
(file-explorer-close-path))))
|
||||
(error-message (format nil
|
||||
(_ "~s is not a valid kami address")
|
||||
url)))))))
|
||||
(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 ()
|
||||
(when-let* ((win *filesystem-explorer-window*)
|
||||
|
|
|
|||
Loading…
Reference in New Issue