diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md new file mode 100644 index 0000000..249fa7b --- /dev/null +++ b/ARCHITECTURE.md @@ -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
configuration and lifecycle] + Server[private/server.rkt
HTTP adapter] + Player[private/player.rkt
application state and commands] + Library[private/library.rkt
filesystem and metadata] + UI[public/index.html + styles.css + app.js
browser UI] + Audio[racket-audio
local backend] + Discovery[racket-upnp + racket-sonos
device discovery] + DLNA[racket-audio-dlna
network backend and media server] + Agent[player-agent.rkt
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. diff --git a/README.md b/README.md index b0ae112..159bcdc 100644 --- a/README.md +++ b/README.md @@ -62,9 +62,50 @@ aanwezig en worden niet na een herstart hersteld. De server luistert standaard alleen op localhost. Geef alleen bewust een 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 ```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 ``` diff --git a/info.rkt b/info.rkt index d0a55e7..fbaceee 100644 --- a/info.rkt +++ b/info.rkt @@ -8,6 +8,8 @@ (define deps '("base" + "gui-lib" + "net-lib" "web-server-lib" "racket-audio" "racket-audio-dlna" diff --git a/player-agent.rkt b/player-agent.rkt new file mode 100644 index 0000000..63d8640 --- /dev/null +++ b/player-agent.rkt @@ -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)) diff --git a/private/player-agent-gui.rkt b/private/player-agent-gui.rkt new file mode 100644 index 0000000..9a015ca --- /dev/null +++ b/private/player-agent-gui.rkt @@ -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) diff --git a/private/player.rkt b/private/player.rkt index 1a6c2bf..8d108e2 100644 --- a/private/player.rkt +++ b/private/player.rkt @@ -2,8 +2,10 @@ (require racket-audio racket-audio-dlna + file/sha1 racket/list racket/path + racket/random racket/string racket-sonos racket-upnp @@ -14,12 +16,27 @@ player-state->jsexpr player-command! player-discover! + player-agent-register! + player-agent-poll! + player-agent-media player-close!) (sl-def-log web-player) (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) (struct playlist-tab @@ -28,6 +45,7 @@ (struct player (libraries + [agents #:mutable] [current-library-id #:mutable] [browser-path #:mutable] [browser-entries #:mutable] @@ -68,6 +86,80 @@ (string=? (renderer-id item) id)) (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) (findf (λ (library) (string=? (music-library-id library) id)) @@ -177,6 +269,8 @@ (make-network-backend value (renderer-device selected))) + ((eq? kind 'agent) + (renderer-device selected)) (else (raise-arguments-error 'player-command! @@ -200,9 +294,13 @@ "Could not close ~a player: ~a" kind (exn-message exception))))) - (if (eq? kind 'local) - (audio-quit! backend) - (dlna-player-close! backend)))) + (cond + ((eq? kind 'local) + (audio-quit! backend)) + ((eq? kind 'agent) + (enqueue-agent-command! value backend "stop")) + (else + (dlna-player-close! backend))))) (with-state-lock value (λ () @@ -215,9 +313,15 @@ (define (stop-playback! value) (when (player-backend value) - (if (eq? (player-backend-kind value) 'local) - (audio-stop! (player-backend value)) - (dlna-player-stop! (player-backend value)))) + (cond + ((eq? (player-backend-kind value) 'local) + (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 value (λ () @@ -245,9 +349,27 @@ (set-player-state! value 'starting) (set-player-position! value 0) (set-player-duration! value (track-duration item)))) - (if (eq? kind 'local) - (audio-play! backend (track-file item)) - (dlna-player-play! backend (track-file item))) + (cond + ((eq? kind 'local) + (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))) (define (next-index value direction) @@ -274,8 +396,50 @@ ((exn:fail? (λ (exception) (set-error! value (exn-message exception))))) - (let* ((info (dlna-player-info (player-backend value))) - (track-info (dlna-info-track info))) + (if (eq? (player-backend-kind value) 'agent) + (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 value (λ () @@ -300,7 +464,7 @@ (set-player-decoder! value 'dlna) (when (number? (dlna-info-volume info)) (set-player-volume! value - (dlna-info-volume info))))))))) + (dlna-info-volume info)))))))))) (define (entry-by-index value index) (and (exact-nonnegative-integer? index) @@ -685,14 +849,22 @@ 0))) ((string=? command "pause") (let ((backend (ensure-backend! value))) - (if (eq? (player-backend-kind value) 'local) - (audio-pause! backend #t) - (dlna-player-pause! backend)))) + (cond + ((eq? (player-backend-kind value) 'local) + (audio-pause! backend #t)) + ((eq? (player-backend-kind value) 'agent) + (enqueue-agent-command! value backend "pause")) + (else + (dlna-player-pause! backend))))) ((string=? command "resume") (let ((backend (ensure-backend! value))) - (if (eq? (player-backend-kind value) 'local) - (audio-pause! backend #f) - (dlna-player-resume! backend)))) + (cond + ((eq? (player-backend-kind value) 'local) + (audio-pause! backend #f)) + ((eq? (player-backend-kind value) 'agent) + (enqueue-agent-command! value backend "resume")) + (else + (dlna-player-resume! backend))))) ((string=? command "stop") (stop-playback! value)) ((string=? command "next") @@ -711,9 +883,15 @@ 'player-command! "seek requires a numeric percentage")) (let ((backend (ensure-backend! value))) - (if (eq? (player-backend-kind value) 'local) - (audio-seek! backend percentage) - (dlna-player-seek-percentage! backend percentage))))) + (cond + ((eq? (player-backend-kind value) 'local) + (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") (let ((percentage (json-number data 'value #f))) (unless percentage @@ -722,12 +900,18 @@ "volume requires a numeric value")) (let* ((clamped (min 100 (max 0 percentage))) (backend (ensure-backend! value))) - (if (eq? (player-backend-kind value) 'local) - (let ((logical-volume (/ clamped 100.0))) - (audio-volume! - backend - (* 100.0 logical-volume logical-volume))) - (dlna-player-volume! backend clamped)) + (cond + ((eq? (player-backend-kind value) 'local) + (let ((logical-volume (/ clamped 100.0))) + (audio-volume! + backend + (* 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 value (λ () @@ -757,7 +941,7 @@ (with-state-lock value (λ () - (set-player-selected-id! value id)))))) + (set-player-selected-id! value id)))))) (else (raise-arguments-error 'player-command! @@ -782,13 +966,14 @@ '())) (tab (playlist-tab "default" "Default" '()))) (player libraries + '() (and library (music-library-id library)) '() browser-entries '() (list tab) 0 - (list (renderer "local" "Dit apparaat" 'local #f)) + (list (renderer "local" "Server audio output" 'local #f)) "local" #f #f @@ -816,6 +1001,7 @@ ; result : A JSON-compatible hash. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (player-state->jsexpr value) + (prune-stale-agents! value) (refresh-network-state! value) (with-state-lock value @@ -922,11 +1108,15 @@ (λ () (set-player-renderers! value - (cons (renderer "local" - "Dit apparaat" - 'local - #f) - found)) + (append + (list (renderer "local" + "Server audio output" + 'local + #f)) + found + (filter (λ (item) + (eq? (renderer-kind item) 'agent)) + (player-renderers value)))) (set-player-error! value #f))))) (with-state-lock value @@ -934,6 +1124,145 @@ (set-player-discovering?! value #f)))))) 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. ; pre : Value was created with make-player. @@ -1026,6 +1355,81 @@ (hasheq 'index 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? (λ () (player-command! diff --git a/private/server.rkt b/private/server.rkt index 6fb967e..93c07f6 100644 --- a/private/server.rkt +++ b/private/server.rkt @@ -2,7 +2,10 @@ (require json racket/contract + racket/file + racket/port racket/runtime-path + racket-mimetypes web-server/dispatch web-server/http web-server/http/json @@ -52,10 +55,55 @@ command (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) (dispatch-rules [("api" "state") #:method "get" state-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)) #:method "post" command-handler])) diff --git a/scribblings/rkt-web-player.scrbl b/scribblings/rkt-web-player.scrbl index c70f2a8..5754ea7 100644 --- a/scribblings/rkt-web-player.scrbl +++ b/scribblings/rkt-web-player.scrbl @@ -2,7 +2,8 @@ @(require (for-label racket/base racket/contract - rkt-web-player)) + rkt-web-player + rkt-web-player/player-agent)) @title{RKT Web Player} @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. 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. +}