From 5282e2cf86e0a221334c748198a80114be4572b5 Mon Sep 17 00:00:00 2001 From: cage Date: Tue, 21 Mar 2023 17:49:58 +0100 Subject: [PATCH] - [GUI] added menu command to shows certificates. --- src/gui/client/certificates-window.lisp | 39 +++++++++++++++++++ src/gui/client/main-window.lisp | 10 +++-- src/gui/client/menu-command.lisp | 7 ++++ .../public-api-gemini-certificates.lisp | 13 ++++++- src/package.lisp | 23 ++++++++++- tinmop.asd | 1 + 6 files changed, 87 insertions(+), 6 deletions(-) create mode 100644 src/gui/client/certificates-window.lisp diff --git a/src/gui/client/certificates-window.lisp b/src/gui/client/certificates-window.lisp new file mode 100644 index 0000000..b1a5e4f --- /dev/null +++ b/src/gui/client/certificates-window.lisp @@ -0,0 +1,39 @@ +(in-package :client-certificates-window) + +(named-readtables:in-readtable nodgui.syntax:nodgui-syntax) + +(defclass certificate-frame (gui:frame) + ((tree + :accessor tree + :initform nil + :initarg :tree) + (rows + :accessor rows + :initform '() + :initarg :rows))) + +(defmethod initialize-instance :after ((object certificate-frame) &key) + (with-accessors ((tree tree) + (rows rows)) object + (let ((treeview (make-instance 'gui:scrolled-treeview + :master object + :pack '(:side :top :expand t :fill :both) + :columns (list (_ "File") + (_ "Fingerprint"))))) + (gui:treeview-heading treeview gui:+treeview-first-column-id+ + :text (_ "Address")) + (loop for row in rows do + (let* ((tree-row (make-instance 'gui:tree-item + :id (db:row-cache-key row) + :text (db:row-cache-key row) + :column-values (list (getf row :file) + (getf row :hash)) + :index gui:+treeview-last-index+))) + (gui:treeview-insert-item treeview :item tree-row))) + (setf tree treeview) + object))) + +(defun init-window (master rows) + (gui:with-modal-toplevel (toplevel :master master :title (_ "Certificates")) + (gui:transient toplevel master) + (gui:grid (make-instance 'certificate-frame :master toplevel :rows rows) 0 0))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index e55981f..bfd70a9 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -194,10 +194,12 @@ (defun initialize-menu (parent) (with-accessors ((main-window main-window)) parent (let* ((bar (gui:make-menubar parent)) - (file (gui:make-menu bar (_ "File") :underline 0)) - (help (gui:make-menu bar (_ "Help") :underline 0))) - (gui:make-menubutton file (_ "Quit") #'menu:quit :underline 0) - (gui:make-menubutton help (_ "About") #'menu:help-about :underline 0)))) + (file (gui:make-menu bar (_ "File") :underline 0)) + (tools (gui:make-menu bar (_ "Tools") :underline 0)) + (help (gui:make-menu bar (_ "Help") :underline 0))) + (gui:make-menubutton tools (_ "Certificates") #'menu:show-certificates :underline 0) + (gui:make-menubutton file (_ "Quit") #'menu:quit :underline 0) + (gui:make-menubutton help (_ "About") #'menu:help-about :underline 0)))) (defclass tool-bar (gui:frame) ((iri-entry diff --git a/src/gui/client/menu-command.lisp b/src/gui/client/menu-command.lisp index be34e19..2baa0d3 100644 --- a/src/gui/client/menu-command.lisp +++ b/src/gui/client/menu-command.lisp @@ -16,3 +16,10 @@ (gui:break-mainloop) (client-events:stop-events-loop) (comm:close-server)) + +(defun show-certificates () + (let ((master gui-goodies:*toplevel*) + (rows (cev:enqueue-request-and-wait-results :gemini-certificates + 1 + ev:+maximum-event-priority+))) + (client-certificates-window:init-window master rows))) diff --git a/src/gui/server/public-api-gemini-certificates.lisp b/src/gui/server/public-api-gemini-certificates.lisp index 4f470ad..653ae56 100644 --- a/src/gui/server/public-api-gemini-certificates.lisp +++ b/src/gui/server/public-api-gemini-certificates.lisp @@ -29,7 +29,18 @@ (yason:encode-array-element certificate)))))) (defun gemini-certificates () - (make-instance 'gemini-certificates :contents (db:find-tls-certificates-rows))) + (let* ((certificates-rows (sort (db:find-tls-certificates-rows) + (lambda (a b) + (string< (db:row-cache-key a) + (db:row-cache-key b))))) + (certificates-with-hash (loop for certificate-row in certificates-rows + collect + (let* ((cache-key (db:row-cache-key certificate-row)) + (pem-file (gemini-client::tls-cert-find cache-key)) + (hash (x509:certificate-fingerprint pem-file))) + (append (list :hash hash :file pem-file) + certificate-row))))) + (make-instance 'gemini-certificates :contents certificates-with-hash))) (defun invalidate-cached-value (cache-key) (db:cache-invalidate cache-key) diff --git a/src/package.lisp b/src/package.lisp index 1b4ed89..6260c34 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3377,6 +3377,7 @@ :misc-utils) (:local-nicknames (:comm :json-rpc-communication) (:ev :program-events) + (:cev :client-events) (:re :cl-ppcre) (:a :alexandria) (:gui :nodgui) @@ -3384,7 +3385,27 @@ (:gui-shapes :nodgui.shapes)) (:export :help-about - :quit)) + :quit + :show-certificates)) + +(defpackage :client-certificates-window + (:use + :cl + :config + :constants + :text-utils + :misc-utils) + (:local-nicknames (:comm :json-rpc-communication) + (:re :cl-ppcre) + (:a :alexandria) + (:ev :program-events) + (:cev :client-events) + (:gui :nodgui) + (:gui-mw :nodgui.mw) + (:gui-shapes :nodgui.shapes) + (:menu :client-menu-command)) + (:export + :init-window)) (defpackage :client-main-window (:use diff --git a/tinmop.asd b/tinmop.asd index a60085a..1b18b47 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -165,6 +165,7 @@ (:file "json-rpc-communication") (:file "validation") (:file "icons") + (:file "certificates-window") (:file "menu-command") (:file "main-window"))) (:file "main")