Made the FFI backend downloadable.
This commit is contained in:
153
private/racket-webview-downloader.rkt
Normal file
153
private/racket-webview-downloader.rkt
Normal file
@@ -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
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -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))
|
||||
|
||||
Reference in New Issue
Block a user