- [GUI] added menu command to shows certificates.

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)))

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

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)))

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)

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

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")