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

Making windows download the right webui-wire executable too.

Browse Source
This commit is contained in:
Hans Dijkema
2025-11-13 09:57:16 +01:00
parent fcbce01ebb
commit 27c0b27a46
1 changed files with 36 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
private/webui-wire-download.rkt
View File

@@ -3,10 +3,10 @@
(require setup/dirs (require setup/dirs
net/sendurl net/sendurl
net/url net/url
file/unzip
racket/file racket/file
"web-racket-version.rkt" "web-racket-version.rkt"
racket/system racket/system
racket/string
) )
(provide ww-set-custom-webui-wire-command! (provide ww-set-custom-webui-wire-command!
@@ -27,15 +27,28 @@
(define (get-webui-wire-cmd) (define (get-webui-wire-cmd)
(if (eq? user-webui-wire-command #f) (if (eq? user-webui-wire-command #f)
(let ((os (system-type 'os*))) (let ((os (get-os)))
(if (eq? os 'linux) (if (eq? os 'linux)
"flatpak run nl.dijkewijk.webui-wire" "flatpak run nl.dijkewijk.webui-wire"
(format "~a" (format "~a"
(build-path (webui-wire-dir) (if (eq? os 'windows) (build-path (webui-wire-dir) (if (eq? os 'win64)
"webui-wire.exe" "webui-wire.exe"
"webui-wire"))))) "webui-wire")))))
user-webui-wire-command)) user-webui-wire-command))
(define (get-webui-wire-installed-version)
(let* ((cmd (get-webui-wire-cmd))
(result (call-with-values (λ () (process (format "~a --version" cmd)))
(λ (args)
(let ((out (car args))
(in (cadr args)))
(displayln "exit" in)
(flush-output in)
(read-line out)))))
(result-str (string-trim (format "~a" result)))
)
result-str))
(define (webui-wire-dir) (define (webui-wire-dir)
(let* ((cache-dir (find-system-path 'cache-dir)) (let* ((cache-dir (find-system-path 'cache-dir))
(ww-dir (build-path cache-dir "webui-wire")) (ww-dir (build-path cache-dir "webui-wire"))
@@ -55,10 +68,10 @@
(define (webui-wire-exists?) (define (webui-wire-exists?)
(let ((os (system-type 'os*))) (let ((os (get-os)))
(cond [(eq? os 'linux) (cond [(eq? os 'linux)
(webui-wire-exists-linux?)] (webui-wire-exists-linux?)]
[(eq? os 'windows) [(eq? os 'win64)
(webui-wire-exists-windows?)] (webui-wire-exists-windows?)]
[else [else
(error (error
@@ -83,13 +96,7 @@
(let ((out (car args))) (let ((out (car args)))
(read-line out)))))) (read-line out))))))
(if (string? webui-wire) (if (string? webui-wire)
(let ((webui-wire-version (call-with-values (lambda () (process "flatpak run nl.dijkewijk.webui-wire --version")) (let ((webui-wire-version (get-webui-wire-installed-version)))
(lambda (args)
(let ((out (car args))
(in (cadr args)))
(displayln "exit" in)
(flush-output in)
(read-line out))))))
(if (string=? webui-wire-version ww-wire-version) (if (string=? webui-wire-version ww-wire-version)
#t #t
(begin (begin
@@ -101,9 +108,12 @@
) )
(define (webui-wire-exists-windows?) (define (webui-wire-exists-windows?)
(let ((webui-wire-exe (get-webui-wire-cmd 'windows))) (let ((webui-wire-exe (get-webui-wire-cmd)))
(if (file-exists? webui-wire-exe) (if (file-exists? webui-wire-exe)
#t (let ((webui-wire-version (get-webui-wire-installed-version)))
(if (string=? webui-wire-version ww-wire-version)
#t
(download-webui-wire-windows)))
(download-webui-wire-windows)) (download-webui-wire-windows))
) )
) )
@@ -153,8 +163,8 @@
filepath))) filepath)))
(define (current-webui-wire-link) (define (current-webui-wire-link)
(let* ((os (system-type 'os*)) (let* ((os (get-os))
(arch (system-type 'arch)) (arch (get-arch))
) )
(when (eq? os #f) (when (eq? os #f)
(error "Operating system not automatically supported by webui-wire, you can compile it yourself and use 'ww-set-custom-webui-wire-command!'")) (error "Operating system not automatically supported by webui-wire, you can compile it yourself and use 'ww-set-custom-webui-wire-command!'"))
@@ -173,4 +183,14 @@
) )
(define (get-os)
(let ((os (system-type 'os*)))
(if (eq? os 'windows)
'win64
os)))
(define (get-arch)
(system-type 'arch))
) )