From cbb2220b322797d057791e03818f16ee6277cc83 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Mon, 9 Mar 2026 10:30:32 +0100 Subject: [PATCH] - --- private/racket-webview-qt.rkt | 7 ++++--- private/racket-webview.rkt | 33 +++++++++++++++++++++++++-------- 2 files changed, 29 insertions(+), 11 deletions(-) diff --git a/private/racket-webview-qt.rkt b/private/racket-webview-qt.rkt index 222dcd0..003e56b 100644 --- a/private/racket-webview-qt.rkt +++ b/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) diff --git a/private/racket-webview.rkt b/private/racket-webview.rkt index dab6b94..3d23f31 100644 --- a/private/racket-webview.rkt +++ b/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")) - (f2 (build-path cert-path "self-signed.key")) + (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))) (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)