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

Adding a local player agent

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-27 10:24:40 +02:00
parent d22a7ad529
commit 577b0aa729
8 changed files with 1321 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ARCHITECTURE.md
+344
View File
@@ -0,0 +1,344 @@
# RKT Web Player Architecture
## 1. Purpose and scope
RKT Web Player is a single-process audio player with a browser-based user
interface. It exposes local music directories as lazily browsed libraries and
can play selected files either on the host machine or on a discovered UPnP or
Sonos renderer.
The application is designed as a personal, stateful desktop or LAN service. A
single server-side player instance owns the active browser location, playlists,
playback state, output selection, and audio backend. All connected browser
windows observe and control that same instance.
## 2. System context
```mermaid
flowchart LR
User[User] --> Browser[Web browser]
Browser <-->|HTTP + JSON| Server[RKT Web Player]
Server -->|Read directories and tags| Files[(Local music files)]
Server -->|Audio output| Local[Local audio device]
Server -->|SSDP / UPnP discovery| Network[UPnP and Sonos devices]
Server -->|HTTP media publication + DLNA control| Network
Agent[Windows playback agent] -->|Registration, polling and state| Server
Server -->|Track download| Agent
Agent -->|Audio output| AgentAudio[Client audio device]
```
The browser is a thin client: it renders a complete server-provided state
snapshot and sends commands back to the server. The server is authoritative;
there is no browser-side persistence or independent playback state.
## 3. Runtime structure
```mermaid
flowchart TB
Main[main.rkt<br/>configuration and lifecycle]
Server[private/server.rkt<br/>HTTP adapter]
Player[private/player.rkt<br/>application state and commands]
Library[private/library.rkt<br/>filesystem and metadata]
UI[public/index.html + styles.css + app.js<br/>browser UI]
Audio[racket-audio<br/>local backend]
Discovery[racket-upnp + racket-sonos<br/>device discovery]
DLNA[racket-audio-dlna<br/>network backend and media server]
Agent[player-agent.rkt<br/>polling Windows renderer]
Main --> Server
Main --> Player
Main --> Library
Server --> Player
Server --> UI
Player --> Library
Player --> Audio
Player --> Discovery
Player --> DLNA
Agent --> Server
Agent --> Audio
```
### 3.1 Entrypoint and lifecycle
[`main.rkt`](main.rkt) is both the command-line entrypoint and the public Racket
API. It performs the following work:
1. Reads command-line options and optional INI defaults.
2. Combines and de-duplicates configured music paths.
3. Creates immutable library descriptors with `make-music-libraries`.
4. Creates the single mutable player instance with `make-player`.
5. Starts the web server with `serve-player`.
6. Closes the active audio backend through `player-close!` when the server
exits, using `dynamic-wind` to guarantee cleanup.
The exported `run-web-player` function provides the same lifecycle to programs
that embed the package instead of invoking its command line.
### 3.2 Library subsystem
[`private/library.rkt`](private/library.rkt) isolates filesystem access and
audio metadata extraction. Its principal domain types are:
- `music-library`: a stable generated ID, display name, and absolute root path;
- `browser-entry`: the name, kind, and root-relative path of a visible item;
- `track`: the absolute source file and its display/playback metadata.
Library loading is deliberately lazy:
- Startup validates each root and lists only the first library's root
directory.
- Browsing reads one directory level and does not inspect audio tags.
- Selecting a track for play or addition reads its metadata.
- Selecting a directory for play or addition recursively walks that subtree
and reads metadata for every supported track.
Directories are shown before tracks and entries are sorted case-insensitively.
Hidden directories and unsupported files are omitted. Metadata failures degrade
to the filename, an empty artist and album, an unknown duration, and the MIME
type inferred from the extension.
The HTTP API never accepts filesystem paths. It accepts library IDs and indexes
from the latest state snapshot; the player resolves these to entries whose
relative paths originated from directory listings below a configured root.
### 3.3 Player and application state
[`private/player.rkt`](private/player.rkt) contains the main application logic.
The mutable `player` structure is the aggregate root for:
- configured libraries and the current browser location;
- in-memory playlist tabs and the selected tab's tracks;
- discovered renderers and the selected renderer;
- registered HTTP playback agents and their pending command queues;
- the lazily created local or network backend;
- transport state, current track, position, duration, audio properties, volume,
and repeat mode;
- current error, discovery, and shutdown status;
- synchronization primitives and the DLNA publication port.
Commands are expressed as strings with a JSON-compatible payload. The player
validates each command, mutates its state, delegates to a playback backend where
required, and returns a complete JSON-compatible state snapshot. Commands cover
library navigation, playlist/tab editing, output selection, transport, seeking,
volume, and repeat mode.
Playlist tabs exist only in memory. Selecting, deleting, or creating a tab
stops playback. Tracks are de-duplicated by normalized source path when they are
appended.
### 3.4 Playback backends
The player exposes local, UPnP, and Sonos outputs as renderers with a common
logical interface, but dispatches explicitly based on backend kind.
The default `local` renderer uses `racket-audio`. Its backend is created on the
first playback-related command, not at startup. State and end-of-track callbacks
update the player and automatically advance the playlist. The UI's linear
0-100 volume is squared before being sent to the local audio library to provide
a more useful perceived volume curve.
Network outputs use `racket-audio-dlna`. The backend controls the chosen media
renderer and publishes local files over HTTP on the configured DLNA port and
path. Unlike the callback-driven local backend, network playback information is
refreshed by calling the renderer whenever a state snapshot is requested.
Changing the selected renderer closes the existing backend and resets playback
state. The replacement backend remains lazy and is created only when it is
needed.
Registered playback agents form a fourth renderer kind. An agent keeps the
client/server direction unchanged: it registers and polls the server, while the
server never opens a connection to the agent. Server commands have monotonically
increasing IDs and remain queued until acknowledged. Each poll acknowledges the
last completed command and reports playback state. For a play command, the
server creates an opaque media token; the agent downloads that track to a
temporary file and uses `racket-audio` for local playback. A stable 256-bit
application ID and the agent-owned display name are persisted in its local INI
file. The server follows the name advertised by the agent and does not own a
separate name mapping.
### 3.5 Device discovery
Discovery is explicitly initiated from the UI and runs on a separate Racket
thread so that the initial API call can return immediately. It:
1. Queries all visible UPnP devices.
2. Filters media renderers.
3. Reads Sonos group topology when available.
4. Represents each Sonos group as one logical renderer.
5. Removes individual UPnP devices that are already members of those groups.
6. Sorts the resulting outputs by display name and retains local output as the
first option.
The `discovering` state lets polling clients show progress. Discovery failures
are recorded in the shared player error field.
### 3.6 HTTP and browser layers
[`private/server.rkt`](private/server.rkt) uses Racket's servlet web server. It
serves static assets from [`public/`](public/) and exposes three JSON endpoints:
| Method | Route | Responsibility |
| --- | --- | --- |
| `GET` | `/api/state` | Return the complete current state; also refresh network-renderer information. |
| `POST` | `/api/discover` | Start asynchronous discovery and return the current state. |
| `POST` | `/api/command/:command` | Execute a command with its JSON request body and return the updated state. |
| `POST` | `/api/agent/register` | Register or refresh a polling playback agent. |
| `POST` | `/api/agent/poll` | Accept agent state and acknowledgements and return its next command. |
| `GET` | `/api/agent/media/:app-id/:token` | Download the track currently assigned to an agent. |
Responses use `Cache-Control: no-store`. Command failures are returned as HTTP
400 JSON responses with an `error` property. Unexpected failures are currently
reported through the same client-facing mechanism.
[`public/app.js`](public/app.js) implements a framework-free client. It:
- fetches a full state snapshot once per second;
- temporarily suppresses polling while a browser-initiated command is active;
- immediately renders the state returned by successful commands;
- renders library navigation, playlists, tabs, transport status, and output
selection;
- implements keyboard actions and playlist drag-and-drop in the browser.
DOM signatures prevent rebuilding unchanged library, tab, and playlist
collections on every poll. Playback status and other small values are updated
on every render.
## 4. Key runtime flows
### 4.1 Browse and play a directory
```mermaid
sequenceDiagram
participant B as Browser
participant H as HTTP server
participant P as Player
participant L as Library
participant A as Audio backend
B->>H: POST /api/command/item-play {index}
H->>P: player-command!("item-play", data)
P->>L: Resolve entry and recursively collect tracks
L-->>P: Tracks with metadata
P->>P: Stop playback and replace current playlist
P->>A: Lazily create backend if needed
P->>A: Play first track
P-->>H: Full state snapshot
H-->>B: JSON response
```
### 4.2 Poll network playback state
```mermaid
sequenceDiagram
participant B as Browser
participant H as HTTP server
participant P as Player
participant D as DLNA renderer
loop Every second
B->>H: GET /api/state
H->>P: player-state->jsexpr
P->>D: Query transport, position, track and volume
D-->>P: Current renderer information
P-->>H: Full state snapshot
H-->>B: JSON response
end
```
## 5. Concurrency and consistency
The application uses two semaphores with separate responsibilities:
- `command-lock` serializes commands and shutdown, preventing overlapping state
transitions and backend operations.
- `state-lock` protects short reads and mutations of the shared player fields
performed by HTTP requests, audio callbacks, and the discovery thread.
Potentially slow discovery runs outside the state lock. Backend calls are also
generally performed outside it, with their results committed in short locked
sections. A state request is not serialized by `command-lock`; it may observe
the last committed state while a command is performing external I/O, but its
snapshot is internally protected by `state-lock`.
The server module stores the player in a module-level `current-player` variable.
This matches the intended one-player-per-process deployment, but it prevents
multiple independent player instances from being served safely within the same
Racket process.
## 6. Configuration and deployment
The application accepts settings from command-line options and an optional INI
file:
- web listen address, defaulting to `127.0.0.1`;
- web port, defaulting to `8080`;
- DLNA media publication port, defaulting to `8734`;
- one or more library root paths.
Command-line network settings override INI values. Library paths from both
sources are combined and de-duplicated.
There is no database, migration process, user account, or persistent playlist
store. Restarting the process resets playlists, output discovery, transport
state, and all other mutable state.
## 7. Security and operational boundaries
The service has no authentication, authorization, TLS termination, CSRF
protection, or per-user state. Anyone who can reach the HTTP port can inspect
the exposed library names and control the shared player. The default localhost
binding is therefore an important security boundary. Binding to a LAN address
should be an explicit deployment decision and should use an external trusted
network boundary or authenticated reverse proxy when untrusted clients are
possible.
Playback-agent IDs are random identifiers and media URLs additionally contain
an opaque per-track token. They prevent accidental cross-agent media access but
must not be treated as authentication when transported over unencrypted HTTP.
The configured library roots define the intended filesystem boundary. Clients
operate on opaque indexes instead of sending paths directly. The DLNA backend
must make a selected local file reachable by the network renderer, so its media
port also needs to be accessible on the relevant trusted network.
There is no durable job queue or retry policy. Discovery and renderer failures
are surfaced as shared UI errors, and renderer state is retried naturally by
subsequent polling requests.
## 8. Testing and extension points
Unit tests embedded in `private/library.rkt` cover root creation, filtering, and
directory ordering. Tests in `private/player.rkt` cover initial state, browser
navigation, repeat mode, playlist-tab operations, unknown commands, and clean
shutdown. The current suite does not exercise real audio devices, network
discovery, DLNA renderers, HTTP routing, or browser behavior.
The main extension points are:
- add media formats through the capabilities exposed by `racket-audio`;
- add a renderer kind by extending discovery, backend creation/cleanup, command
dispatch, and state refresh in `private/player.rkt`;
- add an API operation by defining its player command first and exposing it
through the generic command endpoint;
- add persistence behind playlist-tab and player initialization without
changing the browser's snapshot-oriented protocol;
- replace polling with server-pushed updates while keeping the current state
snapshot as the synchronization model.
## 9. Architectural constraints and trade-offs
- **Single shared state:** simple coordination and UI synchronization, but no
multi-user isolation or horizontal scaling.
- **Full-state snapshots:** a small and predictable client protocol, at the cost
of repeatedly transferring all tracks and browser entries.
- **One-second polling:** robust and dependency-free, but introduces periodic
traffic and up to one second of display latency.
- **Lazy filesystem and backend initialization:** fast startup and low idle
resource usage, while the first recursive selection or playback command can
be comparatively slow.
- **In-memory playlists:** minimal operational complexity, but no recovery after
restart.
- **Explicit backend branching:** easy to follow for the current small set of
outputs, but adding renderer types touches several player functions rather
than one formal backend interface.
README.md
+42 -1
View File
@@ -62,9 +62,50 @@ aanwezig en worden niet na een herstart hersteld.
De server luistert standaard alleen op localhost. Geef alleen bewust een De server luistert standaard alleen op localhost. Geef alleen bewust een
LAN-adres aan `--listen-ip`; de huidige opzet bevat geen authenticatie. LAN-adres aan `--listen-ip`; de huidige opzet bevat geen authenticatie.
## Windows playback agent
Een lichte playback agent kan op een Windows-laptop draaien en meldt zichzelf
via HTTP bij de centrale RKT Web Player aan. De agent opent geen inkomende
netwerkpoort. Hij pollt de server voor opdrachten en rapporteert daarbij zijn
actuele afspeelstatus.
Start vanuit de broncode:
```console
racket player-agent.rkt
```
Dezelfde GUI kan vanuit een ander Racket-programma worden gestart:
```racket
#lang racket/base
(require rkt-web-player/player-agent)
(run-player-agent)
```
De GUI bewaart de server-URL, de gekozen naam en een eenmalig gegenereerde
256-bit applicatie-ID in `rkt-web-player-agent.ini` in de gebruikersspecifieke
Racket-configuratiemap. Vul als server bijvoorbeeld `http://192.168.1.10:8080`
in. De naam wordt in dezelfde agent-GUI ingesteld. Na registratie verschijnt
de agent met die naam als uitvoer van type `AGENT`; de server volgt latere
naamswijzigingen bij registratie en polling.
De eerste implementatie downloadt een geselecteerde track volledig naar een
tijdelijk bestand voordat `racket-audio` de weergave start. Daardoor is de
implementatie klein en zijn geen gedeelde mappen nodig, maar het starten van
grote bestanden kan merkbaar langer duren. Het tijdelijke bestand wordt bij de
volgende track of bij afsluiten verwijderd.
De applicatie-ID identificeert de agent en begrenst toegang tot zijn tijdelijke
media-URL, maar vervangt geen transportbeveiliging of authenticatie. Gebruik de
agent en server alleen op een vertrouwd LAN zolang de HTTP-server geen TLS en
gebruikersauthenticatie heeft.
## Controleren ## Controleren
```console ```console
raco test --drdr private/library.rkt private/player.rkt raco test private/library.rkt private/player.rkt
raco setup --check-pkg-deps rkt-web-player raco setup --check-pkg-deps rkt-web-player
``` ```
info.rkt
+2
View File
@@ -8,6 +8,8 @@
(define deps (define deps
'("base" '("base"
"gui-lib"
"net-lib"
"web-server-lib" "web-server-lib"
"racket-audio" "racket-audio"
"racket-audio-dlna" "racket-audio-dlna"
player-agent.rkt
+16
View File
@@ -0,0 +1,16 @@
#lang racket/base
(provide run-player-agent)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Start the graphical polling playback agent.
; pre : A graphical desktop is available.
; post : The agent remains active until its window is closed.
; result : The GUI frame returned by the implementation.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (run-player-agent)
((dynamic-require "private/player-agent-gui.rkt"
'run-player-agent-gui)))
(module+ main
(run-player-agent))
private/player-agent-gui.rkt
+416
View File
@@ -0,0 +1,416 @@
#lang racket/base
(require file/sha1
json
net/url
racket-audio
racket/class
racket/file
racket/gui/base
racket/os
racket/path
racket/port
racket/random
racket/string
simple-ini
simple-log)
(provide run-player-agent-gui)
(sl-def-log player-agent)
(define config-file
(get-ini-file 'rkt-web-player-agent))
(define log-file
(build-path (find-system-path 'pref-dir)
"rkt-web-player-agent.log"))
(define (fresh-app-id)
(bytes->hex-string (crypto-random-bytes 32)))
(define (valid-app-id? value)
(and (string? value)
(regexp-match? #px"^[0-9a-fA-F]{64}$" value)))
(define config
(file->ini config-file))
(define app-id
(let ((configured (ini-get config 'agent 'app-id #f)))
(if (valid-app-id? configured)
(string-downcase configured)
(fresh-app-id))))
(define server-url
(ini-get config 'server 'url "http://127.0.0.1:8080"))
(define assigned-name
(ini-get config 'agent 'name
(format "~a playback" (gethostname))))
(define (save-config!)
(ini-set! config 'agent 'app-id app-id)
(ini-set! config 'agent 'name assigned-name)
(ini-set! config 'server 'url server-url)
(ini->file config config-file #:private? #t))
(save-config!)
(define (base-url value)
(string->url
(regexp-replace #px"/+$" (string-trim value) "")))
(define (endpoint-url base path)
(combine-url/relative (base-url base) path))
(define (post-json base path data)
(let ((input
(post-pure-port
(endpoint-url base path)
(jsexpr->bytes data)
(list "Content-Type: application/json"
"Cache-Control: no-store"))))
(dynamic-wind
void
(λ ()
(let ((response (read-json input)))
(when (and (hash? response)
(string? (hash-ref response 'error #f)))
(error 'player-agent
(hash-ref response 'error)))
response))
(λ ()
(close-input-port input)))))
(define (normal-state state)
(cond
((eq? state 'transitioning) "starting")
((eq? state 'initialized) "stopped")
((eq? state 'no-media) "stopped")
(else (symbol->string state))))
(define (safe-delete-file file)
(when (and file (file-exists? file))
(with-handlers ((exn:fail?
(λ (exception)
(warn-player-agent
"Could not remove temporary media file ~a: ~a"
file
(exn-message exception)))))
(delete-file file))))
(define (run-player-agent-gui)
(sl-log-to-file log-file)
(define state-lock (make-semaphore 1))
(define worker #f)
(define command-worker #f)
(define executing-command-id 0)
(define running? #f)
(define audio #f)
(define temporary-media #f)
(define acknowledged-command 0)
(define ended-counter 0)
(define logical-volume 50)
(define agent-state
(hasheq 'state "stopped"
'position 0
'duration 'null
'rate 'null
'channels 'null
'bits 'null
'format ""
'volume logical-volume
'error 'null))
(define (with-agent-state proc)
(call-with-semaphore state-lock proc))
(define (state-value value fallback)
(if (eq? value #f) fallback value))
(define (update-from-audio! state full-state)
(with-agent-state
(λ ()
(set! agent-state
(hasheq
'state (normal-state state)
'position
(state-value (hash-ref full-state 'at-second #f) 0)
'duration
(state-value (hash-ref full-state 'duration #f) 'null)
'rate
(state-value (hash-ref full-state 'rate #f) 'null)
'channels
(state-value (hash-ref full-state 'channels #f) 'null)
'bits
(state-value (hash-ref full-state 'bits #f) 'null)
'format
(let ((decoder (hash-ref full-state 'decoder #f)))
(if decoder (format "~a" decoder) ""))
'volume logical-volume
'error 'null)))))
(define (set-agent-error! message)
(with-agent-state
(λ ()
(set! agent-state
(hash-set agent-state 'error message)))))
(define (clear-agent-error!)
(with-agent-state
(λ ()
(set! agent-state
(hash-set agent-state 'error 'null)))))
(define (state-snapshot)
(with-agent-state
(λ () agent-state)))
(define (ensure-audio!)
(unless audio
(set! audio
(make-audio-player
(λ (_handle state full-state)
(update-from-audio! state full-state))
(λ (_handle)
(with-agent-state
(λ ()
(set! ended-counter (+ ended-counter 1)))))))
(audio-ao-buf-ms! audio 500)
(audio-buf-seconds! audio 4 10)
(let ((scaled (/ logical-volume 100.0)))
(audio-volume! audio (* 100.0 scaled scaled))))
audio)
(define (download-media! token filename)
(let* ((extension
(or (path-get-extension (string->path filename)) #""))
(template
(string-append "rkt-player-agent-~a"
(bytes->string/utf-8 extension)))
(target (make-temporary-file template))
(path
(format "/api/agent/media/~a/~a" app-id token))
(input (get-pure-port (endpoint-url server-url path))))
(with-handlers
((exn:fail?
(λ (exception)
(close-input-port input)
(safe-delete-file target)
(raise exception))))
(call-with-output-file
target
(λ (output)
(copy-port input output))
#:exists 'truncate/replace)
(close-input-port input)
target)))
(define (execute-command! command)
(let* ((action (hash-ref command 'action ""))
(data (hash-ref command 'data (hasheq))))
(info-player-agent "Executing command ~a" action)
(cond
((string=? action "play")
(let ((next-media
(download-media!
(hash-ref data 'mediaToken)
(hash-ref data 'filename "track"))))
(when audio (audio-stop! audio))
(safe-delete-file temporary-media)
(set! temporary-media next-media)
(audio-play! (ensure-audio!) temporary-media)))
((string=? action "pause")
(audio-pause! (ensure-audio!) #t))
((string=? action "resume")
(audio-pause! (ensure-audio!) #f))
((string=? action "stop")
(when audio (audio-stop! audio)))
((string=? action "seek")
(audio-seek! (ensure-audio!)
(hash-ref data 'percentage 0)))
((string=? action "volume")
(set! logical-volume
(min 100 (max 0 (hash-ref data 'value 50))))
(let ((scaled (/ logical-volume 100.0)))
(audio-volume! (ensure-audio!)
(* 100.0 scaled scaled)))
(with-agent-state
(λ ()
(set! agent-state
(hash-set agent-state
'volume
logical-volume)))))
(else
(error 'player-agent "unknown command: ~a" action)))))
(define frame #f)
(define status-message #f)
(define name-field #f)
(define server-field #f)
(define connect-button #f)
(define (show-status! message)
(queue-callback
(λ ()
(when status-message
(send status-message set-label message)))
#f))
(define (show-name! name)
(queue-callback
(λ ()
(when name-field
(send name-field set-value name)))
#f))
(define (poll-loop)
(with-handlers
((exn:fail?
(λ (exception)
(warn-player-agent "Connection cycle failed: ~a"
(exn-message exception))
(set-agent-error! (exn-message exception))
(show-status! (format "Niet verbonden: ~a"
(exn-message exception)))
(when running?
(sleep 3)
(poll-loop)))))
(let ((registration
(post-json
server-url
"/api/agent/register"
(hasheq 'appId app-id
'name assigned-name))))
(show-name! assigned-name)
(clear-agent-error!)
(show-status! "Verbonden")
(info-player-agent "Registered at ~a as ~a"
server-url assigned-name)
(let loop ()
(when running?
(let* ((response
(post-json
server-url
"/api/agent/poll"
(hasheq 'appId app-id
'name assigned-name
'ack acknowledged-command
'endedCounter ended-counter
'state (state-snapshot))))
(command
(hash-ref response 'command 'null)))
(when (and (hash? command)
(> (hash-ref command 'id 0)
acknowledged-command)
(not (= (hash-ref command 'id 0)
executing-command-id)))
(set! executing-command-id
(hash-ref command 'id))
(set!
command-worker
(thread
(λ ()
(with-handlers
((exn:fail?
(λ (exception)
(warn-player-agent "Command failed: ~a"
(exn-message exception))
(set-agent-error!
(exn-message exception)))))
(clear-agent-error!)
(execute-command! command))
(set! acknowledged-command
(hash-ref command 'id))
(set! executing-command-id 0)
(set! command-worker #f)))))
(sleep 1)
(loop)))))))
(define (start-worker!)
(set! running? #t)
(set! worker (thread poll-loop))
(send connect-button set-label "Opnieuw verbinden"))
(define (stop-worker!)
(set! running? #f)
(when (and worker (not (thread-dead? worker)))
(kill-thread worker))
(when (and command-worker
(not (thread-dead? command-worker)))
(kill-thread command-worker))
(set! worker #f)
(set! command-worker #f)
(set! executing-command-id 0))
(define (reconnect!)
(stop-worker!)
(set! server-url (string-trim (send server-field get-value)))
(let ((new-name (string-trim (send name-field get-value))))
(set! assigned-name
(if (string=? new-name "")
(format "~a playback" (gethostname))
new-name)))
(save-config!)
(show-status! "Verbinden…")
(start-worker!))
(define agent-frame%
(class frame%
(super-new)
(define/override (on-close)
(stop-worker!)
(when audio
(with-handlers ((exn:fail? void))
(audio-quit! audio)))
(safe-delete-file temporary-media)
(super on-close))))
(set! frame
(new agent-frame%
(label "RKT Web Player Agent")
(width 560)
(height 230)))
(define panel
(new vertical-panel%
(parent frame)
(alignment '(left top))
(border 12)
(spacing 8)))
(set! server-field
(new text-field%
(parent panel)
(label "RKT Web Player server")
(init-value server-url)))
(set! name-field
(new text-field%
(parent panel)
(label "Naam")
(init-value assigned-name)))
(define id-field
(new text-field%
(parent panel)
(label "Applicatie-ID")
(init-value app-id)))
(send id-field enable #f)
(define controls
(new horizontal-panel%
(parent panel)
(alignment '(left center))))
(set! connect-button
(new button%
(parent controls)
(label "Opslaan en verbinden")
(callback (λ (_button _event)
(reconnect!)))))
(set! status-message
(new message%
(parent controls)
(label "Verbinden…")
(auto-resize #t)))
(send frame show #t)
(start-worker!)
frame)
private/player.rkt
+439 -35
View File
@@ -2,8 +2,10 @@
(require racket-audio (require racket-audio
racket-audio-dlna racket-audio-dlna
file/sha1
racket/list racket/list
racket/path racket/path
racket/random
racket/string racket/string
racket-sonos racket-sonos
racket-upnp racket-upnp
@@ -14,12 +16,27 @@
player-state->jsexpr player-state->jsexpr
player-command! player-command!
player-discover! player-discover!
player-agent-register!
player-agent-poll!
player-agent-media
player-close!) player-close!)
(sl-def-log web-player) (sl-def-log web-player)
(struct renderer (struct renderer
(id name kind device) (id [name #:mutable] kind device)
#:transparent)
(struct playback-agent
(app-id
[name #:mutable]
[last-seen #:mutable]
[reported-state #:mutable]
[commands #:mutable]
[next-command-id #:mutable]
[media-token #:mutable]
[media-file #:mutable]
[ended-counter #:mutable])
#:transparent) #:transparent)
(struct playlist-tab (struct playlist-tab
@@ -28,6 +45,7 @@
(struct player (struct player
(libraries (libraries
[agents #:mutable]
[current-library-id #:mutable] [current-library-id #:mutable]
[browser-path #:mutable] [browser-path #:mutable]
[browser-entries #:mutable] [browser-entries #:mutable]
@@ -68,6 +86,80 @@
(string=? (renderer-id item) id)) (string=? (renderer-id item) id))
(player-renderers value))) (player-renderers value)))
(define (agent-renderer-id app-id)
(string-append "agent:" app-id))
(define (agent-by-id value app-id)
(findf (λ (agent)
(string=? (playback-agent-app-id agent) app-id))
(player-agents value)))
(define (agent-renderer value agent)
(renderer-by-id value
(agent-renderer-id
(playback-agent-app-id agent))))
(define (valid-agent-id? value)
(and (string? value)
(regexp-match? #px"^[0-9a-fA-F]{64}$" value)))
(define (fresh-media-token)
(bytes->hex-string (crypto-random-bytes 32)))
(define (enqueue-agent-command! value agent action [data (hasheq)])
(with-state-lock
value
(λ ()
(let* ((id (playback-agent-next-command-id agent))
(command (hasheq 'id id
'action action
'data data)))
(set-playback-agent-next-command-id! agent (+ id 1))
(set-playback-agent-commands!
agent
(append (playback-agent-commands agent)
(list command)))
command))))
(define agent-heartbeat-timeout-seconds 10)
(define (prune-stale-agents! value)
(with-state-lock
value
(λ ()
(let* ((cutoff (- (current-seconds)
agent-heartbeat-timeout-seconds))
(stale
(filter (λ (agent)
(< (playback-agent-last-seen agent) cutoff))
(player-agents value)))
(stale-ids
(map (λ (agent)
(agent-renderer-id
(playback-agent-app-id agent)))
stale)))
(unless (null? stale)
(set-player-agents!
value
(filter (λ (agent)
(not (member (agent-renderer-id
(playback-agent-app-id agent))
stale-ids)))
(player-agents value)))
(set-player-renderers!
value
(filter (λ (item)
(not (member (renderer-id item) stale-ids)))
(player-renderers value)))
(when (member (player-selected-id value) stale-ids)
(set-player-selected-id! value "local")
(set-player-backend! value #f)
(set-player-backend-kind! value #f)
(set-player-state! value 'stopped)
(set-player-position! value 0)
(set-player-duration! value #f)
(reset-audio-info! value)))))))
(define (library-by-id value id) (define (library-by-id value id)
(findf (λ (library) (findf (λ (library)
(string=? (music-library-id library) id)) (string=? (music-library-id library) id))
@@ -177,6 +269,8 @@
(make-network-backend (make-network-backend
value value
(renderer-device selected))) (renderer-device selected)))
((eq? kind 'agent)
(renderer-device selected))
(else (else
(raise-arguments-error (raise-arguments-error
'player-command! 'player-command!
@@ -200,9 +294,13 @@
"Could not close ~a player: ~a" "Could not close ~a player: ~a"
kind kind
(exn-message exception))))) (exn-message exception)))))
(if (eq? kind 'local) (cond
(audio-quit! backend) ((eq? kind 'local)
(dlna-player-close! backend)))) (audio-quit! backend))
((eq? kind 'agent)
(enqueue-agent-command! value backend "stop"))
(else
(dlna-player-close! backend)))))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
@@ -215,9 +313,15 @@
(define (stop-playback! value) (define (stop-playback! value)
(when (player-backend value) (when (player-backend value)
(if (eq? (player-backend-kind value) 'local) (cond
(audio-stop! (player-backend value)) ((eq? (player-backend-kind value) 'local)
(dlna-player-stop! (player-backend value)))) (audio-stop! (player-backend value)))
((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command! value
(player-backend value)
"stop"))
(else
(dlna-player-stop! (player-backend value)))))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
@@ -245,9 +349,27 @@
(set-player-state! value 'starting) (set-player-state! value 'starting)
(set-player-position! value 0) (set-player-position! value 0)
(set-player-duration! value (track-duration item)))) (set-player-duration! value (track-duration item))))
(if (eq? kind 'local) (cond
(audio-play! backend (track-file item)) ((eq? kind 'local)
(dlna-player-play! backend (track-file item))) (audio-play! backend (track-file item)))
((eq? kind 'agent)
(let ((token (fresh-media-token)))
(with-state-lock
value
(λ ()
(set-playback-agent-media-token! backend token)
(set-playback-agent-media-file! backend (track-file item))))
(enqueue-agent-command!
value
backend
"play"
(hasheq 'mediaToken token
'filename
(path->string
(or (file-name-from-path (track-file item))
(track-file item)))))))
(else
(dlna-player-play! backend (track-file item))))
(clear-error! value))) (clear-error! value)))
(define (next-index value direction) (define (next-index value direction)
@@ -274,8 +396,50 @@
((exn:fail? ((exn:fail?
(λ (exception) (λ (exception)
(set-error! value (exn-message exception))))) (set-error! value (exn-message exception)))))
(let* ((info (dlna-player-info (player-backend value))) (if (eq? (player-backend-kind value) 'agent)
(track-info (dlna-info-track info))) (let ((reported
(playback-agent-reported-state
(player-backend value))))
;; Keep the server's optimistic command state visible until the
;; agent acknowledges all queued work. Its report in the poll that
;; receives a command still describes the state before execution.
(when (and (hash? reported)
(null? (playback-agent-commands
(player-backend value))))
(with-state-lock
value
(λ ()
(let ((state (hash-ref reported 'state #f)))
(when (string? state)
(set-player-state!
value
(normalize-state (string->symbol state)))))
(set-player-position!
value
(or (json-number reported 'position #f) 0))
(set-player-duration!
value
(json-number reported 'duration #f))
(set-player-rate!
value
(json-number reported 'rate #f))
(set-player-channels!
value
(json-number reported 'channels #f))
(set-player-bits!
value
(json-number reported 'bits #f))
(let ((decoder (json-string reported 'format #f)))
(set-player-decoder!
value
(and decoder (string->symbol decoder))))
(let ((volume (json-number reported 'volume #f)))
(when volume
(set-player-volume! value volume)))
(let ((error (json-string reported 'error #f)))
(set-player-error! value error))))))
(let* ((info (dlna-player-info (player-backend value)))
(track-info (dlna-info-track info)))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
@@ -300,7 +464,7 @@
(set-player-decoder! value 'dlna) (set-player-decoder! value 'dlna)
(when (number? (dlna-info-volume info)) (when (number? (dlna-info-volume info))
(set-player-volume! value (set-player-volume! value
(dlna-info-volume info))))))))) (dlna-info-volume info))))))))))
(define (entry-by-index value index) (define (entry-by-index value index)
(and (exact-nonnegative-integer? index) (and (exact-nonnegative-integer? index)
@@ -685,14 +849,22 @@
0))) 0)))
((string=? command "pause") ((string=? command "pause")
(let ((backend (ensure-backend! value))) (let ((backend (ensure-backend! value)))
(if (eq? (player-backend-kind value) 'local) (cond
(audio-pause! backend #t) ((eq? (player-backend-kind value) 'local)
(dlna-player-pause! backend)))) (audio-pause! backend #t))
((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command! value backend "pause"))
(else
(dlna-player-pause! backend)))))
((string=? command "resume") ((string=? command "resume")
(let ((backend (ensure-backend! value))) (let ((backend (ensure-backend! value)))
(if (eq? (player-backend-kind value) 'local) (cond
(audio-pause! backend #f) ((eq? (player-backend-kind value) 'local)
(dlna-player-resume! backend)))) (audio-pause! backend #f))
((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command! value backend "resume"))
(else
(dlna-player-resume! backend)))))
((string=? command "stop") ((string=? command "stop")
(stop-playback! value)) (stop-playback! value))
((string=? command "next") ((string=? command "next")
@@ -711,9 +883,15 @@
'player-command! 'player-command!
"seek requires a numeric percentage")) "seek requires a numeric percentage"))
(let ((backend (ensure-backend! value))) (let ((backend (ensure-backend! value)))
(if (eq? (player-backend-kind value) 'local) (cond
(audio-seek! backend percentage) ((eq? (player-backend-kind value) 'local)
(dlna-player-seek-percentage! backend percentage))))) (audio-seek! backend percentage))
((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command!
value backend "seek"
(hasheq 'percentage percentage)))
(else
(dlna-player-seek-percentage! backend percentage))))))
((string=? command "volume") ((string=? command "volume")
(let ((percentage (json-number data 'value #f))) (let ((percentage (json-number data 'value #f)))
(unless percentage (unless percentage
@@ -722,12 +900,18 @@
"volume requires a numeric value")) "volume requires a numeric value"))
(let* ((clamped (min 100 (max 0 percentage))) (let* ((clamped (min 100 (max 0 percentage)))
(backend (ensure-backend! value))) (backend (ensure-backend! value)))
(if (eq? (player-backend-kind value) 'local) (cond
(let ((logical-volume (/ clamped 100.0))) ((eq? (player-backend-kind value) 'local)
(audio-volume! (let ((logical-volume (/ clamped 100.0)))
backend (audio-volume!
(* 100.0 logical-volume logical-volume))) backend
(dlna-player-volume! backend clamped)) (* 100.0 logical-volume logical-volume))))
((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command!
value backend "volume"
(hasheq 'value clamped)))
(else
(dlna-player-volume! backend clamped)))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
@@ -757,7 +941,7 @@
(with-state-lock (with-state-lock
value value
(λ () (λ ()
(set-player-selected-id! value id)))))) (set-player-selected-id! value id))))))
(else (else
(raise-arguments-error (raise-arguments-error
'player-command! 'player-command!
@@ -782,13 +966,14 @@
'())) '()))
(tab (playlist-tab "default" "Default" '()))) (tab (playlist-tab "default" "Default" '())))
(player libraries (player libraries
'()
(and library (music-library-id library)) (and library (music-library-id library))
'() '()
browser-entries browser-entries
'() '()
(list tab) (list tab)
0 0
(list (renderer "local" "Dit apparaat" 'local #f)) (list (renderer "local" "Server audio output" 'local #f))
"local" "local"
#f #f
#f #f
@@ -816,6 +1001,7 @@
; result : A JSON-compatible hash. ; result : A JSON-compatible hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-state->jsexpr value) (define (player-state->jsexpr value)
(prune-stale-agents! value)
(refresh-network-state! value) (refresh-network-state! value)
(with-state-lock (with-state-lock
value value
@@ -922,11 +1108,15 @@
(λ () (λ ()
(set-player-renderers! (set-player-renderers!
value value
(cons (renderer "local" (append
"Dit apparaat" (list (renderer "local"
'local "Server audio output"
#f) 'local
found)) #f))
found
(filter (λ (item)
(eq? (renderer-kind item) 'agent))
(player-renderers value))))
(set-player-error! value #f))))) (set-player-error! value #f)))))
(with-state-lock (with-state-lock
value value
@@ -934,6 +1124,145 @@
(set-player-discovering?! value #f)))))) (set-player-discovering?! value #f))))))
can-start?)) can-start?))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Register or refresh one polling playback agent.
; pre : Data contains a 256-bit hexadecimal application id.
; post : The agent is available as a renderer under its advertised name.
; result : Agent configuration for the polling client.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-agent-register! value data)
(let* ((app-id (json-string data 'appId #f))
(suggested-name
(string-trim
(or (json-string data 'name #f)
"RKT playback agent"))))
(unless (valid-agent-id? app-id)
(raise-arguments-error
'player-agent-register!
"appId must contain exactly 64 hexadecimal characters"
"appId" app-id))
(with-state-lock
value
(λ ()
(let ((existing (agent-by-id value app-id)))
(if existing
(begin
(set-playback-agent-name! existing suggested-name)
(let ((agent-output (agent-renderer value existing)))
(when agent-output
(set-renderer-name! agent-output suggested-name)))
(set-playback-agent-last-seen!
existing
(current-seconds))
(hasheq 'name (playback-agent-name existing)
'pollIntervalMs 1000))
(let* ((name
(if (string=? suggested-name "")
"RKT playback agent"
suggested-name))
(agent
(playback-agent
app-id name (current-seconds)
(hasheq 'state "stopped"
'position 0
'volume 50)
'() 1 #f #f 0)))
(set-player-agents!
value
(append (player-agents value) (list agent)))
(set-player-renderers!
value
(append
(player-renderers value)
(list (renderer (agent-renderer-id app-id)
name
'agent
agent))))
(hasheq 'name name
'pollIntervalMs 1000))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Accept agent state and return its oldest unacknowledged command.
; pre : The agent was registered with player-agent-register!.
; post : State, heartbeat, acknowledgements and end-of-track are incorporated.
; result : Poll response containing the current agent name and optional command.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-agent-poll! value data)
(let ((app-id (json-string data 'appId #f))
(name (json-string data 'name #f)))
(unless (valid-agent-id? app-id)
(raise-arguments-error
'player-agent-poll!
"appId must contain exactly 64 hexadecimal characters"
"appId" app-id))
(call-with-semaphore
(player-command-lock value)
(λ ()
(let ((agent (agent-by-id value app-id)))
(unless agent
(raise-arguments-error
'player-agent-poll!
"playback agent is not registered"
"appId" app-id))
(let* ((ack (json-number data 'ack #f))
(reported (hash-ref data 'state #f))
(ended (json-number data 'endedCounter 0))
(previous-ended
(playback-agent-ended-counter agent)))
(with-state-lock
value
(λ ()
(set-playback-agent-last-seen! agent (current-seconds))
(when (and name
(not (string=? (string-trim name) "")))
(let ((trimmed (string-trim name))
(agent-output (agent-renderer value agent)))
(set-playback-agent-name! agent trimmed)
(when agent-output
(set-renderer-name! agent-output trimmed))))
(when (hash? reported)
(set-playback-agent-reported-state! agent reported))
(when (exact-nonnegative-integer? ack)
(set-playback-agent-commands!
agent
(filter
(λ (command)
(> (hash-ref command 'id) ack))
(playback-agent-commands agent))))
(when (exact-nonnegative-integer? ended)
(set-playback-agent-ended-counter! agent ended))))
(when (and (> ended previous-ended)
(string=? (player-selected-id value)
(agent-renderer-id app-id))
(eq? (player-backend value) agent))
(let ((index (next-index value 1)))
(if index
(play-index! value index)
(stop-playback! value))))
(hasheq
'name (playback-agent-name agent)
'command
(if (null? (playback-agent-commands agent))
'null
(car (playback-agent-commands agent))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Resolve the current opaque media token for one playback agent.
; pre : App id and token came from a play command returned by agent polling.
; post : No state changes.
; result : The local track path, or #f when the token is invalid or expired.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-agent-media value app-id token)
(with-state-lock
value
(λ ()
(let ((agent (and (valid-agent-id? app-id)
(agent-by-id value app-id))))
(and agent
(string? token)
(equal? token (playback-agent-media-token agent))
(playback-agent-media-file agent))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Stop playback and release all player resources. ; goal : Stop playback and release all player resources.
; pre : Value was created with make-player. ; pre : Value was created with make-player.
@@ -1026,6 +1355,81 @@
(hasheq 'index 1))) (hasheq 'index 1)))
(check-equal? (length (hash-ref deleted-state 'tabs)) 1) (check-equal? (length (hash-ref deleted-state 'tabs)) 1)
(define test-agent-id
(make-string 64 #\a))
(define registration
(player-agent-register!
example-player
(hasheq 'appId test-agent-id
'name "Test laptop")))
(check-equal? (hash-ref registration 'name) "Test laptop")
(define agent-renderer-state
(player-command!
example-player
"renderer"
(hasheq 'id (agent-renderer-id test-agent-id))))
(check-equal?
(hash-ref agent-renderer-state 'rendererId)
(agent-renderer-id test-agent-id))
(player-command!
example-player
"volume"
(hasheq 'value 25))
(define first-poll
(player-agent-poll!
example-player
(hasheq 'appId test-agent-id
'ack 0
'endedCounter 0
'state
(hasheq 'state "stopped"
'position 0
'volume 25))))
(check-equal?
(hash-ref (hash-ref first-poll 'command) 'action)
"volume")
(define first-command-id
(hash-ref (hash-ref first-poll 'command) 'id))
(define acknowledged-poll
(player-agent-poll!
example-player
(hasheq 'appId test-agent-id
'ack first-command-id
'endedCounter 0
'state
(hasheq 'state "stopped"
'position 0
'volume 25))))
(check-eq? (hash-ref acknowledged-poll 'command) 'null)
(check-equal?
(hash-ref
(player-agent-register!
example-player
(hasheq 'appId test-agent-id
'name "Office laptop"))
'name)
"Office laptop")
(check-equal?
(renderer-name
(findf
(λ (item)
(string=? (renderer-id item)
(agent-renderer-id test-agent-id)))
(player-renderers example-player)))
"Office laptop")
(check-exn exn:fail? (check-exn exn:fail?
(λ () (λ ()
(player-command! (player-command!
private/server.rkt
+48
View File
@@ -2,7 +2,10 @@
(require json (require json
racket/contract racket/contract
racket/file
racket/port
racket/runtime-path racket/runtime-path
racket-mimetypes
web-server/dispatch web-server/dispatch
web-server/http web-server/http
web-server/http/json web-server/http/json
@@ -52,10 +55,55 @@
command command
(request-jsexpr request))))) (request-jsexpr request)))))
(define (agent-register-handler request)
(with-handlers
((exn:fail? error-response))
(json-response
(player-agent-register!
current-player
(request-jsexpr request)))))
(define (agent-poll-handler request)
(with-handlers
((exn:fail? error-response))
(json-response
(player-agent-poll!
current-player
(request-jsexpr request)))))
(define (agent-media-handler _request app-id token)
(let ((file (player-agent-media current-player app-id token)))
(if (and file (file-exists? file))
(response/output
(λ (output)
(call-with-input-file
file
(λ (input)
(copy-port input output))))
#:mime-type
(let ((mime (mimetype-for-ext file)))
(if (string? mime)
(string->bytes/utf-8 mime)
#"application/octet-stream"))
#:headers
(list
(header #"Content-Length"
(string->bytes/utf-8
(number->string (file-size file))))
(header #"Cache-Control" #"no-store")))
(json-response
(hasheq 'error "media token is invalid or expired")
#:code 404))))
(define-values (dispatch _url) (define-values (dispatch _url)
(dispatch-rules (dispatch-rules
[("api" "state") #:method "get" state-handler] [("api" "state") #:method "get" state-handler]
[("api" "discover") #:method "post" discover-handler] [("api" "discover") #:method "post" discover-handler]
[("api" "agent" "register") #:method "post" agent-register-handler]
[("api" "agent" "poll") #:method "post" agent-poll-handler]
[("api" "agent" "media" (string-arg) (string-arg))
#:method "get"
agent-media-handler]
[("api" "command" (string-arg)) [("api" "command" (string-arg))
#:method "post" #:method "post"
command-handler])) command-handler]))
scribblings/rkt-web-player.scrbl
+14 -1
View File
@@ -2,7 +2,8 @@
@(require (for-label racket/base @(require (for-label racket/base
racket/contract racket/contract
rkt-web-player)) rkt-web-player
rkt-web-player/player-agent))
@title{RKT Web Player} @title{RKT Web Player}
@author{Hans van Dijkema} @author{Hans van Dijkema}
@@ -32,3 +33,15 @@ network renderer. Player resources are closed when the web server exits.
The default listen address only exposes the interface to the local computer. The default listen address only exposes the interface to the local computer.
Use a LAN address deliberately if other devices should control the player. Use a LAN address deliberately if other devices should control the player.
} }
@defmodule[rkt-web-player/player-agent]
@defproc[(run-player-agent) any/c] {
Starts the graphical polling playback agent. The agent keeps a generated
256-bit application identifier in a user-specific INI file, registers with the
configured RKT Web Player server, downloads assigned tracks over HTTP, and
plays them with @tt{racket-audio}. Its configured display name is authoritative
and is followed by the server. Importing the module does not start the GUI; the
function must be called explicitly.
}