mirror of https://codeberg.org/cage/tinmop/
- [GUI] added button to delete and import gemini gertificates.
This commit is contained in:
cage
parent
5282e2cf86
commit
902cf57657
|
|
@ -12,28 +12,90 @@
|
|||
:initform '()
|
||||
:initarg :rows)))
|
||||
|
||||
(defun resync-rows (certificate-frame new-rows)
|
||||
(with-accessors ((tree tree)
|
||||
(rows rows)) certificate-frame
|
||||
(gui:treeview-delete-all tree)
|
||||
(setf rows new-rows)
|
||||
(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 tree :item tree-row))))
|
||||
certificate-frame)
|
||||
|
||||
(defun all-rows ()
|
||||
(cev:enqueue-request-and-wait-results :gemini-certificates
|
||||
1
|
||||
ev:+standard-event-priority+))
|
||||
|
||||
(defmethod initialize-instance :after ((object certificate-frame) &key)
|
||||
(with-accessors ((tree tree)
|
||||
(rows rows)) object
|
||||
(let ((treeview (make-instance 'gui:scrolled-treeview
|
||||
(let ((new-rows (all-rows))
|
||||
(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)
|
||||
(gui:treeview-heading tree gui:+treeview-first-column-id+
|
||||
:text (_ "Address"))
|
||||
(resync-rows object new-rows)
|
||||
object)))
|
||||
|
||||
(defun init-window (master rows)
|
||||
(defun delete-certificates-clsr (certificate-frame)
|
||||
(lambda ()
|
||||
(a:when-let* ((selections (gui:treeview-get-selection (tree certificate-frame))))
|
||||
(loop for selection in selections do
|
||||
(let ((url (gui:id selection)))
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(comm:make-request :gemini-delete-certificate
|
||||
1
|
||||
url))
|
||||
(let ((new-rows (all-rows)))
|
||||
(resync-rows certificate-frame new-rows)))))))
|
||||
|
||||
(defun import-certificates-clsr (certificate-frame)
|
||||
(lambda ()
|
||||
(a:when-let* ((uri (gui-mw:text-input-dialog certificate-frame
|
||||
(_ "Information")
|
||||
(_ "Type the net address the certificate is valid for:")))
|
||||
(cert-file (gui:get-open-file :initial-dir "."
|
||||
:parent certificate-frame
|
||||
:multiple nil
|
||||
:title (_ "Choose the certificate file")))
|
||||
(key-file (gui:get-open-file :initial-dir (fs:parent-dir-path cert-file)
|
||||
:parent certificate-frame
|
||||
:multiple nil
|
||||
:title (_ "Choose the private key file"))))
|
||||
(handler-case
|
||||
(progn
|
||||
(cev:enqueue-request-and-wait-results :gemini-import-certificate
|
||||
1
|
||||
ev:+standard-event-priority+
|
||||
uri
|
||||
cert-file
|
||||
key-file)
|
||||
(resync-rows certificate-frame (all-rows)))
|
||||
(error (e)
|
||||
(client-main-window::notify-request-error e))))))
|
||||
|
||||
(defun init-window (master)
|
||||
(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)))
|
||||
(let* ((table (make-instance 'certificate-frame :master toplevel))
|
||||
(delete-button (make-instance 'gui:button
|
||||
:master toplevel
|
||||
:image icons:*document-delete*
|
||||
:command (delete-certificates-clsr table)))
|
||||
(import-button (make-instance 'gui:button
|
||||
:master toplevel
|
||||
:image icons:*document-add*
|
||||
:command (import-certificates-clsr table))))
|
||||
(gui:grid table 0 0 :sticky :news :columnspan 2)
|
||||
(gui:grid delete-button 1 0 :sticky :w)
|
||||
(gui:grid import-button 1 1 :sticky :w))))
|
||||
|
|
|
|||
|
|
@ -1,30 +1,38 @@
|
|||
(in-package :icons)
|
||||
|
||||
(a:define-constant +icon-dir+ "/data/icons/" :test #'string=)
|
||||
(a:define-constant +icon-dir+ "/data/icons/" :test #'string=)
|
||||
|
||||
(a:define-constant +search+ "fmw_search" :test #'string=)
|
||||
(a:define-constant +search+ "fmw_search" :test #'string=)
|
||||
|
||||
(a:define-constant +back+ "fmw_back" :test #'string=)
|
||||
(a:define-constant +back+ "fmw_back" :test #'string=)
|
||||
|
||||
(a:define-constant +go+ "fmw_go" :test #'string=)
|
||||
(a:define-constant +go+ "fmw_go" :test #'string=)
|
||||
|
||||
(a:define-constant +open-tour+ "fmw_open_tour" :test #'string=)
|
||||
(a:define-constant +open-tour+ "fmw_open_tour" :test #'string=)
|
||||
|
||||
(a:define-constant +refresh+ "fmw_refresh" :test #'string=)
|
||||
(a:define-constant +refresh+ "fmw_refresh" :test #'string=)
|
||||
|
||||
(a:define-constant +up+ "fmw_uparrow" :test #'string=)
|
||||
(a:define-constant +up+ "fmw_uparrow" :test #'string=)
|
||||
|
||||
(defparameter *search* nil)
|
||||
(a:define-constant +document-delete+ "fmw_document-delete" :test #'string=)
|
||||
|
||||
(defparameter *back* nil)
|
||||
(a:define-constant +document-add+ "fmw_document-add" :test #'string=)
|
||||
|
||||
(defparameter *open-iri* nil)
|
||||
(defparameter *search* nil)
|
||||
|
||||
(defparameter *open-tour* nil)
|
||||
(defparameter *back* nil)
|
||||
|
||||
(defparameter *refresh* nil)
|
||||
(defparameter *open-iri* nil)
|
||||
|
||||
(defparameter *up* nil)
|
||||
(defparameter *open-tour* nil)
|
||||
|
||||
(defparameter *refresh* nil)
|
||||
|
||||
(defparameter *up* nil)
|
||||
|
||||
(defparameter *document-delete* nil)
|
||||
|
||||
(defparameter *document-add* nil)
|
||||
|
||||
(defun load-icon (filename)
|
||||
(let ((path (if (not (re:scan "(?i)png$" filename))
|
||||
|
|
@ -36,9 +44,11 @@
|
|||
(gui:make-image data)))))
|
||||
|
||||
(defun load-icons ()
|
||||
(setf *search* (load-icon +search+))
|
||||
(setf *back* (load-icon +back+))
|
||||
(setf *open-iri* (load-icon +go+))
|
||||
(setf *open-tour* (load-icon +open-tour+))
|
||||
(setf *refresh* (load-icon +refresh+))
|
||||
(setf *up* (load-icon +up+)))
|
||||
(setf *search* (load-icon +search+))
|
||||
(setf *back* (load-icon +back+))
|
||||
(setf *open-iri* (load-icon +go+))
|
||||
(setf *open-tour* (load-icon +open-tour+))
|
||||
(setf *refresh* (load-icon +refresh+))
|
||||
(setf *up* (load-icon +up+))
|
||||
(setf *document-delete* (load-icon +document-delete+))
|
||||
(setf *document-add* (load-icon +document-add+)))
|
||||
|
|
|
|||
|
|
@ -87,8 +87,9 @@
|
|||
:code code
|
||||
:data data
|
||||
:text message))
|
||||
(values (rpc:extract-results raw-response)
|
||||
raw-response)))))
|
||||
(progn
|
||||
(values (rpc:extract-results raw-response)
|
||||
raw-response))))))
|
||||
|
||||
(defun close-server ()
|
||||
(make-request :quit-program 1))
|
||||
|
|
|
|||
|
|
@ -18,8 +18,5 @@
|
|||
(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)))
|
||||
(let ((master gui-goodies:*toplevel*))
|
||||
(client-certificates-window:init-window master)))
|
||||
|
|
|
|||
|
|
@ -48,3 +48,21 @@
|
|||
|
||||
(defun gemini-delete-certificate (cache-key)
|
||||
(invalidate-cached-value cache-key))
|
||||
|
||||
(defun gemini-import-certificate (uri cert-file key-file)
|
||||
(db-utils:with-ready-database (:connect nil)
|
||||
(if (gemini-parser:gemini-iri-p uri)
|
||||
(let* ((id (to-s (db:cache-put uri +cache-tls-certificate-type+)))
|
||||
(cert-filename (fs:path-last-element cert-file))
|
||||
(key-filename (fs:path-last-element key-file))
|
||||
(cache-dir (os-utils:cached-file-path id))
|
||||
(cert-out-path (strcat cache-dir
|
||||
fs:*directory-sep*
|
||||
cert-filename))
|
||||
(key-out-path (strcat cache-dir
|
||||
fs:*directory-sep*
|
||||
key-filename)))
|
||||
(fs:make-directory cache-dir)
|
||||
(fs:copy-a-file cert-file cert-out-path :overwrite t)
|
||||
(fs:copy-a-file key-file key-out-path :overwrite t))
|
||||
(error (format nil (_ "~s is not a valid gemini address") uri)))))
|
||||
|
|
|
|||
|
|
@ -69,6 +69,11 @@
|
|||
(gen-rpc "gemini-delete-certificate"
|
||||
'gemini-delete-certificate
|
||||
"cache-key" 0)
|
||||
(gen-rpc "gemini-import-certificate"
|
||||
'gemini-import-certificate
|
||||
"uri" 0
|
||||
"cert-file" 1
|
||||
"key-file" 2)
|
||||
(gen-rpc "gemini-table-of-contents"
|
||||
'gemini-table-of-contents
|
||||
"iri" 0
|
||||
|
|
|
|||
|
|
@ -3318,7 +3318,9 @@
|
|||
:*open-iri*
|
||||
:*open-tour*
|
||||
:*refresh*
|
||||
:*up*))
|
||||
:*up*
|
||||
:*document-delete*
|
||||
:*document-add*))
|
||||
|
||||
(defpackage :validation
|
||||
(:use
|
||||
|
|
|
|||
|
|
@ -235,7 +235,7 @@
|
|||
|
||||
(defclass blocking-caller-event (event-on-own-thread function-event)
|
||||
((results
|
||||
:initform (make-instance 'box:box)
|
||||
:initform (make-instance 'box:box :contents :nothing)
|
||||
:initarg :results
|
||||
:accessor results)))
|
||||
|
||||
|
|
@ -265,7 +265,7 @@
|
|||
(funcall push-event-fn event)
|
||||
(with-lock (lock)
|
||||
(loop
|
||||
while (null (box:unbox (results event)))
|
||||
while (eq (box:unbox (results event)) :nothing)
|
||||
do
|
||||
(bt:condition-wait condition-variable lock)))
|
||||
(let* ((event-results (results event))
|
||||
|
|
|
|||
Loading…
Reference in New Issue