diff --git a/etc/init.lisp b/etc/init.lisp index 8967010..2abda86 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -557,6 +557,8 @@ (define-key "up" #'gemini-certificate-window-go-up *gemini-certificates-keymap*) +(define-key "c" #'gemini-change-certificate-password *gemini-certificates-keymap*) + ;; gemini subscription window (define-key "C-J" #'show-gemlog-to-screen *gemlog-subscription-keymap*) diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index 8a260c4..c494ceb 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -625,7 +625,7 @@ (let ((id (db:row-id row))) (multiple-value-bind (iri host path query port fragment scheme user-info) (gemini-client:displace-iri (iri:iri-parse (db:row-cache-key row))) - (declare (ignore query fragment)) + (declare (ignore iri query fragment)) (when (and (string= request-host host) (string= request-scheme scheme) (string= request-user-info user-info) diff --git a/src/package.lisp b/src/package.lisp index 3185db0..aa4059a 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3102,6 +3102,7 @@ :gemini-certificate-window-move :gemini-certificate-window-go-down :gemini-certificate-window-go-up + :gemini-change-certificate-password :gemini-close-certificate-window :gemini-delete-certificate :gemini-streams-window-up diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index f436806..9615898 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -1798,8 +1798,7 @@ authenticate this client on a gemini server." "Delete a gemini certificate, this could makes all user data on the server unreachable as the server will not be able to identify the client. -Of course could be possible to generate a new identity (i.e. a new -certificate). +Often would be possible to generate a new identity (i.e. a new certificate). " (flet ((on-input-complete (answer) (when (boolean-input-accepted-p answer) @@ -1819,6 +1818,45 @@ certificate). :prompt (_ "Delete this certificate? [Y/n] ") :complete-fn #'complete:complete-always-empty))) +(defun gemini-change-certificate-password () + "Change the password for an existing TLS gemini client certificate." + (when-let* ((selected-row (line-oriented-window:selected-row-fields + *gemini-certificates-window*)) + (cache-key (db:row-cache-key selected-row)) + (key-path (nth-value 1 + (gemini-client::tls-cert-find cache-key)))) + (let ((old-password "") + (new-password "") + (confirm-password "")) + (labels ((on-confirm-password-complete (confirm-passwd) + (when confirm-passwd + (setf confirm-password confirm-passwd)) + (if (string= confirm-password + new-password) + (tui:with-notify-errors + (os-utils:change-ssl-key-passphrase key-path old-password new-password) + (info-message (format nil (_ "Password changed for key ~a") key-path))) + (error-message (_ "password and confirmation does not match")))) + (on-new-password-complete (new-passwd) + (when new-passwd + (setf new-password new-passwd)) + (ask-string-input #'on-confirm-password-complete + :prompt (_ "confirm password: ") + :complete-fn #'complete:complete-always-empty + :hide-input t)) + (on-old-password-complete (old-passwd) + (when old-passwd + (setf old-password old-passwd)) + (ask-string-input #'on-new-password-complete + :prompt (_ "new password: ") + :complete-fn #'complete:complete-always-empty + :hide-input t))) + (ask-string-input #'on-old-password-complete + :prompt (_ "old password: ") + :complete-fn #'complete:complete-always-empty + :hide-input t))))) + + (defun gemini-certificate-information () (when-let* ((selected-row (line-oriented-window:selected-row-fields *gemini-certificates-window*))