-

private/downloader.rkt

@@ -0,0 +1,165 @@
+#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-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 (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
+      )
+    )
+  )

private/utils.rkt

@@ -4,6 +4,7 @@
            racket/runtime-path
            ffi/unsafe
            setup/dirs
+           "downloader.rkt"
            )
   
   (provide while
@@ -55,18 +56,12 @@
            (do-for-f))))))
 
 
-  (define-runtime-path lib-path "..")
-
   (define (build-lib-path)
-    (let ((os-type (system-type 'os*)))
-      (if (eq? os-type 'windows)
-          (build-path lib-path "lib" "dll")
-          (let* ((arch (symbol->string (system-type 'arch)))
-                 (subdir (string-append (symbol->string os-type) "-" arch)))
-            (let ((path (build-path lib-path "lib" subdir)))
-              path)))))
+    (soundlibs-directory))
 
   (define (get-lib* libs-to-try orig-libs versions)
+    (unless (soundlibs-available?)
+      (download-soundlibs))
     (if (null? libs-to-try)
         (error (format "Cannot find library, tried ~a" orig-libs)) 
         (ffi-lib (car libs-to-try) versions
@@ -77,4 +72,4 @@
   (define (get-lib libs-to-try versions)
     (get-lib* libs-to-try libs-to-try versions))
   
-  ) ; end of module
+) ; end of module