hans/racket-webview
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Better profile support, only 1 web server per context, multiple windows per context

Browse Source
This commit is contained in:
Hans Dijkema
2026-03-12 00:23:27 +01:00
parent 7d234bc834
commit d99c5a1725
13 changed files with 314 additions and 168 deletions
Download Patch File Download Diff File Expand all files Collapse all files

252
private/racket-webview.rkt
View File

@@ -5,6 +5,7 @@
"utils.rkt"
"mimetypes.rkt"
"rgba.rkt"
finalizer
racket/async-channel
web-server/http
web-server/servlet-dispatch
@@ -28,7 +29,8 @@
racket-self-signed-cert
)
(provide webview-create
(provide webview-new-context
webview-create
webview-devtools
webview-close
@@ -102,8 +104,8 @@
webview-version
wv-base-url
wv-window-nr
wv-context-base-url
wv-win-window-nr
test
)
@@ -118,32 +120,38 @@
(let ((file (build-path js-path "boilerplate.js")))
(file->string file)))
(define-struct wv
([handle #:mutable]
(define-struct wv-context
([context #:mutable]
[port #:mutable]
[window-nr #:mutable]
[file-getter #:mutable]
[boilerplate-js #:mutable]
[webserver-thread #:mutable]
[base-url #:mutable]
[request-count #:mutable]
[sec-token-cache #:mutable]
[cert-ou-token #:mutable]
)
#:transparent
)
(define-struct wv-win
([handle #:mutable]
[context #:mutable]
[window-nr #:mutable]
)
#:transparent)
(define (process-html wv-handle path out)
(let ((html (file->string path))
(boilerplate-js ((wv-boilerplate-js wv-handle))))
(set! html (string-replace html "<head>"
(string-append "<head>" "\n"
"<script>" "\n"
boilerplate-js "\n"
"</script>" "\n")))
(define (process-html context path out)
(let ((html (file->string path)))
(display html out)))
; (boilerplate-js ((wv-context-boilerplate-js wv-win-handle))))
; (set! html (string-replace html "<head>"
; (string-append "<head>" "\n"
; "<script>" "\n"
; boilerplate-js "\n"
; "</script>" "\n")))
; (display html out)))
(define (process-file wv-handle ext path out)
(define (process-file context ext path out)
(let ((content (file->bytes path)))
(display content out)))
@@ -185,11 +193,11 @@
)
)
(define (web-serve wv-handle req)
(define (web-serve context req)
(let* ((path (url->string (request-uri req)))
(file-getter (wv-file-getter wv-handle))
(file-getter (wv-context-file-getter context))
(token (get-security-token req))
(sec-cache (wv-sec-token-cache wv-handle))
(sec-cache (wv-context-sec-token-cache context))
(cache-empty? (lru-empty? sec-cache))
(token-in-cache? (not (or (eq? token #f)
(eq? (lru-has? sec-cache token) #f))))
@@ -212,8 +220,8 @@
#:headers (list (make-sec-header sec-cache))
(λ (out)
(if (or (eq? ext 'html) (eq? ext 'htm))
(process-html wv-handle file-to-serve out)
(process-file wv-handle ext file-to-serve out))
(process-html context file-to-serve out)
(process-file context ext file-to-serve out))
))
(response/output
#:code 404
@@ -238,12 +246,16 @@
)
)
)
(let* ((cert-path (let ((p (build-path (find-system-path 'pref-dir) "racket-webview" (wv-context h))))
(let* ((cert-path (let* ((context-nr (wv-context-context h))
(p (build-path (find-system-path 'pref-dir)
"racket-webview"
(format "context-~a" context-nr)))
)
(make-directory* p)
p))
(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)))
(context-nr (wv-context-context h))
(f1 (build-path cert-path (format "self-signed-~a.cert" context-nr)))
(f2 (build-path cert-path (format "self-signed-~a.key" context-nr)))
(fh1 (open-output-file f1 #:exists 'replace #:permissions #o600))
(fh2 (open-output-file f2 #:exists 'replace #:permissions #o600)))
(display (certificate cert) fh1)
@@ -266,12 +278,12 @@
)
(define (remove-cert-files h)
(let* ((cert-path (build-path (find-system-path 'pref-dir)
(let* ((context-nr (wv-context-context h))
(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)))
(format "context-~a" context-nr)))
(f1 (build-path cert-path (format "self-signed-~a.cert" context-nr)))
(f2 (build-path cert-path (format "self-signed-~a.key" context-nr)))
)
(when (file-exists? f1)
(delete-file f1))
@@ -387,68 +399,96 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Webview functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (webview-create context file-getter event-callback
#:boilerplate-js [bj (λ () (default-boilerplate-js))]
#:parent [p #f])
(->* ((or/c symbol? string?) procedure? procedure?)
(#:boilerplate-js procedure? #:parent (or/c wv? #f))
wv?)
(let* ((h (make-wv #f 0 -1 file-getter bj #f #f 0 (make-lru 250 #:cmp eq?)
(symbol->string (make-security-token)) (symbol->string context)))
(define/contract (webview-new-context file-getter
#:boilerplate-js [bj (default-boilerplate-js)])
(->* (procedure?) (#:boilerplate-js string?) wv-context?)
(let* ((h (make-wv-context 0 0 file-getter #f #f 0
(make-lru 250 #:cmp eq?)
(symbol->string (make-security-token))
))
(cert (generate-self-signed-cert 2048 365 '("127.0.0.1" "localhost")
"NL" "Dijkema"
#:ou (wv-cert-ou-token h)))
#:ou (wv-context-cert-ou-token h)))
(server-cert (certificate cert))
(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 server-cert)))
(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.
(sleep 1) ;;; ToDO Check if server is up
s))
(port-nr (let ((pn (async-channel-get channel)))
(set-wv-port! h pn)
(set-wv-context-port! h pn)
pn))
(base-req (format "https://127.0.0.1:~a" (wv-port h)))
(base-req (format "https://127.0.0.1:~a" (wv-context-port h)))
)
(set-wv-webserver-thread! h server)
(set-wv-base-url! h base-req)
(rkt-webview-set-ou-token (wv-handle h) (wv-cert-ou-token h))
(rkt-webview-set-url! (wv-handle h) base-req)
(set-wv-context-context! h (rkt-webview-new-context bj server-cert))
(set-wv-context-webserver-thread! h server)
(set-wv-context-base-url! h base-req)
(register-finalizer h (λ (h) (remove-cert-files h)))
h))
;([context #:mutable]
; [port #:mutable]
; [file-getter #:mutable]
; [webserver-thread #:mutable]
; [base-url #:mutable]
; [request-count #:mutable]
; [sec-token-cache #:mutable]
; [cert-ou-token #:mutable]
;(define-struct wv
; ([handle #:mutable]
; [context #:mutable]
; [window-nr #:mutable]
; )
; #:transparent)
(define/contract (webview-create context url-path event-callback
#:parent [p #f])
(->* (wv-context? string? procedure?)
(#:parent (or/c wv-win? #f))
wv-win?)
(let* ((h (make-wv-win #f context -1))
(event-processor (λ (wv evt)
(event-callback h (util-parse-event evt))))
(close-callback (λ () #t))
(ph (if (wv-win? p) (wv-win-handle p) #f))
(context-nr (wv-context-context context))
(wv (let ((internal-handle (rkt-webview-create context-nr ph event-processor close-callback)))
(set-wv-win-handle! h internal-handle)
(set-wv-win-window-nr! h (rkt-wv-win internal-handle))
internal-handle))
)
(rkt-webview-set-ou-token (wv-win-handle h) (wv-context-cert-ou-token context))
(webview-set-url! h url-path)
h)
)
(define/contract (webview-devtools wv)
(-> wv? symbol?)
(rkt-webview-open-devtools (wv-handle wv)))
(-> wv-win? symbol?)
(rkt-webview-open-devtools (wv-win-handle wv)))
(define/contract (webview-move wv x y)
(-> wv? number? number? symbol?)
(rkt-webview-move (wv-handle wv) x y))
(-> wv-win? number? number? symbol?)
(rkt-webview-move (wv-win-handle wv) x y))
(define/contract (webview-resize wv w h)
(-> wv? number? number? symbol?)
(rkt-webview-resize (wv-handle wv) w h))
(-> wv-win? number? number? symbol?)
(rkt-webview-resize (wv-win-handle wv) w h))
(define/contract (webview-set-html! wv html)
(-> wv? (or/c string? xexpr?) symbol?)
(-> wv-win? (or/c string? xexpr?) symbol?)
(if (string? html)
(rkt-webview-set-html! (wv-handle wv) html)
(rkt-webview-set-html! (wv-handle wv) (xexpr->string html))
(rkt-webview-set-html! (wv-win-handle wv) html)
(rkt-webview-set-html! (wv-win-handle wv) (xexpr->string html))
)
)
(define/contract (webview-set-url! wv url)
(-> wv? (or/c string? url?) symbol?)
(let ((u (if (string? url) (string->url url) url))
(bu (string->url (wv-base-url wv))))
(-> wv-win? (or/c string? url?) symbol?)
(let* ((u (if (string? url) (string->url url) url))
(c (wv-win-context wv))
(bu (string->url (wv-context-base-url c))))
(when (or (eq? (url-scheme u) #f) (eq? (url-host u) #f))
(set-url-host! u (url-host bu))
(set-url-port! u (url-port bu))
@@ -457,27 +497,27 @@
)
(when (eq? (url-scheme u) #f)
(set-url-scheme! (url-scheme bu)))
(rkt-webview-set-url! (wv-handle wv) (url->string u))
(rkt-webview-set-url! (wv-win-handle wv) (url->string u))
)
)
(define/contract (webview-navigate! wv place)
(-> wv? string? symbol?)
(-> wv-win? string? symbol?)
(webview-run-js wv
(format "window.location = '~a';"
(esc-quote place))))
(define/contract (webview-base-url wv)
(-> wv? url?)
(string->url (wv-base-url wv)))
(-> wv-win? url?)
(string->url (wv-context-base-url (wv-win-context wv))))
(define-syntax def-win-func
(syntax-rules ()
((_ name name-to-wrap)
(define/contract (name wv)
(-> wv? symbol?)
(name-to-wrap (wv-handle wv))))))
(-> wv-win? symbol?)
(name-to-wrap (wv-win-handle wv))))))
(def-win-func webview-show rkt-webview-show)
(def-win-func webview-hide rkt-webview-hide)
@@ -488,9 +528,9 @@
(def-win-func webview-window-state rkt-webview-window-state)
(define/contract (webview-choose-dir wv title base-dir)
(-> wv? string? (or/c path? string?) (or/c hash? boolean?))
(-> wv-win? string? (or/c path? string?) (or/c hash? boolean?))
(let ((bd (if (path? base-dir) (path->string base-dir) base-dir)))
(let ((res (rkt-webview-choose-dir (wv-handle wv) title bd)))
(let ((res (rkt-webview-choose-dir (wv-win-handle wv) title bd)))
(if (eq? res #f)
#f
(cond ((eq? (car res) 'oke)
@@ -506,7 +546,7 @@
(define (file-open-save wv title base-dir permitted-exts open-save-f)
(let* ((bd (if (path? base-dir) (path->string base-dir) base-dir))
(ext-filter (make-exts-filter permitted-exts)))
(let ((res (open-save-f (wv-handle wv) title bd ext-filter)))
(let ((res (open-save-f (wv-win-handle wv) title bd ext-filter)))
(if (eq? res #f)
#f
(cond ((eq? (car res) 'oke)
@@ -522,30 +562,29 @@
(define/contract (webview-file-open wv title base-dir permitted-exts)
(-> wv? string? (or/c path? string?) (or/c wv-permitted-exts? wv-list-of-permitted-exts?)
(-> wv-win? string? (or/c path? string?) (or/c wv-permitted-exts? wv-list-of-permitted-exts?)
(or/c hash? boolean?))
(file-open-save wv title base-dir permitted-exts rkt-webview-file-open))
(define/contract (webview-file-save wv title base-dir permitted-exts)
(-> wv? string? (or/c path? string?) (or/c wv-permitted-exts? wv-list-of-permitted-exts?)
(-> wv-win? string? (or/c path? string?) (or/c wv-permitted-exts? wv-list-of-permitted-exts?)
(or/c hash? boolean?))
(file-open-save wv title base-dir permitted-exts rkt-webview-file-save))
(define/contract (webview-set-title! wv title)
(-> wv? string? symbol?)
(rkt-webview-set-title! (wv-handle wv) title))
(-> wv-win? string? symbol?)
(rkt-webview-set-title! (wv-win-handle wv) title))
(define/contract (webview-close wv)
(-> wv? symbol?)
(-> wv-win? symbol?)
(begin
(rkt-webview-close (wv-handle wv))
(kill-thread (wv-webserver-thread wv))
(rkt-webview-close (wv-win-handle wv))
'oke))
(define/contract (webview-bind! wv selector event)
(-> wv? (or/c symbol? string?) (or/c symbol? list-of-symbol?) list?)
(-> wv-win? (or/c symbol? string?) (or/c symbol? list-of-symbol?) list?)
(let* ((sel (if (symbol? selector)
(format "#~a" selector)
selector))
@@ -555,13 +594,13 @@
)
(let ((r (webview-call-js wv
(format "return window.rkt_bind_evt_ids(~a, '~a', ~a)"
(wv-window-nr wv) sel evt))))
(wv-win-window-nr wv) sel evt))))
(map (λ (el)
(list (string->symbol (car el)) (cadr el) (caddr el)))
r))))
(define/contract (webview-unbind! wv selector event)
(-> wv? (or/c symbol? string?) (or/c symbol? list-of-symbol?) list?)
(-> wv-win? (or/c symbol? string?) (or/c symbol? list-of-symbol?) list?)
(let* ((sel (if (symbol? selector)
(format "#~a" selector)
selector))
@@ -571,14 +610,14 @@
)
(let ((r (webview-call-js wv
(format "return window.rkt_unbind_evt_ids(~a, '~a', ~a)"
(wv-window-nr wv) sel evt))))
(wv-win-window-nr wv) sel evt))))
(map (λ (el)
(list (string->symbol (car el)) (cadr el) (caddr el)))
r))))
(define/contract (webview-run-js wv js)
(-> wv? string? symbol?)
(rkt-webview-run-js (wv-handle wv) js))
(-> wv-win? string? symbol?)
(rkt-webview-run-js (wv-win-handle wv) js))
(define (webview-standard-file-getter base-path
#:not-exist [on-not-exist (λ (file base-path path) path)]
@@ -594,8 +633,8 @@
(define (webview-call-js wv js)
(-> wv? string? (or/c string? list? boolean? hash?))
(let ((result (rkt-webview-call-js (wv-handle wv) js)))
(-> wv-win? string? (or/c string? list? boolean? hash?))
(let ((result (rkt-webview-call-js (wv-win-handle wv) js)))
(if (webview-call-js-result? result)
(if (eq? (car result) 'oke)
(hash-ref (fromJson (cadr result)) 'result #f)
@@ -614,7 +653,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (webview-set-innerHTML! wv id html)
(-> wv? symbol? (or/c string? xexpr?) symbol?)
(-> wv-win? symbol? (or/c string? xexpr?) symbol?)
(if (string? html)
(webview-run-js wv
(with-id id el
@@ -624,7 +663,7 @@
)
(define/contract (webview-set-value! wv id val)
(-> wv? symbol? (or/c symbol? string? number? boolean? g:date? g:time? g:datetime? rgba?) symbol?)
(-> wv-win? symbol? (or/c symbol? string? number? boolean? g:date? g:time? g:datetime? rgba?) symbol?)
(webview-run-js wv
(with-id id el
((string-append
@@ -651,7 +690,7 @@
)
(define/contract (webview-value wv id)
(-> wv? symbol? (or/c string? boolean?))
(-> wv-win? symbol? (or/c string? boolean?))
(let ((v (webview-call-js wv
(with-id id el
((string-append "let f = function() {\n"
@@ -670,7 +709,7 @@
(syntax-rules ()
((_ name type-pred? convert)
(define/contract (name wv id)
(-> wv? symbol? (or/c type-pred? boolean?))
(-> wv-win? symbol? (or/c type-pred? boolean?))
(let ((v (webview-value wv id)))
(if (eq? v #f)
#f
@@ -689,7 +728,7 @@
(define/contract (webview-add-class! wv id-or-selector class)
(-> wv? (or/c symbol? string?) (or/c symbol? string? list?) hash?)
(-> wv-win? (or/c symbol? string?) (or/c symbol? string? list?) hash?)
(let ((sel (if (symbol? id-or-selector)
(format "#~a" id-or-selector)
id-or-selector))
@@ -709,7 +748,7 @@
)
(define/contract (webview-remove-class! wv id-or-selector class)
(-> wv? (or/c symbol? string?) (or/c symbol? string? list?) hash?)
(-> wv-win? (or/c symbol? string?) (or/c symbol? string? list?) hash?)
(let ((sel (if (symbol? id-or-selector)
(format "#~a" id-or-selector)
id-or-selector))
@@ -731,7 +770,7 @@
)
(define/contract (webview-set-style! wv selector style-entries)
(-> wv? (or/c symbol? string?) (or/c kv? list-of-kv?) hash?)
(-> wv-win? (or/c symbol? string?) (or/c kv? list-of-kv?) hash?)
(let ((sel (if (symbol? selector)
(format "#~a" selector)
selector))
@@ -755,7 +794,7 @@
)
(define/contract (webview-get-style wv selector styles)
(-> wv? (or/c symbol? string?) (or/c symbol? list-of-symbol?) (or/c list? hash?))
(-> wv-win? (or/c symbol? string?) (or/c symbol? list-of-symbol?) (or/c list? hash?))
(let ((sel (if (symbol? selector)
(format "#~a" selector)
selector))
@@ -788,7 +827,7 @@
(define/contract (webview-unset-style! wv selector style-entries)
(-> wv? (or/c symbol? string?) (or/c symbol? list-of-symbol?) hash?)
(-> wv-win? (or/c symbol? string?) (or/c symbol? list-of-symbol?) hash?)
(let ((sel (if (symbol? selector)
(format "#~a" selector)
selector))
@@ -813,7 +852,7 @@
)
(define/contract (webview-set-attr! wv selector attr-entries)
(-> wv? (or/c symbol? string?)
(-> wv-win? (or/c symbol? string?)
(or/c kv? list-of-kv?) hash?)
(let* ((sel (if (symbol? selector)
(format "#~a" selector)
@@ -847,7 +886,7 @@
)
(define/contract (webview-attr wv id attr)
(-> wv? symbol? (or/c symbol? string?) (or/c string? boolean?))
(-> wv-win? symbol? (or/c symbol? string?) (or/c string? boolean?))
(let ((v (webview-call-js wv
(with-id id el
-> (format "el.getAttribute('~a');" attr))
@@ -862,7 +901,7 @@
(syntax-rules ()
((_ name type-pred? convert)
(define/contract (name wv id attr)
(-> wv? symbol? (or/c symbol? string?) (or/c type-pred? boolean?))
(-> wv-win? symbol? (or/c symbol? string?) (or/c type-pred? boolean?))
(let ((v (webview-attr wv id attr)))
(if (eq? v #f)
#f
@@ -891,11 +930,14 @@
(define file-getter (webview-standard-file-getter example-path))
(define test-context (webview-new-context file-getter))
(define (test)
(let* ((cb (λ (handle evt)
(displayln evt)))
(h (webview-create 'test file-getter cb))
(h (webview-create test-context "index.html" cb))
)
(displayln h)
(webview-set-title! h "This is a test window")
(webview-resize h 800 600)
(webview-move h 350 220)