diff --git a/private/racket-webview-downloader.rkt b/private/racket-webview-downloader.rkt new file mode 100644 index 0000000..b06689b --- /dev/null +++ b/private/racket-webview-downloader.rkt @@ -0,0 +1,153 @@ +#lang racket/base + +(require setup/dirs + net/sendurl + net/url + net/url-connect + racket/file + racket/system + racket/string + file/unzip + ) + +(provide download-racket-webview-qt + racket-webview-qt-version + racket-webview-qt-directory + racket-webview-qt-is-available? + racket-webview-qt-is-downloadable? + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Version info of the version to download +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define rkt-qt-version-major 0) +(define rkt-qt-version-minor 1) +(define rkt-qt-version-patch 1) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Internal functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(define rkt-qt-download-version (format "~a-~a-~a" + rkt-qt-version-major + rkt-qt-version-minor + rkt-qt-version-patch + )) + +(define rkt-qt-download-site "git.dijkewijk.nl") +(define rkt-qt-base-path "hans/racket-webview-qt/releases/download") +(define rkt-qt-os (system-type 'os*)) +(define rkt-qt-arch (system-type 'arch)) + +(define rkt-download-url (format "https://~a/~a/~a/~a-~a.zip" + rkt-qt-download-site + rkt-qt-base-path + rkt-qt-download-version + rkt-qt-os + rkt-qt-arch)) + +(define install-path (build-path (find-system-path 'addon-dir) "racket-webview-qt")) +(define version-file (build-path install-path "version.txt")) +(define ffi-path (build-path install-path (format "~a-~a" rkt-qt-os rkt-qt-arch))) + +(define (download-port link) + (let ((current-https-prot (current-https-protocol))) + (current-https-protocol 'secure) + (let* ((url (string->url link)) + (port-in (get-pure-port url #:redirections 10))) + (current-https-protocol current-https-prot) + port-in))) + + +(define (do-download port-in port-out) + (letrec ((downloader-func (λ (count next-c len) + (let ((bytes (read-bytes 16384 port-in))) + (if (eof-object? bytes) + count + (let ((read-len (bytes-length bytes))) + (when (> read-len 0) + (set! count (+ count read-len)) + (when (> count next-c) + (display (format "~a..." count)) + (set! next-c (+ count len))) + (write-bytes bytes port-out) + ) + (downloader-func count next-c len))))) + )) + (let ((count (downloader-func 0 1000000 1000000))) + (displayln (format "~a downloaded" count)) + (close-input-port port-in) + (close-output-port port-out) + count) + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Provided functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (racket-webview-qt-is-available?) + (if (file-exists? version-file) + (with-handlers ([exn:fail? (λ (e) #f)]) + (let ((v (file->value version-file))) + (and + (= (car v) rkt-qt-version-major) + (= (cadr v) rkt-qt-version-minor) + (= (caddr v) rkt-qt-version-patch))) + ) + #f)) + +(define (racket-webview-qt-directory) + (if (racket-webview-qt-is-available?) + (build-path (format "~a/~a-~a" install-path rkt-qt-os rkt-qt-arch)) + #f)) + +(define (racket-webview-qt-version) + (if (racket-webview-qt-is-available?) + (file->value version-file) + #f)) + +(define (racket-webview-qt-is-downloadable?) + (let ((in (download-port rkt-download-url))) + (let ((d (input-port? in))) + (when d + (close-input-port in)) + d))) + +(define (download-racket-webview-qt) + (let ((in (download-port rkt-download-url))) + (unless (input-port? in) + (error (format "Cannot get a download port for '~a'" rkt-download-url))) + (unless (directory-exists? install-path) + (make-directory* install-path)) + (let* ((file (build-path install-path "archive.zip")) + (out (open-output-file file #:exists 'replace)) + ) + (displayln (format "Downloading racket-webview-qt (~a)..." rkt-download-url)) + (do-download in out) + (displayln (format "downloaded '~a'" file)) + (when (directory-exists? ffi-path) + (displayln (format "Removing existing directory '~a'" ffi-path)) + (delete-directory/files ffi-path)) + (displayln "Unzipping...") + (let ((cd (current-directory))) + (current-directory install-path) + (unzip file) + (current-directory cd)) + (displayln "Removing zip archive") + (delete-file file) + (displayln "Writing version") + (let ((version (list rkt-qt-version-major + rkt-qt-version-minor + rkt-qt-version-patch + ))) + (let ((out (open-output-file version-file #:exists 'replace))) + (write version out) + (close-output-port out))) + (displayln "Version file written; ready for FFI integration") + #t + ) + ) + ) diff --git a/private/racket-webview-qt.rkt b/private/racket-webview-qt.rkt index 75d80bf..7e32bcb 100644 --- a/private/racket-webview-qt.rkt +++ b/private/racket-webview-qt.rkt @@ -13,6 +13,7 @@ racket/string racket/path "utils.rkt" + "racket-webview-downloader.rkt" ) (provide rkt-wv @@ -54,62 +55,14 @@ (define lib-type 'release) +(unless (racket-webview-qt-is-available?) + (unless (racket-webview-qt-is-downloadable?) + (error (format "There is no version of the racket-webview Qt backend available for OS '~a', Architectur '~a'" + (system-type 'os*) + (system-type 'arch)))) + (download-racket-webview-qt)) + (define os (system-type 'os*)) -(define arch (system-type 'arch)) -(define supported-os '(windows linux)) - -(unless (ormap (λ (o) (eq? os o)) supported-os) - (error (format "OS currently not supported: ~a. Supported: ~a." os supported-os))) - -(define-runtime-path lib-dir "lib") - -#| -(define libraries-to-preload - (cond - ([eq? os 'windows] - '(Qt6Core.dll - Qt6Positioning.dll - Qt6Gui.dll - Qt6Widgets.dll - Qt6Svg.dll - Qt6Network.dll - Qt6OpenGL.dll - Qt6PrintSupport.dll - Qt6Qml.dll - Qt6QmlModels.dll - Qt6QmlWorkerScript.dll - Qt6QmlMeta.dll - Qt6Quick.dll - Qt6QuickWidgets.dll - Qt6WebChannel.dll - Qt6WebEngineCore.dll - Qt6WebEngineWidgets.dll - )) - ([eq? os 'linux] - '(libQt6XcbQpa - ;libQt6WaylandClient - ;libQt6EglFSDeviceIntegration - libQt6Core - libQt6Positioning - libQt6Gui - libQt6Widgets - libQt6Svg - libQt6Network - libQt6OpenGL - libQt6PrintSupport - libQt6Qml - libQt6QmlModels - libQt6QmlWorkerScript - libQt6QmlMeta - libQt6Quick - libQt6QuickWidgets - libQt6WebChannel - libQt6WebEngineCore - libQt6WebEngineWidgets - )) - ) - ) -|# (define ffi-library (cond @@ -118,7 +71,7 @@ ) ) -(define os-lib-dir (build-path lib-dir (symbol->string os) (symbol->string arch))) +(define os-lib-dir (racket-webview-qt-directory)) (let ((files (directory-list os-lib-dir))) (displayln (format "os-lib-dir: ~a" os-lib-dir)) @@ -127,7 +80,6 @@ (define (libname lib-symbol) (build-path os-lib-dir (symbol->string lib-symbol))) -; c:\qt\6.10.2\msvc2022_64\bin\windeployqt.exe rktwebview_qt_test.exe (define quiet-call #t) (define rktwebview-prg (if (eq? os 'windows) @@ -138,26 +90,6 @@ "QtWebEngineProcess.exe" "QtWebEngineProcess")) -;;; Preload libraries - -#| -(for-each (λ (lib-symbol) - (let* ((libn (if (list? lib-symbol) (car lib-symbol) lib-symbol)) - (versions (if (list? lib-symbol) (cons (cadr lib-symbol) '(#f)) (list #f))) - (load-lib (if (list? lib-symbol) - (if (eq? (caddr lib-symbol) #f) - (symbol->string libn) - (libname libn)) - (libname libn))) - ) - ;(displayln (format "loading ~a" load-lib)) - (ffi-lib load-lib versions - ;#:custodian (current-custodian)) - ) - ) - libraries-to-preload) -|# - ;;; Actual FFI integration (define webview-lib-file (libname ffi-library))