diff --git a/.gitignore b/.gitignore index 1bb8cbc..325df98 100644 --- a/.gitignore +++ b/.gitignore @@ -30,3 +30,4 @@ data/*.keystore* # Logging *.log *.log.* +/player-agent-gui.zip diff --git a/player-agent-gui.rkt b/player-agent-gui.rkt new file mode 100644 index 0000000..d2f861e --- /dev/null +++ b/player-agent-gui.rkt @@ -0,0 +1,5 @@ +#lang racket/base + +(require "private-player-agent/player-agent-gui.rkt") + +(run-player-agent-gui) diff --git a/player-agent.rkt b/player-agent.rkt index e88c295..585a01c 100644 --- a/player-agent.rkt +++ b/player-agent.rkt @@ -1,11 +1,15 @@ #lang racket/base (require racket/class - racket/contract) + racket/gui + racket/contract + racket/runtime-path) (provide run-player-agent run-player-agent-cli) +(define-runtime-path private "./private-player-agent") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Start the graphical polling playback agent. ; pre : A graphical desktop is available. @@ -16,8 +20,8 @@ ; keeps command-line use independent of racket/gui initialization. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define/contract (run-player-agent) - (-> object?) - ((dynamic-require "private-player-agent/player-agent-gui.rkt" + (-> void?) + ((dynamic-require (build-path private "player-agent-gui.rkt") 'run-player-agent-gui))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -42,5 +46,4 @@ #:name name #:config-file config-file)) -(module+ main - (run-player-agent)) + diff --git a/private-player-agent/player-agent-core.rkt b/private-player-agent/player-agent-core.rkt index 69e316f..d43ef10 100644 --- a/private-player-agent/player-agent-core.rkt +++ b/private-player-agent/player-agent-core.rkt @@ -84,6 +84,26 @@ (exn-message exception))))) (delete-file file)))) +;;; Evicts least recently used files until the cache fits its byte budget. +;;; Entries contain path, byte size and last use; active files remain protected. +(define (trim-media-cache! cache protected [limit 1000000000]) + (let loop ((entries (sort (hash->list cache) < + #:key (λ (entry) (cadddr entry)))) + (size (apply + (map cadr (hash-values cache))))) + (when (and (> size limit) (pair? entries)) + (let* ((entry (car entries)) + (key (car entry)) + (path (cadr entry))) + (cond + ((member key protected) (loop (cdr entries) size)) + (else + (safe-delete-file path) + (if (file-exists? path) + (loop (cdr entries) size) + (begin + (hash-remove! cache key) + (loop (cdr entries) (- size (caddr entry))))))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Provided functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -123,6 +143,8 @@ (authorization-notified? #f) (audio #f) (current-media-key #f) + (loading-media-key #f) + (queued-media-key #f) (cached-media (make-hash)) (prefetched-track #f) (auto-started-key #f) @@ -210,7 +232,9 @@ (λ (_handle state full-state) (update-from-audio! state full-state)) (λ (handle) - (advance-at-decoder-eof! handle)))) + (advance-at-decoder-eof! handle)) + #:use-place #f + )) (audio-ao-buf-ms! audio 500) (audio-buf-seconds! audio 4 10) (let ((scaled (/ logical-volume 100.0))) @@ -220,52 +244,84 @@ ;;; Downloads one protected media resource to a temporary local file. ;;; A failed download closes its port and removes its partial file. (define (download-media! token filename) - (let* ((extension + (let* ((started (current-inexact-monotonic-milliseconds)) + (extension (or (path-get-extension (string->path filename)) #"")) (target (make-temporary-file (string-append "rkt-player-agent-~a" (bytes->string/utf-8 extension)))) (path (format "/api/agent/media/~a/~a" app-id token)) - (input (get-pure-port (endpoint-url server-url path)))) + (input #f)) (with-handlers ((exn:fail? (λ (exception) - (close-input-port input) + (when input (close-input-port input)) (safe-delete-file target) (raise exception)))) + (info-player-agent "Downloading ~a" filename) + (set! input (get-pure-port (endpoint-url server-url path))) (call-with-output-file target (λ (output) (copy-port input output)) #:exists 'truncate/replace) (close-input-port input) + (info-player-agent "Downloaded ~a: ~a bytes in ~a ms" + filename (file-size target) + (round (- (current-inexact-monotonic-milliseconds) + started))) target))) - ;;; Selects the stable cache key carried by a playback command. + ;;; Scopes media identity to its server, source path, size and modification time. + ;;; Older servers without version metadata only reuse the same media token. (define (command-cache-key data) - (hash-ref data 'cacheKey (hash-ref data 'mediaToken))) + (list server-url + (hash-ref data 'cacheKey (hash-ref data 'mediaToken)) + (hash-ref data 'mediaSize #f) + (hash-ref data 'mediaModified (hash-ref data 'mediaToken)))) ;;; Returns cached media or downloads and records it when absent. (define (ensure-media-cached! data) (let* ((key (command-cache-key data)) - (found (hash-ref cached-media key #f))) - (if (and found (file-exists? found)) - found + (found (with-agent-state + (λ () + (set! loading-media-key key) + (hash-ref cached-media key #f))))) + (if (and found (file-exists? (car found)) + (= (file-size (car found)) (cadr found))) + (begin + (info-player-agent "Cache hit: ~a" (hash-ref data 'filename "track")) + (with-agent-state + (λ () + (hash-set! cached-media key + (list (car found) (cadr found) + (current-inexact-monotonic-milliseconds))))) + (car found)) (let ((downloaded (download-media! (hash-ref data 'mediaToken) (hash-ref data 'filename "track")))) - (hash-set! cached-media key downloaded) + (when (and (hash-has-key? data 'mediaSize) + (not (= (file-size downloaded) + (hash-ref data 'mediaSize)))) + (safe-delete-file downloaded) + (error 'player-agent "Downloaded media size does not match the server")) + (with-agent-state + (λ () + (when found (safe-delete-file (car found))) + (hash-set! cached-media key + (list downloaded (file-size downloaded) + (current-inexact-monotonic-milliseconds))))) downloaded)))) - ;;; Removes every cached media file except the entry identified by keep-key. - (define (discard-unused-media! keep-key) - (let loop ((remaining (hash->list cached-media))) - (unless (null? remaining) - (let ((entry (car remaining))) - (unless (equal? (car entry) keep-key) - (safe-delete-file (cdr entry)) - (hash-remove! cached-media (car entry)))) - (loop (cdr remaining))))) + ;;; Bounds retained media while protecting the current and prepared tracks. + ;;; The caller holds state-lock so decoder callbacks cannot race eviction. + (define (trim-cache!) + (trim-media-cache! + cached-media + (list current-media-key + loading-media-key + queued-media-key + (and prefetched-track (command-cache-key (car prefetched-track)))))) ;;; Continues with prefetched media when the current decoder reaches EOF. ;;; Decoder EOF precedes audible EOF, so audio-play! queues behind the buffer. @@ -274,6 +330,8 @@ (with-agent-state (λ () (let ((value prefetched-track)) + (when value + (set! queued-media-key (command-cache-key (car value)))) (set! prefetched-track #f) value))))) (cond @@ -288,15 +346,19 @@ (exn-message exception)) (set-agent-error! (exn-message exception)) (with-agent-state - (λ () (set! ended-counter (+ ended-counter 1))))))) + (λ () + (set! queued-media-key #f) + (trim-cache!) + (set! ended-counter (+ ended-counter 1))))))) (let ((music-id (audio-play! handle path))) (info-player-agent "Queued prefetched track ~a as music id ~a" (hash-ref data 'filename "track") music-id) - (set! current-media-key key) - (discard-unused-media! key) (with-agent-state (λ () + (set! current-media-key key) + (set! queued-media-key #f) + (trim-cache!) (hash-set! music-tracks music-id data) (set! auto-started-key key) (set! pending-auto-music-id music-id))))))) @@ -311,7 +373,8 @@ (define (execute-command! command) (let ((action (hash-ref command 'action "")) (data (hash-ref command 'data (hasheq)))) - (info-player-agent "Executing command ~a" action) + (info-player-agent "Executing command ~a: ~a" + (hash-ref command 'id) action) (cond ((string=? action "play") (let* ((next-key (command-cache-key data)) @@ -337,29 +400,30 @@ (hash-set agent-state 'state "starting") 'error 'null)))) (let* ((next-media (ensure-media-cached! data)) + (handle (ensure-audio!)) + (started (current-inexact-monotonic-milliseconds)) ;; audio-play! interrupts and closes the previous decoder. - (music-id (audio-play! (ensure-audio!) next-media))) + (music-id (audio-play! handle next-media))) + (info-player-agent "Audio accepted ~a as music id ~a in ~a ms" + (hash-ref data 'filename "track") music-id + (round (- (current-inexact-monotonic-milliseconds) + started))) (with-agent-state (λ () (hash-clear! music-tracks) - (hash-set! music-tracks music-id data))) - (set! current-media-key next-key) - (discard-unused-media! next-key))))) + (hash-set! music-tracks music-id data) + (set! current-media-key next-key) + (set! loading-media-key #f) + (trim-cache!))))))) ((string=? action "prefetch") - (let ((key (command-cache-key data)) - (path (ensure-media-cached! data))) + (let ((path (ensure-media-cached! data))) (with-agent-state - (λ () (set! prefetched-track (cons data path)))) + (λ () + (set! prefetched-track (cons data path)) + (set! loading-media-key #f) + (trim-cache!))) (info-player-agent "Prefetched ~a" - (hash-ref data 'filename "track")) - (let loop ((remaining (hash->list cached-media))) - (unless (null? remaining) - (let ((entry (car remaining))) - (unless (or (equal? (car entry) current-media-key) - (equal? (car entry) key)) - (safe-delete-file (cdr entry)) - (hash-remove! cached-media (car entry)))) - (loop (cdr remaining)))))) + (hash-ref data 'filename "track")))) ((string=? action "pause") (audio-pause! (ensure-audio!) #t)) ((string=? action "resume") @@ -371,7 +435,11 @@ (set! auto-started-key #f) (set! pending-auto-music-id #f))) (when audio - (audio-stop! audio))) + (audio-stop! audio)) + (with-agent-state + (λ () + (set! current-media-key #f) + (trim-cache!)))) ((string=? action "seek") (audio-seek! (ensure-audio!) (hash-ref data 'percentage 0))) ((string=? action "volume") @@ -444,6 +512,10 @@ (λ (exception) (warn-player-agent "Command failed: ~a" (exn-message exception)) + (with-agent-state + (λ () + (set! loading-media-key #f) + (trim-cache!))) (set-agent-error! (exn-message exception))))) (clear-agent-error!) (execute-command! command)) @@ -488,7 +560,7 @@ (set! audio #f)) (let loop ((paths (hash-values cached-media))) (unless (null? paths) - (safe-delete-file (car paths)) + (safe-delete-file (caar paths)) (loop (cdr paths)))) (hash-clear! cached-media)) @@ -511,6 +583,36 @@ (check-equal? (normal-state 'transitioning) "starting") (check-equal? (normal-state 'playing) "playing") + (let ((directory (make-temporary-file "agent-cache-test-~a" 'directory)) + (cache (make-hash))) + (dynamic-wind + void + (λ () + (for-each + (λ (key age) + (let ((path (build-path directory (symbol->string key)))) + (display-to-file "1234" path) + (hash-set! cache key (list path 4 age)))) + '(old recent current prepared) + '(1 4 2 3)) + ;; Entries below the budget survive track changes. + (trim-media-cache! cache '(current prepared) 16) + (check-equal? (hash-count cache) 4) + ;; Eviction follows last use, not insertion or playback order. + (trim-media-cache! cache '(current prepared) 12) + (check-false (hash-has-key? cache 'old)) + (check-false (file-exists? (build-path directory "old"))) + (check-true (hash-has-key? cache 'recent)) + ;; Active files survive even when they exceed the entire budget. + (trim-media-cache! cache '(current prepared) 4) + (check-equal? (hash-count cache) 2) + (check-true (file-exists? (build-path directory "current"))) + (check-true (file-exists? (build-path directory "prepared"))) + ;; Releasing active files lets the cache return to its limit. + (trim-media-cache! cache '() 4) + (check-equal? (hash-keys cache) '(prepared))) + (λ () (delete-directory/files directory)))) + (let* ((app-id (make-string 64 #\a)) (runtime (make-player-agent-runtime "http://127.0.0.1:1234" diff --git a/private-player-agent/player-agent-gui.rkt b/private-player-agent/player-agent-gui.rkt index 600cb82..dc6af93 100644 --- a/private-player-agent/player-agent-gui.rkt +++ b/private-player-agent/player-agent-gui.rkt @@ -85,8 +85,8 @@ ; Playback and polling remain in player-agent-core.rkt. racket-tray ; owns native tray resources and the portable minimize watcher. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define/contract (run-player-agent-gui) - (-> (is-a?/c frame%)) +(define/contract (run-player-agent-gui* exit-callback) + (-> procedure? void?) (sl-log-to-file log-file) (let ((config (load-player-agent-config)) (frame #f) @@ -98,9 +98,11 @@ (name-field #f) (server-field #f) (connect-button #f) + (quit-button #f) (playback-timer #f) (tray #f) - (shutting-down? #f)) + (shutting-down? #f) + ) (define (cap200 msg) (substring msg 0 (min 199 (string-length msg)))) @@ -272,7 +274,8 @@ ((player-agent-runtime-shutdown! runtime)) (when tray (tray-close tray) - (set! tray #f)))) + (set! tray #f))) + ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Terminate the graphical agent from its tray menu. @@ -285,7 +288,9 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (quit!) (shutdown!) - (send frame show #f)) + (send frame show #f) + (exit-callback) + ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Restore the agent frame from the tray. @@ -380,6 +385,11 @@ (parent playback-panel) (label "—") [ellipsis 'right] [auto-resize #t] [stretchable-width #t])) + (set! quit-button + (new button% + (parent controls) + (label (tr 'quit)) + (callback (λ (_button _event) (quit!))))) (set! connect-button (new button% (parent controls) @@ -411,8 +421,22 @@ (send frame show #t) ((player-agent-runtime-start! runtime)) + (send connect-button set-label (cap200 (tr 'reconnect))) - frame)) + + (void))) + + +(define (run-player-agent-gui) + (let ((quit-semaphore (make-semaphore 0))) + + (run-player-agent-gui* + (λ () + (semaphore-post quit-semaphore))) + + (yield quit-semaphore) + + (void))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tests for module library.rkt diff --git a/private/player.rkt b/private/player.rkt index 7ecb1a3..e7584a3 100644 --- a/private/player.rkt +++ b/private/player.rkt @@ -175,6 +175,8 @@ (hasheq 'playlistIndex index 'trackNumber (+ index 1) 'cacheKey (track-cache-key item) + 'mediaSize (file-size (track-file item)) + 'mediaModified (file-or-directory-modify-seconds (track-file item)) 'mediaToken token 'filename (path->string @@ -198,6 +200,8 @@ agent (append (playback-agent-commands agent) (list command))) + (info-web-player "Queued agent command ~a: ~a (~a pending)" + id action (length (playback-agent-commands agent))) command)))) (define agent-heartbeat-timeout-seconds 10) @@ -2172,6 +2176,12 @@ 'state (hasheq 'state "starting" 'position 0)))) (define play-command (hash-ref play-poll 'command)) (check-equal? (hash-ref play-command 'action) "play") + (check-equal? + (hash-ref (hash-ref play-command 'data) 'mediaSize) + (file-size first-file)) + (check-equal? + (hash-ref (hash-ref play-command 'data) 'mediaModified) + (file-or-directory-modify-seconds first-file)) (check-equal? (hash-ref (hash-ref play-command 'data) 'trackNumber) 1) diff --git a/scribblings/rkt-web-player.scrbl b/scribblings/rkt-web-player.scrbl index d629859..18a8455 100644 --- a/scribblings/rkt-web-player.scrbl +++ b/scribblings/rkt-web-player.scrbl @@ -124,6 +124,21 @@ renderers. The server can prefetch the next track to an agent for gapless transitions. A 256-bit application ID identifies the agent; the server's @tt{[playback-agents]} allowlist decides which agents may connect. +Both agents retain downloaded tracks in a local disk cache with a budget of +1 GB (1,000,000,000 bytes), evicting the least recently used tracks first. +Selecting a cached track reuses its local file when the server address, source +path, file size and modification time still match. Changing the source file's +size or modification time causes a new download. Older servers without this +metadata only allow reuse for the same media token. +Files in use for playback or prefetch are protected, so those files and an +in-progress download can temporarily exceed the budget. The cache lasts until +the agent exits; it is not retained across restarts. + +A track that is not cached is still downloaded completely before playback. +The next track is fetched after the play command completes. Commands are +processed in server order, so a pending prefetch can still delay a later manual +track selection. + @defproc[(run-web-player [music-paths (listof (or/c path-string? (list/c string? path-string?)))]