racket-sound/private/downloader.rkt

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