player agent gui script for exe

.gitignore

@@ -30,3 +30,4 @@ data/*.keystore*
 # Logging
 *.log
 *.log.*
+/player-agent-gui.zip

player-agent-gui.rkt

@@ -0,0 +1,5 @@
+#lang racket/base
+
+(require "private-player-agent/player-agent-gui.rkt")
+
+(run-player-agent-gui)

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?)
+  (-> void?)
-  ((dynamic-require "private-player-agent/player-agent-gui.rkt"
+  ((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))

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)))
+           (found (with-agent-state
-      (if (and found (file-exists? found))
+                   (λ ()
-          found
+                     (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.
+  ;;; Bounds retained media while protecting the current and prepared tracks.
-  (define (discard-unused-media! keep-key)
+  ;;; The caller holds state-lock so decoder callbacks cannot race eviction.
-    (let loop ((remaining (hash->list cached-media)))
+  (define (trim-cache!)
-      (unless (null? remaining)
+    (trim-media-cache!
-        (let ((entry (car remaining)))
+     cached-media
-          (unless (equal? (car entry) keep-key)
+     (list current-media-key
-            (safe-delete-file (cdr entry))
+           loading-media-key
-            (hash-remove! cached-media (car entry))))
+           queued-media-key
-        (loop (cdr remaining)))))
+           (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)))
+                  (hash-set! music-tracks music-id data)
-               (set! current-media-key next-key)
+                  (set! current-media-key next-key)
-               (discard-unused-media! next-key)))))
+                  (set! loading-media-key #f)
+                  (trim-cache!)))))))
         ((string=? action "prefetch")
-         (let ((key (command-cache-key data))
+         (let ((path (ensure-media-cached! data)))
-               (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"))
+                              (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))))))
         ((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"

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)
+(define/contract (run-player-agent-gui* exit-callback)
-  (-> (is-a?/c frame%))
+  (-> 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

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)

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?)))]