-

private/racket-webview-qt.rkt

@@ -315,7 +315,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-struct rkt-wv
-  (win evt-queue callback [valid #:mutable])
+  (win evt-queue callback [valid #:mutable] [close-callback #:mutable])
   #:transparent
   )
 
@@ -337,14 +337,14 @@
         )
       'done))
 
-(define (rkt-webview-create parent evt-callback)
+(define (rkt-webview-create parent evt-callback close-callback)
   (let* ((evt-queue (make-queue))
          (parent-win (if (eq? parent #f) 0 (rkt-wv-win parent)))
          )
     (let ((wv (rkt_webview_create parent-win
                                   (λ (rkt-evt)
                                     (enqueue! evt-queue rkt-evt)))))
-      (let ((handle (make-rkt-wv wv evt-queue evt-callback #t)))
+      (let ((handle (make-rkt-wv wv evt-queue evt-callback #t close-callback)))
         (thread (λ ()
                   (sleep 1)
                   (letrec ((f (λ ()
@@ -365,6 +365,7 @@
 (define (rkt-webview-close handle)
   (rkt_webview_close (rkt-wv-win handle))
   (enqueue! (rkt-wv-evt-queue handle) 'quit)
+  ((rkt-wv-close-callback handle))
   #t)
 
 (define (rkt-webview-set-ou-token handle token)

private/racket-webview.rkt

@@ -229,8 +229,9 @@
       (let* ((cert-path (let ((p (build-path (find-system-path 'pref-dir) "racket-webview" (wv-context h))))
                           (make-directory* p)
                           p))
-             (f1 (build-path cert-path "self-signed.cert"))
+             (window-nr (wv-window-nr h))
-             (f2 (build-path cert-path "self-signed.key"))
+             (f1 (build-path cert-path (format "self-signed-~a.cert" window-nr)))
+             (f2 (build-path cert-path (format "self-signed-~a.key" window-nr)))
              (fh1 (open-output-file f1 #:exists 'replace #:permissions #o600))
              (fh2 (open-output-file f2 #:exists 'replace #:permissions #o600)))
         (display (certificate cert) fh1)
@@ -252,6 +253,19 @@
       )
   )
 
+(define (remove-cert-files h)
+  (let* ((cert-path (build-path (find-system-path 'pref-dir)
+                                "racket-webview"
+                                (wv-context h)))
+         (window-nr (wv-window-nr h))
+         (f1 (build-path cert-path (format "self-signed-~a.cert" window-nr)))
+         (f2 (build-path cert-path (format "self-signed-~a.key" window-nr)))
+         )
+    (delete-file f1)
+    (delete-file f2)
+    )
+  )
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Utilities
@@ -368,6 +382,15 @@
          (cert (generate-self-signed-cert 2048 365 '("127.0.0.1" "localhost")
                                           "NL" "Dijkema"
                                           #:ou (wv-cert-ou-token h)))
+         (event-processor (λ (wv evt)
+                            (event-callback h (util-parse-event evt))))
+         (close-callback (λ ()
+                           (remove-cert-files h)))
+         (ph (if (wv? p) (wv-handle p) #f))
+         (wv (let ((internal-handle (rkt-webview-create ph event-processor close-callback)))
+               (set-wv-handle! h internal-handle)
+               (set-wv-window-nr! h (rkt-wv-win internal-handle))
+               internal-handle))
          (channel (make-async-channel))
          (server (let ((s (start-web-server h channel cert)))
                    (sleep 1) ;;; TODO: Check if web server is up. 
@@ -375,14 +398,8 @@
          (port-nr (let ((pn (async-channel-get channel)))
                     (set-wv-port! h pn)
                     pn))
-         (event-processor (λ (wv evt)
-                            (event-callback h (util-parse-event evt))))
-         (ph (if (wv? p) (wv-handle p) #f))
-         (wv (rkt-webview-create ph event-processor))
          (base-req (format "https://127.0.0.1:~a" (wv-port h)))
          )
-    (set-wv-handle! h wv)
-    (set-wv-window-nr! h (rkt-wv-win wv))
     (set-wv-webserver-thread! h server)
     (rkt-webview-set-ou-token (wv-handle h) (wv-cert-ou-token h))
     (rkt-webview-set-url! (wv-handle h) base-req)