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

playlists and DLNA playback

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-28 12:51:12 +02:00
parent 69433abee1
commit cd16e3ae42
12 changed files with 1028 additions and 415 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+2
View File
@@ -23,3 +23,5 @@ scrbl/*.css
rkt-web-player.ini rkt-web-player.ini
# Runtime playlist keystore
data/*.keystore*
ARCHITECTURE.md
+57 -32
View File
@@ -39,11 +39,13 @@ flowchart TB
Server[private/server.rkt<br/>HTTP adapter] Server[private/server.rkt<br/>HTTP adapter]
Users[private/users.rkt<br/>users, networks and sessions] Users[private/users.rkt<br/>users, networks and sessions]
Player[private/player.rkt<br/>application state and commands] Player[private/player.rkt<br/>application state and commands]
Playlists[private/playlists.rkt<br/>durable playlist tabs]
DLNAAdapter[private/dlna-playback.rkt<br/>playlist transition orchestration]
Library[private/library.rkt<br/>filesystem and metadata] Library[private/library.rkt<br/>filesystem and metadata]
UI[public/index.html + styles.css + app.js<br/>browser UI] UI[public/index.html + styles.css + app.js<br/>browser UI]
Audio[racket-audio<br/>local backend] Audio[racket-audio<br/>local backend]
Discovery[racket-upnp + racket-sonos<br/>device discovery] Discovery[racket-upnp + racket-sonos<br/>device discovery]
DLNA[racket-audio-dlna<br/>network backend and media server] DLNA[racket-audio-dlna<br/>transport, seeking and media publication]
AgentGUI[private/player-agent-gui.rkt<br/>GUI adapter] AgentGUI[private/player-agent-gui.rkt<br/>GUI adapter]
AgentCLI[player-agent-cli.rkt<br/>CLI adapter] AgentCLI[player-agent-cli.rkt<br/>CLI adapter]
AgentCore[private/player-agent-core.rkt<br/>polling and audio runtime] AgentCore[private/player-agent-core.rkt<br/>polling and audio runtime]
@@ -55,9 +57,11 @@ flowchart TB
Server --> Users Server --> Users
Server --> UI Server --> UI
Player --> Library Player --> Library
Player --> Playlists
Player --> Audio Player --> Audio
Player --> Discovery Player --> Discovery
Player --> DLNA Player --> DLNAAdapter
DLNAAdapter --> DLNA
AgentGUI --> AgentCore AgentGUI --> AgentCore
AgentCLI --> AgentCore AgentCLI --> AgentCore
AgentCore --> Server AgentCore --> Server
@@ -115,7 +119,7 @@ relative paths originated from directory listings below a configured root.
The mutable `player` structure is the aggregate root for: The mutable `player` structure is the aggregate root for:
- configured libraries and the current browser location; - configured libraries and the current browser location;
- in-memory playlist tabs and the selected tab's tracks; - playlist tabs, the selected tab, and their durably stored tracks;
- discovered renderers and the selected renderer; - discovered renderers and the selected renderer;
- registered HTTP playback agents and their pending command queues; - registered HTTP playback agents and their pending command queues;
- the lazily created local or network backend; - the lazily created local or network backend;
@@ -130,9 +134,12 @@ required, and returns a complete JSON-compatible state snapshot. Commands cover
library navigation, playlist/tab editing, output selection, transport, seeking, library navigation, playlist/tab editing, output selection, transport, seeking,
volume, and repeat mode. volume, and repeat mode.
Playlist tabs exist only in memory. Selecting, deleting, or creating a tab Selecting, deleting, or creating a tab stops playback. Tracks are de-duplicated
stops playback. Tracks are de-duplicated by normalized source path when they are by normalized source path when they are appended. Every playlist mutation is
appended. written in one `keystore` transaction. `playlists-for-<username>` contains the
ordered playlist GUIDs; each GUID key contains that playlist's name and tracks.
Loading validates every stored track independently against all configured
library roots, so one playlist can safely combine multiple libraries.
### 3.4 Playback backends ### 3.4 Playback backends
@@ -145,15 +152,21 @@ 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 0-100 volume is squared before being sent to the local audio library to provide
a more useful perceived volume curve. a more useful perceived volume curve.
Network outputs use `racket-audio-dlna`. The backend controls the chosen media Network outputs use the small `private/dlna-playback.rkt` adapter. It owns only
renderer and publishes local files over HTTP on the configured DLNA port and the playlist transition state machine; all transport commands, seeking, HTTP
path. After starting a track, the server publishes the following track and sets publication, UPnP calls and cached renderer information are delegated to
it as the renderer's `NextAVTransportURI`. Network playback information is `racket-audio-dlna`. After starting a track, the adapter asks that package to
refreshed whenever a state snapshot is requested. A changed current URI publish the following track and set it as the renderer's
promotes the prepared playlist index and immediately prepares its successor. `NextAVTransportURI`.
If a renderer does not perform the prepared transition, a confirmed natural
stop advances through a server-driven fallback. Explicit stops and failed play The adapter polls the package's cached renderer information independently of
requests are tracked separately and never trigger that fallback. browser requests. A changed current URI promotes the prepared playlist index
and immediately prepares its successor. If a renderer does not perform the
prepared transition, a confirmed natural stop advances through a
server-driven fallback. Explicit stops and failed play requests are tracked
separately and never trigger that fallback. A seek uses
`dlna-player-seek-percentage!` directly; its synchronously updated cached
position is pushed to the application state immediately.
Changing the selected renderer closes the existing backend and resets playback Changing the selected renderer closes the existing backend and resets playback
state. The replacement backend remains lazy and is created only when it is state. The replacement backend remains lazy and is created only when it is
@@ -269,16 +282,24 @@ sequenceDiagram
participant B as Browser participant B as Browser
participant H as HTTP server participant H as HTTP server
participant P as Player participant P as Player
participant A as DLNA playback adapter
participant L as racket-audio-dlna
participant D as DLNA renderer participant D as DLNA renderer
loop Every second loop Browser state polling
B->>H: GET /api/state B->>H: GET /api/state
H->>P: player-state->jsexpr H->>P: player-state->jsexpr
P->>D: Query transport, position, track and volume
D-->>P: Current renderer information
P-->>H: Full state snapshot P-->>H: Full state snapshot
H-->>B: JSON response H-->>B: JSON response
end end
loop DLNA adapter polling
L->>D: Poll transport and position
D-->>L: Current renderer information
A->>L: Read cached state
L-->>A: DLNA info
A-->>P: Update track, transport and time state
end
``` ```
## 5. Concurrency and consistency ## 5. Concurrency and consistency
@@ -311,15 +332,16 @@ file:
- DLNA media publication port, defaulting to `8734`; - DLNA media publication port, defaulting to `8734`;
- named library root paths under `[libraries]` (the legacy semicolon-separated - named library root paths under `[libraries]` (the legacy semicolon-separated
setting remains supported); setting remains supported);
- allowed 256-bit playback-agent IDs under `[playback-agents]`. - allowed 256-bit playback-agent IDs under `[playback-agents]`;
- the optional playlist-keystore override under `[player]`;
- Argon2id user hashes, local networks, trusted proxies, and session timeout. - Argon2id user hashes, local networks, trusted proxies, and session timeout.
Command-line network settings override INI values. Library paths from both Command-line network settings override INI values. Library paths from both
sources are combined and de-duplicated. sources are combined and de-duplicated.
There is no database, migration process, user account, or persistent playlist Playlist tabs use the SQLite-backed `keystore` module at
store. Restarting the process resets playlists, output discovery, transport `data/playlists.keystore`. Output discovery, transport state, playback position
state, and all other mutable state. and sessions still reset when the process restarts.
## 7. Security and operational boundaries ## 7. Security and operational boundaries
@@ -353,10 +375,13 @@ subsequent polling requests.
## 8. Testing and extension points ## 8. Testing and extension points
Unit tests embedded in `private/library.rkt` cover root creation, filtering, and Unit tests embedded in `private/library.rkt` cover root creation, filtering, and
directory ordering. Tests in `private/player.rkt` cover initial state, browser directory ordering. `private/playlists.rkt` tests transactional round trips,
navigation, repeat mode, playlist-tab operations, unknown commands, and clean per-user GUID indexes, multiple libraries, deletion and library-boundary
shutdown. The current suite does not exercise real audio devices, network validation. Tests in `private/player.rkt`
discovery, DLNA renderers, HTTP routing, or browser behavior. cover initial state, browser navigation, repeat mode, persistent 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: The main extension points are:
@@ -365,15 +390,14 @@ The main extension points are:
dispatch, and state refresh in `private/player.rkt`; dispatch, and state refresh in `private/player.rkt`;
- add an API operation by defining its player command first and exposing it - add an API operation by defining its player command first and exposing it
through the generic command endpoint; 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 - replace polling with server-pushed updates while keeping the current state
snapshot as the synchronization model. snapshot as the synchronization model.
## 9. Architectural constraints and trade-offs ## 9. Architectural constraints and trade-offs
- **Single shared state:** simple coordination and UI synchronization, but no - **Per-user playlists, shared transport:** playlist collections are isolated
multi-user isolation or horizontal scaling. by username, while the renderer and transport remain shared. A playlist
command from another user explicitly takes over that shared player.
- **Full-state snapshots:** a small and predictable client protocol, at the cost - **Full-state snapshots:** a small and predictable client protocol, at the cost
of repeatedly transferring all tracks and browser entries. of repeatedly transferring all tracks and browser entries.
- **One-second polling:** robust and dependency-free, but introduces periodic - **One-second polling:** robust and dependency-free, but introduces periodic
@@ -381,8 +405,9 @@ The main extension points are:
- **Lazy filesystem and backend initialization:** fast startup and low idle - **Lazy filesystem and backend initialization:** fast startup and low idle
resource usage, while the first recursive selection or playback command can resource usage, while the first recursive selection or playback command can
be comparatively slow. be comparatively slow.
- **In-memory playlists:** minimal operational complexity, but no recovery after - **Keystore playlists:** transactional recovery after restart without a custom
restart. database layer, with the SQLite-backed keystore remaining a single-node
resource.
- **Explicit backend branching:** easy to follow for the current small set of - **Explicit backend branching:** easy to follow for the current small set of
outputs, but adding renderer types touches several player functions rather outputs, but adding renderer types touches several player functions rather
than one formal backend interface. than one formal backend interface.
README.md
+14 -3
View File
@@ -52,7 +52,10 @@ hans=$argon2id$v=19$m=19456,t=2,p=1$...
Start dat bestand met `racket main.rkt --config rkt-web-player.ini`. Iedere key Start dat bestand met `racket main.rkt --config rkt-web-player.ini`. Iedere key
onder `[libraries]` is de zichtbare bibliotheeknaam; de waarde is de lokale of onder `[libraries]` is de zichtbare bibliotheeknaam; de waarde is de lokale of
UNC-rootmap. Het oudere `[library] paths=D:\Muziek;D:\Podcasts` blijft eveneens UNC-rootmap. Het oudere `[library] paths=D:\Muziek;D:\Podcasts` blijft eveneens
ondersteund. ondersteund. Playlisttabs worden standaard opgeslagen in de keystore
`data/playlists.keystore` binnen de geïnstalleerde map van rkt-web-player. Met
`playlist-keystore=...` onder `[player]` kan desgewenst een ander pad worden
gebruikt.
Zodra `[users]` minstens één gebruiker bevat, toont de webinterface voor Zodra `[users]` minstens één gebruiker bevat, toont de webinterface voor
niet-lokale clients een eigen loginvenster. Wachtwoorden staan uitsluitend als niet-lokale clients een eigen loginvenster. Wachtwoorden staan uitsluitend als
@@ -98,8 +101,16 @@ track.
Playlisttabs kunnen worden toegevoegd, geselecteerd, hernoemd door dubbel te Playlisttabs kunnen worden toegevoegd, geselecteerd, hernoemd door dubbel te
klikken en verwijderd. Tracks kunnen worden afgespeeld, verwijderd en met klikken en verwijderd. Tracks kunnen worden afgespeeld, verwijderd en met
drag-and-drop verplaatst. De tabs zijn in deze versie alleen in het geheugen drag-and-drop verplaatst. Tabnamen, tabvolgorde en alle tracklijsten worden na
aanwezig en worden niet na een herstart hersteld. iedere wijziging transactioneel opgeslagen. Een verwijderde
tab verdwijnt daarbij ook uit de keystore. Voor iedere gebruiker bevat de key
`playlists-for-<username>` de geordende lijst met playlist-GUIDs. Onder iedere
GUID-key staan de naam en tracks van die playlist. Tracks uit verschillende
geconfigureerde libraries mogen in dezelfde playlist staan; ontbrekende of
buiten de libraries gelegen bestanden worden bij het laden overgeslagen.
`local`, `anonymous` en iedere aangemelde gebruiker hebben daarbij een eigen
playlistverzameling. Het fysieke afspeelpunt en de transportbediening blijven
gedeeld; een playlistcommando van een andere gebruiker neemt die speler over.
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`. Configureer gebruikersauthenticatie voordat de LAN-adres aan `--listen-ip`. Configureer gebruikersauthenticatie voordat de
data/.gitkeep
+1
View File
@@ -0,0 +1 @@
info.rkt
+3 -1
View File
@@ -10,6 +10,7 @@
'("base" '("base"
"crypto-lib" "crypto-lib"
"gui-lib" "gui-lib"
"keystore"
"net-lib" "net-lib"
"web-server-lib" "web-server-lib"
"racket-audio" "racket-audio"
@@ -18,7 +19,8 @@
"racket-sonos" "racket-sonos"
"racket-upnp" "racket-upnp"
"simple-ini" "simple-ini"
"simple-log")) "simple-log"
"uuid"))
(define build-deps (define build-deps
'("racket-doc" '("racket-doc"
main.rkt
+20
View File
@@ -4,6 +4,7 @@
racket/contract racket/contract
racket/list racket/list
racket/mpair racket/mpair
racket/runtime-path
racket/string racket/string
simple-ini simple-ini
simple-log simple-log
@@ -20,6 +21,9 @@
(or/c path-string? (or/c path-string?
(list/c string? path-string?))) (list/c string? path-string?)))
(define-runtime-path default-playlist-keystore
"data/playlists.keystore")
(define (ini-section-key-values config section-name) (define (ini-section-key-values config section-name)
(let ((section (assoc section-name (mcdr config)))) (let ((section (assoc section-name (mcdr config))))
(if section (if section
@@ -62,6 +66,8 @@
#:listen-ip [listen-ip "127.0.0.1"] #:listen-ip [listen-ip "127.0.0.1"]
#:port [port 8080] #:port [port 8080]
#:dlna-port [dlna-port 8734] #:dlna-port [dlna-port 8734]
#:playlist-keystore
[playlist-keystore default-playlist-keystore]
#:launch-browser? [launch-browser? #t]) #:launch-browser? [launch-browser? #t])
(->* ((listof library-spec/c)) (->* ((listof library-spec/c))
(#:allowed-agent-ids (listof string?) (#:allowed-agent-ids (listof string?)
@@ -72,11 +78,13 @@
#:listen-ip string? #:listen-ip string?
#:port exact-positive-integer? #:port exact-positive-integer?
#:dlna-port exact-positive-integer? #:dlna-port exact-positive-integer?
#:playlist-keystore (or/c path-string? #f)
#:launch-browser? boolean?) #:launch-browser? boolean?)
any) any)
(let* ((libraries (make-music-libraries music-paths)) (let* ((libraries (make-music-libraries music-paths))
(player (make-player libraries (player (make-player libraries
#:allowed-agent-ids allowed-agent-ids #:allowed-agent-ids allowed-agent-ids
#:playlist-keystore playlist-keystore
#:dlna-port dlna-port)) #:dlna-port dlna-port))
(auth-manager (auth-manager
(make-auth-manager users (make-auth-manager users
@@ -107,6 +115,7 @@
(define listen-ip #f) (define listen-ip #f)
(define port #f) (define port #f)
(define dlna-port #f) (define dlna-port #f)
(define playlist-keystore #f)
(define launch-browser? #t) (define launch-browser? #t)
(define config-file #f) (define config-file #f)
@@ -123,6 +132,9 @@
[("--dlna-port") value [("--dlna-port") value
"Port used to publish local audio to DLNA renderers" "Port used to publish local audio to DLNA renderers"
(set! dlna-port (string->number value))] (set! dlna-port (string->number value))]
[("--playlist-keystore") path
"Keystore used to persist per-user playlist tabs"
(set! playlist-keystore path)]
[("--config") path [("--config") path
"Read defaults from an INI file" "Read defaults from an INI file"
(set! config-file path)] (set! config-file path)]
@@ -200,4 +212,12 @@
(ini-get config 'server 'port 8080)) (ini-get config 'server 'port 8080))
#:dlna-port (or dlna-port #:dlna-port (or dlna-port
(ini-get config 'player 'dlna-port 8734)) (ini-get config 'player 'dlna-port 8734))
#:playlist-keystore
(or playlist-keystore
(let ((configured
(ini-get config 'player 'playlist-keystore #f)))
(and (path-string? configured)
(not (string=? (string-trim (format "~a" configured)) ""))
configured))
default-playlist-keystore)
#:launch-browser? launch-browser?)) #:launch-browser? launch-browser?))
private/dlna-playback.rkt
+425
View File
@@ -0,0 +1,425 @@
#lang racket/base
(require racket-audio-dlna
racket/list
racket/path
racket/string
simple-log
"library.rkt")
(provide make-dlna-playback
dlna-playback-play-index!
dlna-playback-pause!
dlna-playback-resume!
dlna-playback-stop!
dlna-playback-seek-percentage!
dlna-playback-volume!
dlna-playback-repeat!
dlna-playback-close!)
(sl-def-log web-player-dlna)
;; This module deliberately contains only playlist orchestration. Transport,
;; HTTP publication, metadata, polling and seeking remain the responsibility
;; of racket-audio-dlna.
(struct dlna-playback
(player
tracks
update
error
[repeat #:mutable]
[current-index #:mutable]
[current-uri #:mutable]
[prepared-index #:mutable]
[playing-seen? #:mutable]
[progress-seen? #:mutable]
[failure-active? #:mutable]
[stop-requested? #:mutable]
[stopped-polls #:mutable]
[play-request-ms #:mutable]
[reachable? #:mutable]
[running? #:mutable]
[monitor #:mutable]
lock)
#:transparent)
(define playback-start-timeout-ms 8000)
(define (now-ms)
(current-inexact-milliseconds))
(define (normalize-state state)
(cond
((eq? state 'transitioning) 'starting)
((member state '(initialized no-media)) 'stopped)
(else state)))
;; Position reporting is optional and notably unreliable on some Denon
;; renderers. PLAYING, TRANSITIONING or PAUSED is itself confirmation that the
;; renderer accepted the transport. A positive position remains useful for
;; devices whose transport state lags behind their position response.
(define (renderer-confirms-playback? state position)
(or (and (member state '(playing starting paused)) #t)
(and (number? position) (> position 0))))
(define (with-lock playback proc)
(call-with-semaphore (dlna-playback-lock playback) proc))
(define (current-tracks playback)
((dlna-playback-tracks playback)))
(define (valid-index? playback index)
(and (exact-nonnegative-integer? index)
(< index (length (current-tracks playback)))))
(define (track-at playback index)
(and (valid-index? playback index)
(list-ref (current-tracks playback) index)))
(define (normalized-file file)
(with-handlers ((exn:fail? (lambda (_) (format "~a" file))))
(path->string (path->complete-path file))))
(define (same-file? first second)
(and first
second
((if (eq? (system-type 'os) 'windows)
string-ci=?
string=?)
(normalized-file first)
(normalized-file second))))
(define (next-index playback index)
(define count (length (current-tracks playback)))
(cond
((zero? count) #f)
((eq? (dlna-playback-repeat playback) 'one) index)
((< (+ index 1) count) (+ index 1))
((eq? (dlna-playback-repeat playback) 'all) 0)
(else #f)))
(define (track-index-for-info playback info)
(define info-track (dlna-info-track info))
(define file (and info-track (dlna-track-info-file info-track)))
(define prepared (dlna-playback-prepared-index playback))
(cond
((and (valid-index? playback prepared)
(same-file? file (track-file (track-at playback prepared))))
prepared)
(else
(for/first ((item (in-list (current-tracks playback)))
(index (in-naturals))
#:when (same-file? file (track-file item)))
index))))
(define (notify! playback state info)
((dlna-playback-update playback)
state
(dlna-playback-current-index playback)
info))
(define (report-failure! playback detail)
(set-dlna-playback-playing-seen?! playback #f)
(set-dlna-playback-progress-seen?! playback #f)
(set-dlna-playback-failure-active?! playback #t)
(set-dlna-playback-play-request-ms! playback #f)
(set-dlna-playback-stopped-polls! playback 0)
((dlna-playback-error playback) detail))
(define (prepare-next! playback)
(define current (dlna-playback-current-index playback))
(when (valid-index? playback current)
(define following (next-index playback current))
(cond
((not following)
(set-dlna-playback-prepared-index! playback #f))
((not (equal? following (dlna-playback-prepared-index playback)))
(with-handlers
((exn:fail?
(lambda (exception)
(set-dlna-playback-prepared-index! playback #f)
(warn-web-player-dlna
"Could not prepare next DLNA track: ~a"
(exn-message exception)))))
(dlna-player-set-next-file!
(dlna-playback-player playback)
(track-file (track-at playback following)))
(set-dlna-playback-prepared-index! playback following))))))
(define (play-index/locked! playback index)
(define item (track-at playback index))
(unless item
(raise-arguments-error
'dlna-playback-play-index!
"track index is outside the playlist"
"index" index))
(with-handlers
((exn:fail?
(lambda (exception)
(report-failure! playback (exn-message exception))
(raise exception))))
(dlna-player-play! (dlna-playback-player playback) (track-file item))
(define info (dlna-player-info (dlna-playback-player playback)))
(set-dlna-playback-current-index! playback index)
(set-dlna-playback-current-uri! playback (dlna-info-uri info))
(set-dlna-playback-prepared-index! playback #f)
(set-dlna-playback-playing-seen?! playback #t)
(set-dlna-playback-progress-seen?! playback #f)
(set-dlna-playback-failure-active?! playback #f)
(set-dlna-playback-play-request-ms! playback (now-ms))
(set-dlna-playback-stop-requested?! playback #f)
(set-dlna-playback-stopped-polls! playback 0)
(notify! playback 'starting info)
(prepare-next! playback)))
(define (update-current-track! playback info)
(define index (track-index-for-info playback info))
(when (valid-index? playback index)
(unless (equal? index (dlna-playback-current-index playback))
(set-dlna-playback-progress-seen?! playback #f)
(set-dlna-playback-play-request-ms! playback (now-ms)))
(set-dlna-playback-current-index! playback index)
(set-dlna-playback-prepared-index! playback #f)
(prepare-next! playback)))
(define (advance! playback)
(define current (dlna-playback-current-index playback))
(define following (and (valid-index? playback current)
(next-index playback current)))
(if following
(play-index/locked! playback following)
(begin
(dlna-player-stop! (dlna-playback-player playback))
(notify! playback
'stopped
(dlna-player-info (dlna-playback-player playback))))))
(define (poll/locked! playback)
(define info (dlna-player-info (dlna-playback-player playback)))
(cond
((not (dlna-info-reachable? info))
(when (dlna-playback-reachable? playback)
(set-dlna-playback-reachable?! playback #f)
((dlna-playback-error playback) "De DLNA-renderer is niet bereikbaar")))
(else
(set-dlna-playback-reachable?! playback #t)
(define state (normalize-state (dlna-info-state info)))
(define uri (dlna-info-uri info))
(define position (dlna-info-position info))
(define failed-now? #f)
(when (and (string? uri)
(not (string=? uri ""))
(not (equal? uri (dlna-playback-current-uri playback))))
(set-dlna-playback-current-uri! playback uri)
(set-dlna-playback-stopped-polls! playback 0)
(update-current-track! playback info))
(when (renderer-confirms-playback? state position)
(set-dlna-playback-progress-seen?! playback #t))
(when (and (dlna-playback-playing-seen? playback)
(not (dlna-playback-progress-seen? playback))
(dlna-playback-play-request-ms playback)
(>= (- (now-ms)
(dlna-playback-play-request-ms playback))
playback-start-timeout-ms))
(set! failed-now? #t)
(warn-web-player-dlna
"DLNA start was not confirmed: state=~a position=~a uri=~a"
state position (or uri ""))
(report-failure!
playback
"De DLNA-renderer bevestigde de start van de track niet"))
(unless (or failed-now? (dlna-playback-failure-active? playback))
(cond
((eq? state 'playing)
(set-dlna-playback-playing-seen?! playback #t)
(set-dlna-playback-stopped-polls! playback 0))
((and (eq? state 'stopped)
(dlna-playback-stop-requested? playback))
(set-dlna-playback-stop-requested?! playback #f)
(set-dlna-playback-stopped-polls! playback 0))
((and (eq? state 'stopped)
(dlna-playback-playing-seen? playback))
(cond
((and (not (dlna-playback-progress-seen? playback))
(dlna-playback-play-request-ms playback)
(< (- (now-ms)
(dlna-playback-play-request-ms playback))
5000))
(void))
((not (dlna-playback-progress-seen? playback))
(warn-web-player-dlna
"DLNA renderer stopped without confirming playback: position=~a uri=~a"
position (or uri ""))
(report-failure!
playback
"De DLNA-renderer bevestigde de start van de track niet"))
(else
(set-dlna-playback-stopped-polls!
playback
(+ 1 (dlna-playback-stopped-polls playback)))
;; Give SetNextAVTransportURI one poll to take over. Some
;; renderers need the explicit fallback on the following poll.
(when (or (not (dlna-playback-prepared-index playback))
(> (dlna-playback-stopped-polls playback) 1))
(set-dlna-playback-playing-seen?! playback #f)
(set-dlna-playback-stopped-polls! playback 0)
(advance! playback)))))))
(notify!
playback
(cond
((or failed-now? (dlna-playback-failure-active? playback)) 'stopped)
((and (dlna-playback-playing-seen? playback)
(not (dlna-playback-progress-seen? playback)))
'starting)
(else state))
info))))
(define (monitor-loop playback poll-seconds)
(let loop ()
(when (dlna-playback-running? playback)
(sleep poll-seconds)
(when (dlna-playback-running? playback)
(with-handlers
((exn:fail?
(lambda (exception)
(warn-web-player-dlna
"Could not update DLNA playback state: ~a"
(exn-message exception)))))
(with-lock playback (lambda () (poll/locked! playback))))
(loop)))))
(define (make-dlna-playback device
tracks
update
error
#:port [port 8734]
#:poll-seconds [poll-seconds 1])
(define raw
(make-dlna-player device
#:port port
#:path "/rkt-web-player/"))
(define playback
(dlna-playback raw tracks update error 'off #f #f #f
#f #f #f #f 0 #f #t #t #f
(make-semaphore 1)))
(set-dlna-playback-monitor!
playback
(thread (lambda () (monitor-loop playback poll-seconds))))
playback)
(define (dlna-playback-play-index! playback index)
(with-lock playback (lambda () (play-index/locked! playback index))))
(define (dlna-playback-pause! playback)
(with-lock
playback
(lambda ()
(dlna-player-pause! (dlna-playback-player playback))
(notify! playback 'paused (dlna-player-info (dlna-playback-player playback))))))
(define (dlna-playback-resume! playback)
(with-lock
playback
(lambda ()
(dlna-player-resume! (dlna-playback-player playback))
(notify! playback 'playing (dlna-player-info (dlna-playback-player playback))))))
(define (dlna-playback-stop! playback)
(with-lock
playback
(lambda ()
(set-dlna-playback-stop-requested?! playback #t)
(set-dlna-playback-playing-seen?! playback #f)
(set-dlna-playback-progress-seen?! playback #f)
(set-dlna-playback-failure-active?! playback #f)
(set-dlna-playback-play-request-ms! playback #f)
(set-dlna-playback-stopped-polls! playback 0)
(dlna-player-stop! (dlna-playback-player playback))
(notify! playback 'stopped (dlna-player-info (dlna-playback-player playback))))))
(define (dlna-playback-seek-percentage! playback percentage)
(with-lock
playback
(lambda ()
(dlna-player-seek-percentage! (dlna-playback-player playback) percentage)
;; racket-audio-dlna updates its cache synchronously after Seek. Publish
;; that value immediately so the web slider does not jump back.
(define info (dlna-player-info (dlna-playback-player playback)))
(notify! playback
(normalize-state (dlna-info-state info))
info))))
(define (dlna-playback-volume! playback percentage)
(with-lock
playback
(lambda ()
(dlna-player-volume! (dlna-playback-player playback) percentage)
(define info (dlna-player-info (dlna-playback-player playback)))
(notify! playback
(normalize-state (dlna-info-state info))
info))))
(define (dlna-playback-repeat! playback repeat)
(with-lock
playback
(lambda ()
(set-dlna-playback-repeat! playback repeat)
(set-dlna-playback-prepared-index! playback #f)
(prepare-next! playback))))
(define (dlna-playback-close! playback)
(when (dlna-playback-running? playback)
(set-dlna-playback-running?! playback #f)
(define monitor (dlna-playback-monitor playback))
(when (and monitor (not (thread-dead? monitor)))
(kill-thread monitor))
(set-dlna-playback-monitor! playback #f)
(with-lock
playback
(lambda ()
(dlna-player-close! (dlna-playback-player playback))))))
(module+ test
(require rackunit)
(define first
(track (build-path "music" "01.flac")
"First" "Artist" "Album" 60 "audio/flac"))
(define second
(track (build-path "music" "02.flac")
"Second" "Artist" "Album" 60 "audio/flac"))
(define playback
(dlna-playback #f (lambda () (list first second)) void void
'off 0 #f #f #f #f #f #f 0 #f #t #f #f
(make-semaphore 1)))
(check-equal? (next-index playback 0) 1)
(check-false (next-index playback 1))
(set-dlna-playback-repeat! playback 'all)
(check-equal? (next-index playback 1) 0)
(set-dlna-playback-repeat! playback 'one)
(check-equal? (next-index playback 1) 1)
(set-dlna-playback-prepared-index! playback 1)
(check-equal?
(track-index-for-info
playback
(dlna-info
'playing
(dlna-track-info (track-file second) "Second" "Artist" "Album"
#f #f #f 60 #f #f #f)
"http://renderer.test/02.flac"
#f #f 1 60 25 #f #t))
1)
(check-eq? (normalize-state 'transitioning) 'starting)
(check-eq? (normalize-state 'no-media) 'stopped)
(check-true (renderer-confirms-playback? 'playing #f))
(check-true (renderer-confirms-playback? 'starting 0))
(check-true (renderer-confirms-playback? 'paused #f))
(check-true (renderer-confirms-playback? 'unknown 1))
(check-false (renderer-confirms-playback? 'stopped 0)))
private/library.rkt
+20
View File
@@ -12,6 +12,7 @@
(struct-out track) (struct-out track)
(struct-out artwork) (struct-out artwork)
make-music-libraries make-music-libraries
library-contains-audio-file?
browse-library browse-library
browser-entry->tracks browser-entry->tracks
track-artwork) track-artwork)
@@ -133,6 +134,25 @@
(browser-entry-relative-path entry)))))) (browser-entry-relative-path entry))))))
(browse-library library relative-path))) (browse-library library relative-path)))
(define (library-contains-audio-file? libraries file)
(and (path-string? file)
(file-exists? file)
(audio-file? file)
(let ((full-file
(with-handlers ((exn:fail? (lambda (_) #f)))
(simplify-path (path->complete-path file) #t))))
(and full-file
(for/or ((library (in-list libraries)))
(define root
(with-handlers ((exn:fail? (lambda (_) #f)))
(simplify-path
(path->complete-path (music-library-root library))
#t)))
(and root
(let ((relative (find-relative-path root full-file)))
(and (relative-path? relative)
(not (member 'up (explode-path relative)))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided functions ;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
private/player.rkt
+240 -353
View File
@@ -10,7 +10,10 @@
racket-sonos racket-sonos
racket-upnp racket-upnp
simple-log simple-log
"library.rkt") uuid/random
"dlna-playback.rkt"
"library.rkt"
"playlists.rkt")
(provide make-player (provide make-player
player-state->jsexpr player-state->jsexpr
@@ -47,16 +50,8 @@
(id [name #:mutable] [tracks #:mutable]) (id [name #:mutable] [tracks #:mutable])
#:transparent) #:transparent)
(struct network-playback (struct playlist-context
([current-uri #:mutable] ([tabs #:mutable] [current-index #:mutable])
[prepared-uri #:mutable]
[prepared-index #:mutable]
[playing-seen? #:mutable]
[progress-seen? #:mutable]
[failure-active? #:mutable]
[stop-requested? #:mutable]
[stopped-polls #:mutable]
[play-request-ms #:mutable])
#:transparent) #:transparent)
(struct player (struct player
@@ -86,11 +81,12 @@
[error #:mutable] [error #:mutable]
[discovering? #:mutable] [discovering? #:mutable]
[closed? #:mutable] [closed? #:mutable]
[network-monitor #:mutable]
state-lock state-lock
command-lock command-lock
local-music-indexes local-music-indexes
network playlist-store
playlist-contexts
[active-playlist-user #:mutable]
dlna-port) dlna-port)
#:transparent) #:transparent)
@@ -237,6 +233,71 @@
(current-tab value) (current-tab value)
(player-tracks value))) (player-tracks value)))
(define (normal-playlist-username username)
(let ((value (and (string? username)
(string-downcase (string-trim username)))))
(if (and value (not (string=? value ""))) value "anonymous")))
(define (new-playlist-context value username)
(define stored
(load-user-playlists (player-playlist-store value)
username
(player-libraries value)))
(playlist-context
(if (pair? stored)
(for/list ((tab (in-list stored)))
(playlist-tab (persisted-tab-id tab)
(persisted-tab-name tab)
(persisted-tab-tracks tab)))
(list (playlist-tab (uuid-string) "Default" '())))
0))
(define (playlist-context-for! value username)
(define normalized (normal-playlist-username username))
(hash-ref!
(player-playlist-contexts value)
normalized
(lambda () (new-playlist-context value normalized))))
(define (activate-playlist-user! value username)
(define normalized (normal-playlist-username username))
(unless (string=? normalized (player-active-playlist-user value))
;; Playback uses the active playlist's track indexes. Stop before another
;; user's playlist command replaces that context.
(when (and (player-backend value)
(not (eq? (player-state value) 'stopped)))
(stop-playback! value))
(define context (playlist-context-for! value normalized))
(with-state-lock
value
(lambda ()
(set-player-tabs! value (playlist-context-tabs context))
(set-player-current-tab-index!
value
(playlist-context-current-index context))
(set-player-tracks!
value
(playlist-tab-tracks
(list-ref (playlist-context-tabs context)
(playlist-context-current-index context))))
(set-player-current-index! value #f)
(set-player-active-playlist-user! value normalized)))))
(define (persist-playlists! value)
(define username (player-active-playlist-user value))
(define context (playlist-context-for! value username))
(set-playlist-context-tabs! context (player-tabs value))
(set-playlist-context-current-index!
context
(player-current-tab-index value))
(save-user-playlists!
(player-playlist-store value)
username
(for/list ((tab (in-list (player-tabs value))))
(persisted-tab (playlist-tab-id tab)
(playlist-tab-name tab)
(playlist-tab-tracks tab)))))
(define (normalize-state state) (define (normalize-state state)
(cond (cond
((eq? state 'playing) 'playing) ((eq? state 'playing) 'playing)
@@ -261,94 +322,6 @@
(set-player-bits! value #f) (set-player-bits! value #f)
(set-player-decoder! value #f)) (set-player-decoder! value #f))
(define (now-ms)
(current-inexact-milliseconds))
(define (reset-network-playback! value)
(define network (player-network value))
(set-network-playback-current-uri! network #f)
(set-network-playback-prepared-uri! network #f)
(set-network-playback-prepared-index! network #f)
(set-network-playback-playing-seen?! network #f)
(set-network-playback-progress-seen?! network #f)
(set-network-playback-failure-active?! network #f)
(set-network-playback-stop-requested?! network #f)
(set-network-playback-stopped-polls! network 0)
(set-network-playback-play-request-ms! network #f))
(define (same-track-file? first second)
(and first
second
(with-handlers ((exn:fail? (lambda (_) #f)))
(equal? (normal-case-path first)
(normal-case-path second)))))
(define (network-info-track-index value info)
(define network (player-network value))
(define info-track (dlna-info-track info))
(define file (and info-track (dlna-track-info-file info-track)))
(define uri (dlna-info-uri info))
(define prepared-index (network-playback-prepared-index network))
(define prepared-uri (network-playback-prepared-uri network))
(cond
((and (valid-track-index? value prepared-index)
(or (same-track-file?
file
(track-file (list-ref (player-tracks value) prepared-index)))
(and (string? uri)
(string? prepared-uri)
(string=? uri prepared-uri))))
prepared-index)
(else
(for/first ((item (in-list (player-tracks value)))
(index (in-naturals))
#:when (same-track-file? file (track-file item)))
index))))
(define (prepare-next-network-track! value)
(define backend (player-backend value))
(define network (player-network value))
(when (and backend
(member (player-backend-kind value) '(upnp sonos))
(valid-track-index? value (player-current-index value)))
(define index (next-index value 1))
(cond
((not index)
(set-network-playback-prepared-index! network #f)
(set-network-playback-prepared-uri! network #f))
((not (equal? index (network-playback-prepared-index network)))
(with-handlers
((exn:fail?
(lambda (exception)
(set-network-playback-prepared-index! network #f)
(set-network-playback-prepared-uri! network #f)
(warn-web-player
"Could not prepare next DLNA track: ~a"
(exn-message exception)))))
(dlna-player-set-next-file!
backend
(track-file (list-ref (player-tracks value) index)))
(define prepared-info (dlna-player-info backend))
(set-network-playback-prepared-index! network index)
(set-network-playback-prepared-uri!
network
(dlna-info-next-uri prepared-info)))))))
;; Result used when a renderer reports stopped after a play request.
(define (network-stop-decision stop-requested?
playing-seen?
progress-seen?
elapsed-ms
prepared?
stopped-polls)
(cond
(stop-requested? 'requested-stop)
((not playing-seen?) 'none)
((and (not progress-seen?) (< elapsed-ms 5000)) 'wait-for-start)
((not progress-seen?) 'playback-failed)
((and prepared? (<= stopped-polls 1)) 'wait-for-next)
(else 'advance)))
(define (local-state-callback value handle state full-state) (define (local-state-callback value handle state full-state)
(with-state-lock (with-state-lock
value value
@@ -409,10 +382,38 @@
(* 100.0 logical-volume logical-volume))) (* 100.0 logical-volume logical-volume)))
backend)) backend))
(define (network-state-callback value state index info)
(define track-info (dlna-info-track info))
(with-state-lock
value
(lambda ()
(when (valid-track-index? value index)
(set-player-current-index! value index))
(set-player-state! value state)
(set-player-position! value (or (dlna-info-position info) 0))
(set-player-duration! value (dlna-info-duration info))
(set-player-rate!
value
(and track-info (dlna-track-info-sample-rate track-info)))
(set-player-channels!
value
(and track-info (dlna-track-info-channels track-info)))
(set-player-bits! value #f)
(set-player-decoder! value 'dlna)
(when (number? (dlna-info-volume info))
(set-player-volume! value (dlna-info-volume info))))))
(define (make-network-backend value device) (define (make-network-backend value device)
(make-dlna-player device (define backend
#:port (player-dlna-port value) (make-dlna-playback
#:path "/rkt-web-player/")) device
(lambda () (player-tracks value))
(lambda (state index info)
(network-state-callback value state index info))
(lambda (message) (set-error! value message))
#:port (player-dlna-port value)))
(dlna-playback-repeat! backend (player-repeat value))
backend)
(define (ensure-backend! value) (define (ensure-backend! value)
(if (player-backend value) (if (player-backend value)
@@ -461,11 +462,10 @@
((eq? kind 'agent) ((eq? kind 'agent)
(enqueue-agent-command! value backend "stop")) (enqueue-agent-command! value backend "stop"))
(else (else
(dlna-player-close! backend))))) (dlna-playback-close! backend)))))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
(reset-network-playback! value)
(set-player-backend! value #f) (set-player-backend! value #f)
(set-player-backend-kind! value #f) (set-player-backend-kind! value #f)
(set-player-state! value 'stopped) (set-player-state! value 'stopped)
@@ -483,16 +483,7 @@
(player-backend value) (player-backend value)
"stop")) "stop"))
(else (else
(with-state-lock (dlna-playback-stop! (player-backend value)))))
value
(λ ()
(define network (player-network value))
(set-network-playback-stop-requested?! network #t)
(set-network-playback-playing-seen?! network #f)
(set-network-playback-progress-seen?! network #f)
(set-network-playback-failure-active?! network #f)
(set-network-playback-stopped-polls! network 0)))
(dlna-player-stop! (player-backend value)))))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
@@ -559,24 +550,7 @@
(enqueue-agent-command! (enqueue-agent-command!
value backend "prefetch" following-data)))) value backend "prefetch" following-data))))
(else (else
(dlna-player-play! backend (track-file item)) (dlna-playback-play-index! backend index)))
(let ((info (dlna-player-info backend)))
(with-state-lock
value
(λ ()
(define network (player-network value))
(set-network-playback-current-uri!
network
(dlna-info-uri info))
(set-network-playback-prepared-uri! network #f)
(set-network-playback-prepared-index! network #f)
(set-network-playback-playing-seen?! network #t)
(set-network-playback-progress-seen?! network #f)
(set-network-playback-failure-active?! network #f)
(set-network-playback-stop-requested?! network #f)
(set-network-playback-stopped-polls! network 0)
(set-network-playback-play-request-ms! network (now-ms)))))
(prepare-next-network-track! value)))
(clear-error! value))) (clear-error! value)))
(define (next-index value direction) (define (next-index value direction)
@@ -628,140 +602,14 @@
(when volume (set-player-volume! value volume))) (when volume (set-player-volume! value volume)))
(set-player-error! value (json-string reported 'error #f)))))) (set-player-error! value (json-string reported 'error #f))))))
(define (refresh-dlna-state! value)
(define info (dlna-player-info (player-backend value)))
(define track-info (dlna-info-track info))
(define new-state (normalize-state (dlna-info-state info)))
(define position (or (dlna-info-position info) 0))
(define prepare-next? #f)
(define advance? #f)
(define playback-failed? #f)
(with-state-lock
value
(λ ()
(define network (player-network value))
(define uri (dlna-info-uri info))
(when (and (string? uri)
(not (string=? uri ""))
(not (equal? uri (network-playback-current-uri network))))
(set-network-playback-current-uri! network uri)
(set-network-playback-stopped-polls! network 0)
(let ((detected-index (network-info-track-index value info)))
(when (valid-track-index? value detected-index)
(unless (equal? detected-index (player-current-index value))
(set-network-playback-progress-seen?! network #f)
(set-network-playback-failure-active?! network #f)
(set-network-playback-play-request-ms! network (now-ms)))
(set-player-current-index! value detected-index)
(set-network-playback-prepared-index! network #f)
(set-network-playback-prepared-uri! network #f)
(set! prepare-next? #t))))
(when (and (not (network-playback-failure-active? network))
(member new-state '(playing starting paused)))
(when (eq? new-state 'playing)
(set-network-playback-playing-seen?! network #t)
(set-network-playback-stopped-polls! network 0))
(when (and (number? position) (> position 0))
(set-network-playback-progress-seen?! network #t)))
(let ((requested-at (network-playback-play-request-ms network)))
(when (and (network-playback-playing-seen? network)
(not (network-playback-progress-seen? network))
requested-at
(>= (- (now-ms) requested-at) 8000))
(set-network-playback-playing-seen?! network #f)
(set-network-playback-stopped-polls! network 0)
(set-network-playback-failure-active?! network #t)
(set-player-error! value "De DLNA-renderer kon de track niet starten")
(set! playback-failed? #t)))
(when (and (eq? new-state 'stopped)
(not playback-failed?)
(not (network-playback-failure-active? network)))
(when (and (network-playback-playing-seen? network)
(network-playback-progress-seen? network))
(set-network-playback-stopped-polls!
network
(+ 1 (network-playback-stopped-polls network))))
(let* ((requested-at (network-playback-play-request-ms network))
(decision
(network-stop-decision
(network-playback-stop-requested? network)
(network-playback-playing-seen? network)
(network-playback-progress-seen? network)
(if requested-at (- (now-ms) requested-at) 10000)
(exact-nonnegative-integer?
(network-playback-prepared-index network))
(network-playback-stopped-polls network))))
(case decision
((requested-stop)
(set-network-playback-stop-requested?! network #f)
(set-network-playback-stopped-polls! network 0))
((playback-failed)
(set-network-playback-playing-seen?! network #f)
(set-network-playback-stopped-polls! network 0)
(set-network-playback-failure-active?! network #t)
(set-player-error! value "De DLNA-renderer kon de track niet starten"))
((advance)
(set-network-playback-playing-seen?! network #f)
(set-network-playback-stopped-polls! network 0)
(set! advance? #t)))))
(set-player-state!
value
(cond
((or playback-failed?
(network-playback-failure-active? network))
'stopped)
((and (network-playback-playing-seen? network)
(not (network-playback-progress-seen? network)))
'starting)
(else new-state)))
(set-player-position! value position)
(set-player-duration! value (dlna-info-duration info))
(set-player-rate!
value
(and track-info (dlna-track-info-sample-rate track-info)))
(set-player-channels!
value
(and track-info (dlna-track-info-channels track-info)))
(set-player-bits! value #f)
(set-player-decoder! value 'dlna)
(when (number? (dlna-info-volume info))
(set-player-volume! value (dlna-info-volume info)))))
(when prepare-next?
(prepare-next-network-track! value))
(when advance?
(let ((index (next-index value 1)))
(if index
(play-index! value index)
(stop-playback! value)))))
(define (refresh-network-state! value) (define (refresh-network-state! value)
(call-with-semaphore
(player-command-lock value)
(λ ()
(when (and (player-backend value) (when (and (player-backend value)
(not (eq? (player-backend-kind value) 'local))) (eq? (player-backend-kind value) 'agent))
(with-handlers (with-handlers
((exn:fail? ((exn:fail?
(λ (exception) (λ (exception)
(set-error! value (exn-message exception))))) (set-error! value (exn-message exception)))))
(if (eq? (player-backend-kind value) 'agent) (refresh-agent-state! value))))
(refresh-agent-state! value)
(refresh-dlna-state! value)))))))
(define (start-network-monitor! value)
(set-player-network-monitor!
value
(thread
(λ ()
(let loop ()
(sleep 1)
(unless (player-closed? value)
(refresh-network-state! value)
(loop)))))))
(define (entry-by-index value index) (define (entry-by-index value index)
(and (exact-nonnegative-integer? index) (and (exact-nonnegative-integer? index)
@@ -812,7 +660,8 @@
value value
(λ () (λ ()
(set-player-tracks! value combined) (set-player-tracks! value combined)
(save-current-tab! value))))) (save-current-tab! value)
(persist-playlists! value)))))
(define (replace-tracks! value tracks) (define (replace-tracks! value tracks)
(stop-playback! value) (stop-playback! value)
@@ -821,7 +670,8 @@
(λ () (λ ()
(set-player-tracks! value tracks) (set-player-tracks! value tracks)
(set-player-current-index! value #f) (set-player-current-index! value #f)
(save-current-tab! value)))) (save-current-tab! value)
(persist-playlists! value))))
(define (drop-track! value index) (define (drop-track! value index)
(unless (valid-track-index? value index) (unless (valid-track-index? value index)
@@ -846,7 +696,8 @@
(set-player-current-index! (set-player-current-index!
value value
(- (player-current-index value) 1)))) (- (player-current-index value) 1))))
(save-current-tab! value)))) (save-current-tab! value)
(persist-playlists! value))))
(define (move-track! value from-index to-index) (define (move-track! value from-index to-index)
(unless (and (valid-track-index? value from-index) (unless (and (valid-track-index? value from-index)
@@ -881,7 +732,8 @@
((and (<= to-index current) ((and (<= to-index current)
(< current from-index)) (< current from-index))
(set-player-current-index! value (+ current 1))))) (set-player-current-index! value (+ current 1)))))
(save-current-tab! value)))))) (save-current-tab! value)
(persist-playlists! value))))))
(define (select-tab! value index) (define (select-tab! value index)
(unless (and (exact-nonnegative-integer? index) (unless (and (exact-nonnegative-integer? index)
@@ -900,7 +752,8 @@
(set-player-tracks! (set-player-tracks!
value value
(playlist-tab-tracks (current-tab value))) (playlist-tab-tracks (current-tab value)))
(set-player-current-index! value #f))))) (set-player-current-index! value #f)
(persist-playlists! value)))))
(define (add-tab! value) (define (add-tab! value)
(with-state-lock (with-state-lock
@@ -911,15 +764,14 @@
(number (+ (length tabs) 1)) (number (+ (length tabs) 1))
(tab (tab
(playlist-tab (playlist-tab
(format "tab-~a-~a" (uuid-string)
(current-milliseconds)
(random 10000))
(format "Playlist ~a" number) (format "Playlist ~a" number)
'()))) '())))
(set-player-tabs! value (append tabs (list tab))) (set-player-tabs! value (append tabs (list tab)))
(set-player-current-tab-index! value (length tabs)) (set-player-current-tab-index! value (length tabs))
(set-player-tracks! value '()) (set-player-tracks! value '())
(set-player-current-index! value #f))))) (set-player-current-index! value #f)
(persist-playlists! value)))))
(define (rename-tab! value index name) (define (rename-tab! value index name)
(unless (and (exact-nonnegative-integer? index) (unless (and (exact-nonnegative-integer? index)
@@ -938,7 +790,8 @@
(λ () (λ ()
(set-playlist-tab-name! (set-playlist-tab-name!
(list-ref (player-tabs value) index) (list-ref (player-tabs value) index)
trimmed))))) trimmed)
(persist-playlists! value)))))
(define (delete-tab! value index) (define (delete-tab! value index)
(when (= (length (player-tabs value)) 1) (when (= (length (player-tabs value)) 1)
@@ -967,7 +820,8 @@
(set-player-tracks! (set-player-tracks!
value value
(playlist-tab-tracks (list-ref tabs new-index))) (playlist-tab-tracks (list-ref tabs new-index)))
(set-player-current-index! value #f))))) (set-player-current-index! value #f)
(persist-playlists! value)))))
(define (track->jsexpr item index) (define (track->jsexpr item index)
(hasheq 'index index (hasheq 'index index
@@ -1153,7 +1007,7 @@
((eq? (player-backend-kind value) 'agent) ((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command! value backend "pause")) (enqueue-agent-command! value backend "pause"))
(else (else
(dlna-player-pause! backend))))) (dlna-playback-pause! backend)))))
((string=? command "resume") ((string=? command "resume")
(let ((backend (ensure-backend! value))) (let ((backend (ensure-backend! value)))
(cond (cond
@@ -1162,7 +1016,7 @@
((eq? (player-backend-kind value) 'agent) ((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command! value backend "resume")) (enqueue-agent-command! value backend "resume"))
(else (else
(dlna-player-resume! backend))))) (dlna-playback-resume! backend)))))
((string=? command "stop") ((string=? command "stop")
(stop-playback! value)) (stop-playback! value))
((string=? command "next") ((string=? command "next")
@@ -1189,7 +1043,7 @@
value backend "seek" value backend "seek"
(hasheq 'percentage percentage))) (hasheq 'percentage percentage)))
(else (else
(dlna-player-seek-percentage! backend percentage)))))) (dlna-playback-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
@@ -1209,7 +1063,7 @@
value backend "volume" value backend "volume"
(hasheq 'value clamped))) (hasheq 'value clamped)))
(else (else
(dlna-player-volume! backend clamped))) (dlna-playback-volume! backend clamped)))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
@@ -1227,10 +1081,7 @@
(λ () (λ ()
(set-player-repeat! value mode))) (set-player-repeat! value mode)))
(when (member (player-backend-kind value) '(upnp sonos)) (when (member (player-backend-kind value) '(upnp sonos))
;; Replace the renderer's prepared URI when repeat mode changes. (dlna-playback-repeat! (player-backend value) mode))))
(set-network-playback-prepared-index! (player-network value) #f)
(set-network-playback-prepared-uri! (player-network value) #f)
(prepare-next-network-track! value))))
((string=? command "renderer") ((string=? command "renderer")
(let* ((id (json-string data 'id #f)) (let* ((id (json-string data 'id #f))
(selected (and id (renderer-by-id value id)))) (selected (and id (renderer-by-id value id))))
@@ -1263,6 +1114,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-player libraries (define (make-player libraries
#:allowed-agent-ids [allowed-agent-ids '()] #:allowed-agent-ids [allowed-agent-ids '()]
#:playlist-keystore [playlist-keystore #f]
#:dlna-port [dlna-port 8734]) #:dlna-port [dlna-port 8734])
(define normalized-agent-ids (define normalized-agent-ids
(for/list ((app-id (in-list allowed-agent-ids))) (for/list ((app-id (in-list allowed-agent-ids)))
@@ -1272,12 +1124,25 @@
"64-character hexadecimal playback agent id" "64-character hexadecimal playback agent id"
app-id)) app-id))
(string-downcase app-id))) (string-downcase app-id)))
(define store (open-playlist-store playlist-keystore))
(define stored-tabs
(load-user-playlists store "local" libraries))
(let* ((library (and (pair? libraries) (car libraries))) (let* ((library (and (pair? libraries) (car libraries)))
(browser-entries (browser-entries
(if library (if library
(browse-library library '()) (browse-library library '())
'())) '()))
(tab (playlist-tab "default" "Default" '()))) (tabs
(if (pair? stored-tabs)
(for/list ((tab (in-list stored-tabs)))
(playlist-tab (persisted-tab-id tab)
(persisted-tab-name tab)
(persisted-tab-tracks tab)))
(list (playlist-tab (uuid-string) "Default" '()))))
(selected-index 0)
(contexts (make-hash))
(initial-context (playlist-context tabs selected-index)))
(hash-set! contexts "local" initial-context)
(define value (define value
(player libraries (player libraries
(remove-duplicates normalized-agent-ids string=?) (remove-duplicates normalized-agent-ids string=?)
@@ -1285,9 +1150,9 @@
(and library (music-library-id library)) (and library (music-library-id library))
'() '()
browser-entries browser-entries
'() (playlist-tab-tracks (list-ref tabs selected-index))
(list tab) tabs
0 selected-index
(list (renderer "local" "Server audio output" 'local #f)) (list (renderer "local" "Server audio output" 'local #f))
"local" "local"
#f #f
@@ -1305,13 +1170,13 @@
#f #f
#f #f
#f #f
#f
(make-semaphore 1) (make-semaphore 1)
(make-semaphore 1) (make-semaphore 1)
(make-hash) (make-hash)
(network-playback #f #f #f #f #f #f #f 0 #f) store
contexts
"local"
dlna-port)) dlna-port))
(start-network-monitor! value)
value)) value))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1320,9 +1185,17 @@
; post : Cached DLNA playback information has been incorporated. ; post : Cached DLNA playback information has been incorporated.
; result : A JSON-compatible hash. ; result : A JSON-compatible hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-state->jsexpr value) (define (player-state->jsexpr value #:username [username "local"])
(define normalized (normal-playlist-username username))
(call-with-semaphore
(player-command-lock value)
(lambda ()
(prune-stale-agents! value) (prune-stale-agents! value)
(refresh-network-state! value) (refresh-network-state! value)
(define context (playlist-context-for! value normalized))
(define tabs (playlist-context-tabs context))
(define tab-index (playlist-context-current-index context))
(define tracks (playlist-tab-tracks (list-ref tabs tab-index)))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
@@ -1346,18 +1219,21 @@
(index (in-naturals))) (index (in-naturals)))
(browser-entry->jsexpr entry index))) (browser-entry->jsexpr entry index)))
'tabs 'tabs
(for/list ((tab (in-list (player-tabs value))) (for/list ((tab (in-list tabs))
(index (in-naturals))) (index (in-naturals)))
(tab->jsexpr tab index)) (tab->jsexpr tab index))
'currentTab (player-current-tab-index value) 'currentTab tab-index
'tracks 'tracks
(for/list ((item (in-list (player-tracks value))) (for/list ((item (in-list tracks))
(index (in-naturals))) (index (in-naturals)))
(track->jsexpr item index)) (track->jsexpr item index))
'renderers (map renderer->jsexpr 'renderers (map renderer->jsexpr
(player-renderers value)) (player-renderers value))
'rendererId (player-selected-id value) 'rendererId (player-selected-id value)
'currentIndex (or (player-current-index value) 'null) 'currentIndex
(if (string=? normalized (player-active-playlist-user value))
(or (player-current-index value) 'null)
'null)
'state (symbol->string (player-state value)) 'state (symbol->string (player-state value))
'position (player-position value) 'position (player-position value)
'duration (or (player-duration value) 'null) 'duration (or (player-duration value) 'null)
@@ -1375,7 +1251,7 @@
'volume (player-volume value) 'volume (player-volume value)
'repeat (symbol->string (player-repeat value)) 'repeat (symbol->string (player-repeat value))
'discovering (player-discovering? value) 'discovering (player-discovering? value)
'error (or (player-error value) 'null)))))) 'error (or (player-error value) 'null))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Execute one browser player command. ; goal : Execute one browser player command.
@@ -1383,7 +1259,13 @@
; post : The command has completed or a concrete exception is raised. ; post : The command has completed or a concrete exception is raised.
; result : The updated JSON-compatible player state. ; result : The updated JSON-compatible player state.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-command! value command data) (define playlist-context-commands
'("item-play" "item-add" "track-remove" "track-move"
"playlist-clear" "tab-add" "tab-select" "tab-rename"
"tab-delete" "play"))
(define (player-command! value command data #:username [username "local"])
(define normalized (normal-playlist-username username))
(call-with-semaphore (call-with-semaphore
(player-command-lock value) (player-command-lock value)
(λ () (λ ()
@@ -1396,10 +1278,10 @@
(λ (exception) (λ (exception)
(set-error! value (exn-message exception)) (set-error! value (exn-message exception))
(raise exception)))) (raise exception))))
(when (member command playlist-context-commands)
(activate-playlist-user! value normalized))
(perform-command! value command data)))) (perform-command! value command data))))
;; State refresh can itself advance a completed network track and therefore (player-state->jsexpr value #:username normalized))
;; acquires command-lock. Take the snapshot after releasing this command.
(player-state->jsexpr value))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Discover UPnP renderers and logical Sonos groups asynchronously. ; goal : Discover UPnP renderers and logical Sonos groups asynchronously.
@@ -1606,15 +1488,24 @@
; post : Player state remains unchanged. ; post : Player state remains unchanged.
; result : Artwork bytes and MIME type, or #f when unavailable. ; result : Artwork bytes and MIME type, or #f when unavailable.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-track-artwork value artwork-id) (define (player-track-artwork value artwork-id #:username [username "local"])
(let ((item (define item
(with-state-lock (call-with-semaphore
(player-command-lock value)
(lambda ()
(define context
(playlist-context-for!
value value
(λ () (normal-playlist-username username)))
(findf (λ (candidate) (define candidates
(append
(player-tracks value)
(append-map playlist-tab-tracks
(playlist-context-tabs context))))
(findf (lambda (candidate)
(string=? (track-cache-key candidate) artwork-id)) (string=? (track-cache-key candidate) artwork-id))
(player-tracks value)))))) candidates))))
(and item (track-artwork item)))) (and item (track-artwork item)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Stop playback and release all player resources. ; goal : Stop playback and release all player resources.
@@ -1627,38 +1518,16 @@
(λ () (λ ()
(unless (player-closed? value) (unless (player-closed? value)
(close-backend! value) (close-backend! value)
(close-playlist-store! (player-playlist-store value))
(with-state-lock (with-state-lock
value value
(λ () (λ ()
(set-player-closed?! value #t)))))) (set-player-closed?! value #t)))))))
(let ((monitor (player-network-monitor value)))
(when (and monitor (not (thread-dead? monitor)))
(kill-thread monitor))
(set-player-network-monitor! value #f)))
(module+ test (module+ test
(require rackunit (require rackunit
racket/file) racket/file)
(check-eq?
(network-stop-decision #t #t #t 6000 #f 1)
'requested-stop)
(check-eq?
(network-stop-decision #f #t #f 1000 #f 0)
'wait-for-start)
(check-eq?
(network-stop-decision #f #t #f 6000 #f 0)
'playback-failed)
(check-eq?
(network-stop-decision #f #t #t 6000 #t 1)
'wait-for-next)
(check-eq?
(network-stop-decision #f #t #t 6000 #t 2)
'advance)
(check-eq?
(network-stop-decision #f #t #t 6000 #f 1)
'advance)
(define root (define root
(make-temporary-file "rkt-web-player-~a" 'directory)) (make-temporary-file "rkt-web-player-~a" 'directory))
@@ -1667,9 +1536,11 @@
(λ () (λ ()
(make-directory (build-path root "Album")) (make-directory (build-path root "Album"))
(let* ((libraries (make-music-libraries (list root))) (let* ((libraries (make-music-libraries (list root)))
(playlist-keystore (build-path root "playlists.keystore"))
(test-agent-id (make-string 64 #\a)) (test-agent-id (make-string 64 #\a))
(example-player (example-player
(make-player libraries (make-player libraries
#:playlist-keystore playlist-keystore
#:allowed-agent-ids (list test-agent-id))) #:allowed-agent-ids (list test-agent-id)))
(initial-state (initial-state
(player-state->jsexpr example-player))) (player-state->jsexpr example-player)))
@@ -1821,29 +1692,12 @@
example-player example-player
(list (track first-file "First" "Artist" "Album" 60 "audio/flac") (list (track first-file "First" "Artist" "Album" 60 "audio/flac")
(track second-file "Second" "Artist" "Album" 60 "audio/flac"))) (track second-file "Second" "Artist" "Album" 60 "audio/flac")))
;; Exercise persistence through ordinary playlist mutations while
(define test-network (player-network example-player)) ;; restoring the original order for the playback-agent assertions.
(set-network-playback-prepared-index! test-network 1) (player-command!
(set-network-playback-prepared-uri! example-player "track-move" (hasheq 'from 0 'to 1))
test-network (player-command!
"http://renderer.test/next.flac") example-player "track-move" (hasheq 'from 1 'to 0))
(check-equal?
(network-info-track-index
example-player
(dlna-info
'playing
(dlna-track-info second-file "Second" "Artist" "Album"
#f #f #f 60 #f #f #f)
"http://renderer.test/current.flac"
#f #f 0 60 25 #f #t))
1)
(check-equal?
(network-info-track-index
example-player
(dlna-info 'playing #f "http://renderer.test/next.flac"
#f #f 0 60 25 #f #t))
1)
(reset-network-playback! example-player)
(player-command! example-player "play" (hasheq 'index 0)) (player-command! example-player "play" (hasheq 'index 0))
(define play-poll (define play-poll
@@ -1890,6 +1744,39 @@
example-player example-player
"unknown" "unknown"
(hasheq)))) (hasheq))))
(player-close! example-player)))
(define hans-tabs
(player-command!
example-player
"tab-add"
(hasheq)
#:username "hans"))
(check-equal? (length (hash-ref hans-tabs 'tabs)) 2)
(player-command!
example-player
"tab-rename"
(hasheq 'index 1 'name "Hans favorieten")
#:username "hans")
(define local-after-hans
(player-state->jsexpr example-player #:username "local"))
(check-equal? (length (hash-ref local-after-hans 'tabs)) 1)
(check-equal? (length (hash-ref local-after-hans 'tracks)) 2)
(player-close! example-player)
(define restored-player
(make-player libraries #:playlist-keystore playlist-keystore))
(define restored-state (player-state->jsexpr restored-player))
(check-equal? (length (hash-ref restored-state 'tabs)) 1)
(check-equal? (length (hash-ref restored-state 'tracks)) 2)
(check-equal?
(hash-ref (car (hash-ref restored-state 'tracks)) 'source)
"01.flac")
(define restored-hans
(player-state->jsexpr restored-player #:username "hans"))
(check-equal? (length (hash-ref restored-hans 'tabs)) 2)
(check-equal?
(hash-ref (second (hash-ref restored-hans 'tabs)) 'name)
"Hans favorieten")
(player-close! restored-player)))
(λ () (λ ()
(delete-directory/files root)))) (delete-directory/files root))))
private/playlists.rkt
+202
View File
@@ -0,0 +1,202 @@
#lang racket/base
(require keystore
racket/file
racket/list
racket/path
uuid
"library.rkt")
(provide (struct-out persisted-tab)
open-playlist-store
close-playlist-store!
load-user-playlists
save-user-playlists!)
(struct persisted-tab (id name tracks) #:transparent)
(struct playlist-store (keystore lock) #:transparent)
(define (user-playlists-key username)
(format "playlists-for-~a" username))
(define (track->datum item)
(hasheq 'file (path->string (track-file item))
'title (track-title item)
'artist (track-artist item)
'album (track-album item)
'duration (or (track-duration item) #f)
'mime-type (or (track-mime-type item) #f)))
(define (optional-string? value)
(or (not value) (string? value)))
(define (datum->track value libraries)
(and (hash? value)
(let ((file (hash-ref value 'file #f))
(title (hash-ref value 'title #f))
(artist (hash-ref value 'artist #f))
(album (hash-ref value 'album #f))
(duration (hash-ref value 'duration #f))
(mime-type (hash-ref value 'mime-type #f)))
(and (path-string? file)
(string? title)
(string? artist)
(string? album)
(or (not duration)
(and (number? duration) (not (negative? duration))))
(optional-string? mime-type)
(library-contains-audio-file? libraries file)
(track (path->complete-path file)
title artist album duration mime-type)))))
(define (datum->tab id value libraries)
(and (uuid-string? id)
(hash? value)
(let ((name (hash-ref value 'name #f))
(tracks (hash-ref value 'tracks #f)))
(and (string? name)
(not (string=? name ""))
(list? tracks)
(persisted-tab
id
name
(filter-map
(lambda (item) (datum->track item libraries))
tracks))))))
(define (open-playlist-store file)
(and file
(let ((target (path->complete-path file)))
(make-parent-directory* target)
(playlist-store (ks-open target) (make-semaphore 1)))))
(define (close-playlist-store! store)
(when store
(call-with-semaphore
(playlist-store-lock store)
(lambda () (ks-close (playlist-store-keystore store)))))
(void))
(define (load-user-playlists store username libraries)
(if (not store)
'()
(call-with-semaphore
(playlist-store-lock store)
(lambda ()
(define ks (playlist-store-keystore store))
(define ids (ks-get ks (user-playlists-key username) '()))
(if (list? ids)
(filter-map
(lambda (id)
(datum->tab id (ks-get ks id #f) libraries))
(remove-duplicates (filter uuid-string? ids) string=?))
'())))))
(define (save-user-playlists! store username tabs)
(when store
(call-with-semaphore
(playlist-store-lock store)
(lambda ()
(define ks (playlist-store-keystore store))
(define index-key (user-playlists-key username))
(define old-ids (ks-get ks index-key '()))
(define ids (map persisted-tab-id tabs))
(ks-transaction
ks
(for ((id (in-list (if (list? old-ids) old-ids '())))
#:when (and (string? id) (not (member id ids string=?))))
(ks-drop! ks id))
(for ((tab (in-list tabs)))
(ks-set!
ks
(persisted-tab-id tab)
(hasheq 'name (persisted-tab-name tab)
'tracks (map track->datum
(persisted-tab-tracks tab)))))
(ks-set! ks index-key ids))
(void)))))
(module+ test
(require rackunit
uuid/random)
(define root
(make-temporary-file "rkt-playlists-~a" 'directory))
(define music (build-path root "music"))
(define music-two (build-path root "music-two"))
(define outside (build-path root "outside.flac"))
(define store-file (build-path root "data" "playlists.keystore"))
(dynamic-wind
(lambda ()
(make-directory music)
(make-directory music-two)
(call-with-output-file (build-path music "one.flac") void)
(call-with-output-file (build-path music-two "two.flac") void)
(call-with-output-file outside void))
(lambda ()
(define libraries (make-music-libraries (list music music-two)))
(define store (open-playlist-store store-file))
(define first-id (uuid-string))
(define second-id (uuid-string))
(define item
(track (build-path music "one.flac")
"One" "Artist" "Album" 60 "audio/flac"))
(define item-two
(track (build-path music-two "two.flac")
"Two" "Artist" "Album" 70 "audio/flac"))
(save-user-playlists!
store
"hans"
(list (persisted-tab first-id "First" (list item item-two))
(persisted-tab second-id "Second" '())))
(save-user-playlists!
store
"local"
(list (persisted-tab (uuid-string) "Local" '())))
(define loaded (load-user-playlists store "hans" libraries))
(define ks (playlist-store-keystore store))
(check-equal? (ks-get ks "playlists-for-hans")
(list first-id second-id))
(check-equal? (hash-ref (ks-get ks first-id) 'name) "First")
(check-equal? (map persisted-tab-id loaded) (list first-id second-id))
(check-equal? (persisted-tab-name (car loaded)) "First")
(check-equal? (map track-title (persisted-tab-tracks (car loaded)))
'("One" "Two"))
(check-equal?
(map persisted-tab-name (load-user-playlists store "local" libraries))
'("Local"))
;; Rewriting the user's GUID index durably removes the omitted playlist.
(save-user-playlists!
store "hans"
(list (persisted-tab first-id "First" (list item item-two))))
(check-equal?
(map persisted-tab-id (load-user-playlists store "hans" libraries))
(list first-id))
(check-false (ks-exists? ks second-id))
;; An omitted GUID is deleted rather than becoming orphaned.
(check-equal?
(map persisted-tab-name (load-user-playlists store "local" libraries))
'("Local"))
;; A playlist entry may not restore tracks outside configured libraries.
(define unsafe-id (uuid-string))
(ks-set!
(playlist-store-keystore store)
unsafe-id
(hasheq
'name "Unsafe"
'tracks
(list (hasheq 'file (path->string outside)
'title "Outside" 'artist "" 'album ""
'duration #f 'mime-type "audio/flac"))))
(ks-set! (playlist-store-keystore store)
(user-playlists-key "unsafe")
(list unsafe-id))
(check-equal?
(persisted-tab-tracks
(car (load-user-playlists store "unsafe" libraries)))
'())
(close-playlist-store! store))
(lambda () (delete-directory/files root))))
private/server.rkt
+20 -7
View File
@@ -94,12 +94,21 @@
#:headers #:headers
(list (header #"Set-Cookie" (auth-expired-cookie))))) (list (header #"Set-Cookie" (auth-expired-cookie)))))
(define (state-handler _request) (define (request-username request)
(json-response (player-state->jsexpr current-player))) (or (auth-request-user current-auth request) "anonymous"))
(define (discover-handler _request) (define (state-handler request)
(json-response
(player-state->jsexpr
current-player
#:username (request-username request))))
(define (discover-handler request)
(player-discover! current-player) (player-discover! current-player)
(json-response (player-state->jsexpr current-player))) (json-response
(player-state->jsexpr
current-player
#:username (request-username request))))
(define (command-handler request command) (define (command-handler request command)
(with-handlers (with-handlers
@@ -108,7 +117,8 @@
(player-command! (player-command!
current-player current-player
command command
(request-jsexpr request))))) (request-jsexpr request)
#:username (request-username request)))))
(define (agent-register-handler request) (define (agent-register-handler request)
(with-handlers (with-handlers
@@ -152,8 +162,11 @@
(hasheq 'error "media token is invalid or expired") (hasheq 'error "media token is invalid or expired")
#:code 404)))) #:code 404))))
(define (artwork-handler _request artwork-id) (define (artwork-handler request artwork-id)
(let ((value (player-track-artwork current-player artwork-id))) (let ((value (player-track-artwork
current-player
artwork-id
#:username (request-username request))))
(if value (if value
(response/output (response/output
(λ (output) (λ (output)
scribblings/rkt-web-player.scrbl
+6 -1
View File
@@ -27,6 +27,7 @@ browser by Racket's web server.
[#:listen-ip listen-ip string? "127.0.0.1"] [#:listen-ip listen-ip string? "127.0.0.1"]
[#:port port exact-positive-integer? 8080] [#:port port exact-positive-integer? 8080]
[#:dlna-port dlna-port exact-positive-integer? 8734] [#:dlna-port dlna-port exact-positive-integer? 8734]
[#:playlist-keystore playlist-keystore (or/c path-string? #f)]
[#:launch-browser? launch-browser? boolean? #t]) any/c] { [#:launch-browser? launch-browser? boolean? #t]) any/c] {
Treats every entry in @racket[music-paths] as a separate music library. A Treats every entry in @racket[music-paths] as a separate music library. A
@@ -39,7 +40,11 @@ contents are browsed one level at a time. Metadata and recursive contents are
only read when the user adds or plays a selected item. only read when the user adds or plays a selected item.
The @racket[dlna-port] is used to publish local audio files to a selected The @racket[dlna-port] is used to publish local audio files to a selected
network renderer. Player resources are closed when the web server exits. network renderer. Playlist tabs are atomically persisted in
@racket[playlist-keystore]; @racket[#f] disables playlist persistence. Player
resources are closed when the web server exits. The default is
@tt{data/playlists.keystore} below the installed rkt-web-player collection.
Each username owns an ordered GUID index and separate playlist values.
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.