171 lines
5.6 KiB
Racket
171 lines
5.6 KiB
Racket
#lang racket/base
|
|
|
|
(require setup/dirs
|
|
net/sendurl
|
|
net/url
|
|
net/url-connect
|
|
net/dns
|
|
racket/file
|
|
racket/system
|
|
racket/string
|
|
file/unzip
|
|
)
|
|
|
|
(provide download-soundlibs
|
|
soundlibs-clear-download!
|
|
soundlibs-version
|
|
soundlibs-directory
|
|
soundlibs-available?
|
|
soundlibs-downloadable?
|
|
soundlibs-resolves?
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Version info of the version to download
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define version-major 0)
|
|
(define version-minor 1)
|
|
(define version-patch 0)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Internal functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(define download-version (format "~a-~a-~a"
|
|
version-major
|
|
version-minor
|
|
version-patch
|
|
))
|
|
|
|
(define download-site "git.dijkewijk.nl")
|
|
(define base-path "hans/racket-sound-lib/releases/download")
|
|
(define os (system-type 'os*))
|
|
(define arch (system-type 'arch))
|
|
|
|
(define download-url (format "https://~a/~a/~a/~a-~a.zip"
|
|
download-site
|
|
base-path
|
|
download-version
|
|
os
|
|
arch))
|
|
|
|
(define install-path (build-path (find-system-path 'addon-dir) "racket-sound-lib"))
|
|
(define version-file (build-path install-path "version.txt"))
|
|
(define ffi-path (build-path install-path (format "~a-~a" os 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 100000 100000)))
|
|
(displayln (format "~a downloaded" count))
|
|
(close-input-port port-in)
|
|
(close-output-port port-out)
|
|
count)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (soundlibs-available?)
|
|
(if (file-exists? version-file)
|
|
(with-handlers ([exn:fail? (λ (e) #f)])
|
|
(let ((v (file->value version-file)))
|
|
(and
|
|
(= (car v) version-major)
|
|
(= (cadr v) version-minor)
|
|
(= (caddr v) version-patch)))
|
|
)
|
|
#f))
|
|
|
|
(define (soundlibs-directory)
|
|
(if (soundlibs-available?)
|
|
(build-path install-path (format "~a-~a" os arch))
|
|
#f))
|
|
|
|
(define (soundlibs-resolves?)
|
|
(if (eq? (dns-find-nameserver) #f)
|
|
#f
|
|
(with-handlers ([exn:fail? (λ (e) #f)])
|
|
(dns-get-address (dns-find-nameserver) download-site)
|
|
#t)
|
|
)
|
|
)
|
|
|
|
(define (soundlibs-version)
|
|
(if (soundlibs-available?)
|
|
(file->value version-file)
|
|
#f))
|
|
|
|
(define (soundlibs-downloadable?)
|
|
(with-handlers ([exn:fail? (λ (e) #f)])
|
|
(let ((in (download-port download-url)))
|
|
(let ((d (input-port? in)))
|
|
(when d
|
|
(close-input-port in))
|
|
d))))
|
|
|
|
(define (soundlibs-clear-download!)
|
|
(when (file-exists? version-file)
|
|
(delete-file version-file)))
|
|
|
|
(define (download-soundlibs)
|
|
(let ((in (download-port download-url)))
|
|
(unless (input-port? in)
|
|
(error (format "Cannot get a download port for '~a'" 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)..." 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 #:preserve-attributes? #t #:preserve-timestamps? #t)
|
|
(current-directory cd))
|
|
(displayln "Removing zip archive")
|
|
(delete-file file)
|
|
(displayln "Writing version")
|
|
(let ((version (list version-major
|
|
version-minor
|
|
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
|
|
)
|
|
)
|
|
)
|