#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 ) ) )