hans/rkt-web-player
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

player agent gui script for exe

Browse Source
This commit is contained in:
Hans Dijkema
2026-09-17 09:49:23 +02:00
parent 705ff17c79
commit 83fe3cc472
7 changed files with 212 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+1
View File
@@ -30,3 +30,4 @@ data/*.keystore*
# Logging
*.log
*.log.*
/player-agent-gui.zip
player-agent-gui.rkt
+5
View File
@@ -0,0 +1,5 @@
#lang racket/base
(require "private-player-agent/player-agent-gui.rkt")
(run-player-agent-gui)
player-agent.rkt
+8 -5
View File
@@ -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))
private-player-agent/player-agent-core.rkt
+143 -41
View File
@@ -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"
private-player-agent/player-agent-gui.rkt
+30 -6
View File
@@ -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
private/player.rkt
+10
View File
@@ -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
+15
View File
@@ -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?)))]