Make sure when the backend cannot be downloaded or the site resolved that we're forgiving until we try to use the provided FFI functions.
This commit is contained in:
@@ -4,6 +4,7 @@
|
||||
net/sendurl
|
||||
net/url
|
||||
net/url-connect
|
||||
net/dns
|
||||
racket/file
|
||||
racket/system
|
||||
racket/string
|
||||
@@ -15,6 +16,7 @@
|
||||
racket-webview-qt-directory
|
||||
racket-webview-qt-is-available?
|
||||
racket-webview-qt-is-downloadable?
|
||||
racket-webview-qt-resolves?
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -101,20 +103,30 @@
|
||||
|
||||
(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))
|
||||
(build-path install-path (format "~a-~a" rkt-qt-os rkt-qt-arch))
|
||||
#f))
|
||||
|
||||
(define (racket-webview-qt-resolves?)
|
||||
(if (eq? (dns-find-nameserver) #f)
|
||||
#f
|
||||
(with-handlers ([exn:fail? (λ (e) #f)])
|
||||
(dns-get-address (dns-find-nameserver) rkt-qt-download-site)
|
||||
#t)
|
||||
)
|
||||
)
|
||||
|
||||
(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)))
|
||||
(with-handlers ([exn:fail? (λ (e) #f)])
|
||||
(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)))
|
||||
|
||||
@@ -14,6 +14,7 @@
|
||||
racket/path
|
||||
"utils.rkt"
|
||||
"racket-webview-downloader.rkt"
|
||||
openssl/libssl
|
||||
)
|
||||
|
||||
(provide rkt-wv
|
||||
@@ -55,12 +56,44 @@
|
||||
|
||||
(define lib-type 'release)
|
||||
|
||||
;; Check if racket-webview-qt backend is available or downloadable
|
||||
|
||||
(define do-ffi #t)
|
||||
(define reason "")
|
||||
|
||||
(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))
|
||||
(if (racket-webview-qt-resolves?)
|
||||
(if (racket-webview-qt-is-downloadable?)
|
||||
(begin
|
||||
(set! do-ffi (download-racket-webview-qt))
|
||||
(when (eq? do-ffi #f)
|
||||
(set! reason "Racket Webview Qt backend could not be downloaded"))
|
||||
)
|
||||
(begin
|
||||
(displayln "There is no version of the racket-webview Qt backend available\n")
|
||||
(displayln
|
||||
(format "for OS '~a', Architecture '~a'"
|
||||
(system-type 'os*)
|
||||
(system-type 'arch)))
|
||||
(set! do-ffi #f)
|
||||
(set! reason (format
|
||||
"There is no version of Racket Webview Qt for os '~a', architecture '~a' available"
|
||||
(system-type 'os*)
|
||||
(system-type 'arch)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(begin
|
||||
(displayln "Warning: Cannot resolve racket webview download site.")
|
||||
(displayln "Cannot download backend libraries and programs.")
|
||||
(set! do-ffi #f)
|
||||
(set! reason "Racket Webview Qt backend download site could not be resolved")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; Make sure we can load the FFI library, if at all possible (i.e. do-ffi equals #t)
|
||||
|
||||
(define os (system-type 'os*))
|
||||
|
||||
@@ -71,11 +104,11 @@
|
||||
)
|
||||
)
|
||||
|
||||
(define os-lib-dir (racket-webview-qt-directory))
|
||||
|
||||
(let ((files (directory-list os-lib-dir)))
|
||||
(displayln (format "os-lib-dir: ~a" os-lib-dir))
|
||||
(displayln (format "os-lib-dir-contents: ~a" files)))
|
||||
(define os-lib-dir
|
||||
(let ((dir (racket-webview-qt-directory)))
|
||||
(if (eq? dir #f)
|
||||
(build-path ".")
|
||||
dir)))
|
||||
|
||||
(define (libname lib-symbol)
|
||||
(build-path os-lib-dir (symbol->string lib-symbol)))
|
||||
@@ -94,41 +127,75 @@
|
||||
|
||||
(define webview-lib-file (libname ffi-library))
|
||||
(define webview-lib
|
||||
(with-handlers ([exn:fail?
|
||||
(λ (exp)
|
||||
(cond
|
||||
([eq? os 'linux]
|
||||
(error (format
|
||||
(string-append "Cannot load ~a.\n"
|
||||
"Make sure you installed Qt6 on your system\n"
|
||||
"NB. the minimum Qt version that is supported is Qt 6.10.\n"
|
||||
"This probably means you will need to install it separately from\n"
|
||||
"the standard distro packages (e.g. libqt6webenginewidgets6 on\n"
|
||||
"debian based systems).\n"
|
||||
"\n"
|
||||
"Exception:\n\n~a")
|
||||
ffi-library exp)))
|
||||
(else (error
|
||||
(format "Cannot load ~a for os ~a\n\nException:\n\n~a"
|
||||
ffi-library os exp))))
|
||||
)
|
||||
])
|
||||
(ffi-lib webview-lib-file '("6" #f)
|
||||
#:get-lib-dirs (list os-lib-dir)
|
||||
;#:custodian (current-custodian)
|
||||
)
|
||||
)
|
||||
(if (eq? do-ffi #f)
|
||||
libssl
|
||||
(with-handlers ([exn:fail?
|
||||
(λ (exp)
|
||||
(cond
|
||||
([eq? os 'linux]
|
||||
(error (format
|
||||
(string-append "Cannot load ~a.\n"
|
||||
"Make sure you installed Qt6 on your system\n"
|
||||
"NB. the minimum Qt version that is supported is Qt 6.10.\n"
|
||||
"This probably means you will need to install it separately from\n"
|
||||
"the standard distro packages (e.g. libqt6webenginewidgets6 on\n"
|
||||
"debian based systems).\n"
|
||||
"\n"
|
||||
"Exception:\n\n~a")
|
||||
ffi-library exp)))
|
||||
(else (error
|
||||
(format "Cannot load ~a for os ~a\n\nException:\n\n~a"
|
||||
ffi-library os exp))))
|
||||
)
|
||||
])
|
||||
(ffi-lib webview-lib-file '("6" #f)
|
||||
#:get-lib-dirs (list os-lib-dir)
|
||||
;#:custodian (current-custodian)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define-ffi-definer define-rktwebview webview-lib)
|
||||
;; Make sure we are forgiving with the function loading.
|
||||
;; forgiving with the function loading.
|
||||
|
||||
(define (make-ffi-repl id err . ret)
|
||||
(let ((warned #f)
|
||||
(msg (if (eq? do-ffi #t)
|
||||
(string-append
|
||||
"'~a' could not be loaded from "
|
||||
(format "~a" webview-lib-file))
|
||||
(string-append
|
||||
"'~a' could not be loaded.\n"
|
||||
reason)))
|
||||
)
|
||||
(λ () (λ args
|
||||
(if err
|
||||
(error (format msg id))
|
||||
(begin
|
||||
(unless warned
|
||||
(displayln (format msg id))
|
||||
(set! warned #t))
|
||||
(car ret)))))))
|
||||
|
||||
|
||||
;;; Callbacks from the OS library
|
||||
|
||||
;(define callback-box (box '()))
|
||||
;(define (applier thunk)
|
||||
; (thunk))
|
||||
(define-ffi-definer define-rktwebview
|
||||
webview-lib
|
||||
#:default-make-fail (λ (id)
|
||||
(if (eq? do-ffi #f)
|
||||
(cond
|
||||
((eq? id 'rkt_webview_env)
|
||||
(make-ffi-repl id #f #t))
|
||||
((eq? id 'rkt_webview_events_waiting)
|
||||
(make-ffi-repl id #f 0))
|
||||
((eq? id 'rkt_webview_init)
|
||||
(make-ffi-repl id #f #t))
|
||||
((eq? id 'rkt_webview_cleanup)
|
||||
(make-ffi-repl id #f #t))
|
||||
(else
|
||||
(make-ffi-repl id #t))
|
||||
)
|
||||
(make-ffi-repl id #t)))
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Types / Functions
|
||||
|
||||
Reference in New Issue
Block a user