281 lines
9.1 KiB
Racket
281 lines
9.1 KiB
Racket
#lang racket/base
|
|
|
|
(require net/url
|
|
racket/async-channel
|
|
racket/class
|
|
racket/file
|
|
racket/path
|
|
racket/string
|
|
"../library/base/media-resource.rkt"
|
|
"../misc/utils.rkt")
|
|
|
|
(provide playlist-cache%
|
|
playlist-cache-root
|
|
clear-playlist-cache!)
|
|
|
|
(define (playlist-cache-root)
|
|
(build-path (find-system-path 'cache-dir)
|
|
"rktplayer"))
|
|
|
|
(define (safe-name value)
|
|
(regexp-replace* #px"[<>:\"/\\\\|?*]"
|
|
(format "~a" value)
|
|
"_"))
|
|
|
|
(define (resource-extension resource)
|
|
(let* ((uri (send resource get-uri))
|
|
(without-query
|
|
(regexp-replace #px"[?#].*$" uri ""))
|
|
(uri-extension
|
|
(regexp-match #px"(?i:[.]([a-z0-9]{1,8})$)"
|
|
without-query))
|
|
(mime-type (send resource get-mime-type)))
|
|
(cond
|
|
(uri-extension
|
|
(string-append "."
|
|
(string-downcase
|
|
(cadr uri-extension))))
|
|
((member mime-type
|
|
'("audio/flac"
|
|
"audio/x-flac"
|
|
"application/flac")) ".flac")
|
|
((or (equal? mime-type "audio/mpeg")
|
|
(equal? mime-type "audio/mp3")) ".mp3")
|
|
((or (equal? mime-type "audio/opus")
|
|
(equal? mime-type "audio/ogg")) ".opus")
|
|
((member mime-type
|
|
'("audio/wav"
|
|
"audio/wave"
|
|
"audio/x-wav")) ".wav")
|
|
((member mime-type
|
|
'("audio/mp4"
|
|
"audio/x-m4a")) ".m4a")
|
|
((equal? mime-type "audio/aac") ".aac")
|
|
((equal? mime-type "audio/x-ms-wma") ".wma")
|
|
(else ".audio"))))
|
|
|
|
(define (content-length headers)
|
|
(for/or ((header (in-list headers)))
|
|
(let ((matched
|
|
(regexp-match
|
|
#px#"(?i:^content-length:[ \t]*([0-9]+)[ \t]*$)"
|
|
header)))
|
|
(and matched
|
|
(string->number
|
|
(bytes->string/utf-8
|
|
(cadr matched)))))))
|
|
|
|
(define (successful-status? status)
|
|
(regexp-match? #px#"^HTTP/[0-9.]+ 2[0-9][0-9]" status))
|
|
|
|
(define (clear-playlist-cache! [playlist-id #f])
|
|
(let ((target
|
|
(if playlist-id
|
|
(build-path (playlist-cache-root)
|
|
(safe-name playlist-id))
|
|
(playlist-cache-root))))
|
|
(when (directory-exists? target)
|
|
(with-handlers ([exn:fail? (lambda (e) (void))])
|
|
(delete-directory/files target)))))
|
|
|
|
(define playlist-cache%
|
|
(class object%
|
|
(init-field
|
|
playlist-id
|
|
[updated (lambda (entry downloaded total) (void))])
|
|
|
|
(define directory
|
|
(build-path (playlist-cache-root)
|
|
(safe-name playlist-id)))
|
|
|
|
(define queue
|
|
(make-async-channel))
|
|
|
|
(define generations
|
|
(make-hash))
|
|
|
|
(define stopped?
|
|
#f)
|
|
|
|
(define worker-custodian
|
|
(make-custodian))
|
|
|
|
(define/private (entry-generation entry)
|
|
(hash-ref generations
|
|
(send entry get-id)
|
|
0))
|
|
|
|
(define/private (next-generation! entry)
|
|
(hash-update! generations
|
|
(send entry get-id)
|
|
add1
|
|
0)
|
|
(entry-generation entry))
|
|
|
|
(define/private (cache-file entry)
|
|
(let ((resource
|
|
(send (send entry get-track)
|
|
get-resource)))
|
|
(build-path directory
|
|
(string-append
|
|
(safe-name (send entry get-id))
|
|
(resource-extension resource)))))
|
|
|
|
(define/private (notify! entry downloaded total)
|
|
(with-handlers
|
|
((exn:fail?
|
|
(lambda (exception)
|
|
(warn-rktplayer
|
|
"Cache status callback failed: ~a"
|
|
(exn-message exception)))))
|
|
(updated entry downloaded total)))
|
|
|
|
(define/private (copy-download!
|
|
input temporary entry total)
|
|
(let ((downloaded 0)
|
|
(last-reported 0)
|
|
(buffer (make-bytes 65536)))
|
|
(dynamic-wind
|
|
void
|
|
(lambda ()
|
|
(call-with-output-file
|
|
temporary
|
|
(lambda (output)
|
|
(let loop ()
|
|
(let ((count
|
|
(read-bytes-avail!* buffer input)))
|
|
(unless (eof-object? count)
|
|
(write-bytes buffer output 0 count)
|
|
(set! downloaded (+ downloaded count))
|
|
(when (>= (- downloaded last-reported)
|
|
1048576)
|
|
(set! last-reported downloaded)
|
|
(notify! entry downloaded total))
|
|
(loop)))))
|
|
#:exists 'replace
|
|
#:mode 'binary))
|
|
(lambda ()
|
|
(close-input-port input)))
|
|
downloaded))
|
|
|
|
(define/private (finish-download!
|
|
entry generation target temporary
|
|
downloaded total)
|
|
(if (and (not stopped?)
|
|
(= generation
|
|
(entry-generation entry)))
|
|
(begin
|
|
(when (file-exists? target)
|
|
(delete-file target))
|
|
(rename-file-or-directory temporary target)
|
|
(send entry set-cache-file! target)
|
|
(notify! entry downloaded total))
|
|
(when (file-exists? temporary)
|
|
(delete-file temporary))))
|
|
|
|
(define/private (download! entry generation)
|
|
(let* ((resource
|
|
(send (send entry get-track)
|
|
get-resource))
|
|
(uri (send resource get-uri))
|
|
(target (cache-file entry))
|
|
(temporary
|
|
(string->path
|
|
(string-append (path->string target)
|
|
".part"))))
|
|
(let ((finished? #f))
|
|
(dynamic-wind
|
|
void
|
|
(lambda ()
|
|
(make-directory* directory)
|
|
(let-values
|
|
(((status headers input)
|
|
(http-sendrecv/url
|
|
(string->url uri)
|
|
#:headers
|
|
(list "Connection: close"))))
|
|
(unless (successful-status? status)
|
|
(close-input-port input)
|
|
(error 'playlist-cache%
|
|
"download failed for ~a: ~a"
|
|
uri
|
|
status))
|
|
(let* ((total (content-length headers))
|
|
(downloaded
|
|
(copy-download!
|
|
input temporary entry total)))
|
|
(finish-download!
|
|
entry generation target temporary
|
|
downloaded total)
|
|
(set! finished? #t))))
|
|
(lambda ()
|
|
(when (and (not finished?)
|
|
(file-exists? temporary))
|
|
(delete-file temporary)))))))
|
|
|
|
(define worker
|
|
(parameterize
|
|
((current-custodian worker-custodian))
|
|
(thread
|
|
(lambda ()
|
|
(let loop ()
|
|
(let ((request (async-channel-get queue)))
|
|
(unless (eq? request 'stop)
|
|
(let ((entry (car request))
|
|
(generation (cadr request)))
|
|
(with-handlers
|
|
((exn:fail?
|
|
(lambda (exception)
|
|
(when (= generation
|
|
(entry-generation entry))
|
|
(send entry
|
|
set-cache-failed!
|
|
(exn-message exception))
|
|
(notify! entry 0 #f)))))
|
|
(download! entry generation))
|
|
(loop)))))))))
|
|
|
|
(define/public (ensure-entry! entry)
|
|
(let ((track (send entry get-track)))
|
|
(when track
|
|
(let* ((resource (send track get-resource))
|
|
(file (send resource get-file)))
|
|
(cond
|
|
(file
|
|
(send entry set-cache-file! file))
|
|
((regexp-match? #px"(?i:^https?://)"
|
|
(send resource get-uri))
|
|
(let ((target (cache-file entry)))
|
|
(if (file-exists? target)
|
|
(send entry set-cache-file! target)
|
|
(let ((generation
|
|
(next-generation! entry)))
|
|
(send entry set-cache-downloading!)
|
|
(notify! entry 0 #f)
|
|
(async-channel-put
|
|
queue
|
|
(list entry generation)))))))))))
|
|
|
|
(define/public (drop-entry! entry)
|
|
(next-generation! entry)
|
|
(let ((file (send entry get-cache-file)))
|
|
(when (and file
|
|
(path? file)
|
|
(file-exists? file)
|
|
(equal? (simplify-path directory)
|
|
(simplify-path
|
|
(path-only file))))
|
|
(delete-file file))))
|
|
|
|
(define/public (clear!)
|
|
(when (directory-exists? directory)
|
|
(delete-directory/files directory)))
|
|
|
|
(define/public (stop!)
|
|
(unless stopped?
|
|
(set! stopped? #t)
|
|
(custodian-shutdown-all
|
|
worker-custodian)))
|
|
|
|
(super-new)))
|