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
# Runtime playlist keystore
data/*.keystore*
ARCHITECTURE.md
+57 -32
View File
@@ -39,11 +39,13 @@ flowchart TB
Server[private/server.rkt<br/>HTTP adapter]
Users[private/users.rkt<br/>users, networks and sessions]
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]
UI[public/index.html + styles.css + app.js<br/>browser UI]
Audio[racket-audio<br/>local backend]
Discovery[racket-upnp + racket-sonos<br/>device discovery]
DLNA[racket-audio-dlna<br/>network backend and media server]
DLNA[racket-audio-dlna<br/>transport, seeking and media publication]
AgentGUI[private/player-agent-gui.rkt<br/>GUI adapter]
AgentCLI[player-agent-cli.rkt<br/>CLI adapter]
AgentCore[private/player-agent-core.rkt<br/>polling and audio runtime]
@@ -55,9 +57,11 @@ flowchart TB
Server --> Users
Server --> UI
Player --> Library
Player --> Playlists
Player --> Audio
Player --> Discovery
Player --> DLNA
Player --> DLNAAdapter
DLNAAdapter --> DLNA
AgentGUI --> AgentCore
AgentCLI --> AgentCore
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:
- 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;
- registered HTTP playback agents and their pending command queues;
- 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,
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.
Selecting, deleting, or creating a tab stops playback. Tracks are de-duplicated
by normalized source path when they are appended. Every playlist mutation is
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
@@ -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
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. After starting a track, the server publishes the following track and sets
it as the renderer's `NextAVTransportURI`. Network playback information is
refreshed whenever a state snapshot is requested. 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.
Network outputs use the small `private/dlna-playback.rkt` adapter. It owns only
the playlist transition state machine; all transport commands, seeking, HTTP
publication, UPnP calls and cached renderer information are delegated to
`racket-audio-dlna`. After starting a track, the adapter asks that package to
publish the following track and set it as the renderer's
`NextAVTransportURI`.
The adapter polls the package's cached renderer information independently of
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
state. The replacement backend remains lazy and is created only when it is
@@ -269,16 +282,24 @@ sequenceDiagram
participant B as Browser
participant H as HTTP server
participant P as Player
participant A as DLNA playback adapter
participant L as racket-audio-dlna
participant D as DLNA renderer
loop Every second
loop Browser state polling
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
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
@@ -311,15 +332,16 @@ file:
- DLNA media publication port, defaulting to `8734`;
- named library root paths under `[libraries]` (the legacy semicolon-separated
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.
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.
Playlist tabs use the SQLite-backed `keystore` module at
`data/playlists.keystore`. Output discovery, transport state, playback position
and sessions still reset when the process restarts.
## 7. Security and operational boundaries
@@ -353,10 +375,13 @@ 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.
directory ordering. `private/playlists.rkt` tests transactional round trips,
per-user GUID indexes, multiple libraries, deletion and library-boundary
validation. Tests in `private/player.rkt`
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:
@@ -365,15 +390,14 @@ The main extension points are:
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.
- **Per-user playlists, shared transport:** playlist collections are isolated
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
of repeatedly transferring all tracks and browser entries.
- **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
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.
- **Keystore playlists:** transactional recovery after restart without a custom
database layer, with the SQLite-backed keystore remaining a single-node
resource.
- **Explicit backend branching:** easy to follow for the current small set of
outputs, but adding renderer types touches several player functions rather
than one formal backend interface.
README.md
+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
onder `[libraries]` is de zichtbare bibliotheeknaam; de waarde is de lokale of
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
niet-lokale clients een eigen loginvenster. Wachtwoorden staan uitsluitend als
@@ -98,8 +101,16 @@ track.
Playlisttabs kunnen worden toegevoegd, geselecteerd, hernoemd door dubbel te
klikken en verwijderd. Tracks kunnen worden afgespeeld, verwijderd en met
drag-and-drop verplaatst. De tabs zijn in deze versie alleen in het geheugen
aanwezig en worden niet na een herstart hersteld.
drag-and-drop verplaatst. Tabnamen, tabvolgorde en alle tracklijsten worden na
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
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"
"crypto-lib"
"gui-lib"
"keystore"
"net-lib"
"web-server-lib"
"racket-audio"
@@ -18,7 +19,8 @@
"racket-sonos"
"racket-upnp"
"simple-ini"
"simple-log"))
"simple-log"
"uuid"))
(define build-deps
'("racket-doc"
main.rkt
+20
View File
@@ -4,6 +4,7 @@
racket/contract
racket/list
racket/mpair
racket/runtime-path
racket/string
simple-ini
simple-log
@@ -20,6 +21,9 @@
(or/c path-string?
(list/c string? path-string?)))
(define-runtime-path default-playlist-keystore
"data/playlists.keystore")
(define (ini-section-key-values config section-name)
(let ((section (assoc section-name (mcdr config))))
(if section
@@ -62,6 +66,8 @@
#:listen-ip [listen-ip "127.0.0.1"]
#:port [port 8080]
#:dlna-port [dlna-port 8734]
#:playlist-keystore
[playlist-keystore default-playlist-keystore]
#:launch-browser? [launch-browser? #t])
(->* ((listof library-spec/c))
(#:allowed-agent-ids (listof string?)
@@ -72,11 +78,13 @@
#:listen-ip string?
#:port exact-positive-integer?
#:dlna-port exact-positive-integer?
#:playlist-keystore (or/c path-string? #f)
#:launch-browser? boolean?)
any)
(let* ((libraries (make-music-libraries music-paths))
(player (make-player libraries
#:allowed-agent-ids allowed-agent-ids
#:playlist-keystore playlist-keystore
#:dlna-port dlna-port))
(auth-manager
(make-auth-manager users
@@ -107,6 +115,7 @@
(define listen-ip #f)
(define port #f)
(define dlna-port #f)
(define playlist-keystore #f)
(define launch-browser? #t)
(define config-file #f)
@@ -123,6 +132,9 @@
[("--dlna-port") value
"Port used to publish local audio to DLNA renderers"
(set! dlna-port (string->number value))]
[("--playlist-keystore") path
"Keystore used to persist per-user playlist tabs"
(set! playlist-keystore path)]
[("--config") path
"Read defaults from an INI file"
(set! config-file path)]
@@ -200,4 +212,12 @@
(ini-get config 'server 'port 8080))
#:dlna-port (or dlna-port
(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?))
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 artwork)
make-music-libraries
library-contains-audio-file?
browse-library
browser-entry->tracks
track-artwork)
@@ -133,6 +134,25 @@
(browser-entry-relative-path entry))))))
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
private/player.rkt
+258 -371
View File
@@ -10,7 +10,10 @@
racket-sonos
racket-upnp
simple-log
"library.rkt")
uuid/random
"dlna-playback.rkt"
"library.rkt"
"playlists.rkt")
(provide make-player
player-state->jsexpr
@@ -47,16 +50,8 @@
(id [name #:mutable] [tracks #:mutable])
#:transparent)
(struct network-playback
([current-uri #: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])
(struct playlist-context
([tabs #:mutable] [current-index #:mutable])
#:transparent)
(struct player
@@ -86,11 +81,12 @@
[error #:mutable]
[discovering? #:mutable]
[closed? #:mutable]
[network-monitor #:mutable]
state-lock
command-lock
local-music-indexes
network
playlist-store
playlist-contexts
[active-playlist-user #:mutable]
dlna-port)
#:transparent)
@@ -237,6 +233,71 @@
(current-tab 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)
(cond
((eq? state 'playing) 'playing)
@@ -261,94 +322,6 @@
(set-player-bits! 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)
(with-state-lock
value
@@ -409,10 +382,38 @@
(* 100.0 logical-volume logical-volume)))
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)
(make-dlna-player device
#:port (player-dlna-port value)
#:path "/rkt-web-player/"))
(define backend
(make-dlna-playback
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)
(if (player-backend value)
@@ -461,11 +462,10 @@
((eq? kind 'agent)
(enqueue-agent-command! value backend "stop"))
(else
(dlna-player-close! backend)))))
(dlna-playback-close! backend)))))
(with-state-lock
value
(λ ()
(reset-network-playback! value)
(set-player-backend! value #f)
(set-player-backend-kind! value #f)
(set-player-state! value 'stopped)
@@ -483,16 +483,7 @@
(player-backend value)
"stop"))
(else
(with-state-lock
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)))))
(dlna-playback-stop! (player-backend value)))))
(with-state-lock
value
(λ ()
@@ -559,24 +550,7 @@
(enqueue-agent-command!
value backend "prefetch" following-data))))
(else
(dlna-player-play! backend (track-file item))
(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)))
(dlna-playback-play-index! backend index)))
(clear-error! value)))
(define (next-index value direction)
@@ -628,140 +602,14 @@
(when volume (set-player-volume! value volume)))
(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)
(call-with-semaphore
(player-command-lock value)
(λ ()
(when (and (player-backend value)
(not (eq? (player-backend-kind value) 'local)))
(with-handlers
((exn:fail?
(λ (exception)
(set-error! value (exn-message exception)))))
(if (eq? (player-backend-kind value) 'agent)
(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)))))))
(when (and (player-backend value)
(eq? (player-backend-kind value) 'agent))
(with-handlers
((exn:fail?
(λ (exception)
(set-error! value (exn-message exception)))))
(refresh-agent-state! value))))
(define (entry-by-index value index)
(and (exact-nonnegative-integer? index)
@@ -812,7 +660,8 @@
value
(λ ()
(set-player-tracks! value combined)
(save-current-tab! value)))))
(save-current-tab! value)
(persist-playlists! value)))))
(define (replace-tracks! value tracks)
(stop-playback! value)
@@ -821,7 +670,8 @@
(λ ()
(set-player-tracks! value tracks)
(set-player-current-index! value #f)
(save-current-tab! value))))
(save-current-tab! value)
(persist-playlists! value))))
(define (drop-track! value index)
(unless (valid-track-index? value index)
@@ -846,7 +696,8 @@
(set-player-current-index!
value
(- (player-current-index value) 1))))
(save-current-tab! value))))
(save-current-tab! value)
(persist-playlists! value))))
(define (move-track! value from-index to-index)
(unless (and (valid-track-index? value from-index)
@@ -881,7 +732,8 @@
((and (<= to-index current)
(< current from-index))
(set-player-current-index! value (+ current 1)))))
(save-current-tab! value))))))
(save-current-tab! value)
(persist-playlists! value))))))
(define (select-tab! value index)
(unless (and (exact-nonnegative-integer? index)
@@ -900,7 +752,8 @@
(set-player-tracks!
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)
(with-state-lock
@@ -911,15 +764,14 @@
(number (+ (length tabs) 1))
(tab
(playlist-tab
(format "tab-~a-~a"
(current-milliseconds)
(random 10000))
(uuid-string)
(format "Playlist ~a" number)
'())))
(set-player-tabs! value (append tabs (list tab)))
(set-player-current-tab-index! value (length tabs))
(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)
(unless (and (exact-nonnegative-integer? index)
@@ -938,7 +790,8 @@
(λ ()
(set-playlist-tab-name!
(list-ref (player-tabs value) index)
trimmed)))))
trimmed)
(persist-playlists! value)))))
(define (delete-tab! value index)
(when (= (length (player-tabs value)) 1)
@@ -967,7 +820,8 @@
(set-player-tracks!
value
(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)
(hasheq 'index index
@@ -1153,7 +1007,7 @@
((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command! value backend "pause"))
(else
(dlna-player-pause! backend)))))
(dlna-playback-pause! backend)))))
((string=? command "resume")
(let ((backend (ensure-backend! value)))
(cond
@@ -1162,7 +1016,7 @@
((eq? (player-backend-kind value) 'agent)
(enqueue-agent-command! value backend "resume"))
(else
(dlna-player-resume! backend)))))
(dlna-playback-resume! backend)))))
((string=? command "stop")
(stop-playback! value))
((string=? command "next")
@@ -1189,7 +1043,7 @@
value backend "seek"
(hasheq 'percentage percentage)))
(else
(dlna-player-seek-percentage! backend percentage))))))
(dlna-playback-seek-percentage! backend percentage))))))
((string=? command "volume")
(let ((percentage (json-number data 'value #f)))
(unless percentage
@@ -1209,7 +1063,7 @@
value backend "volume"
(hasheq 'value clamped)))
(else
(dlna-player-volume! backend clamped)))
(dlna-playback-volume! backend clamped)))
(with-state-lock
value
(λ ()
@@ -1227,10 +1081,7 @@
(λ ()
(set-player-repeat! value mode)))
(when (member (player-backend-kind value) '(upnp sonos))
;; Replace the renderer's prepared URI when repeat mode changes.
(set-network-playback-prepared-index! (player-network value) #f)
(set-network-playback-prepared-uri! (player-network value) #f)
(prepare-next-network-track! value))))
(dlna-playback-repeat! (player-backend value) mode))))
((string=? command "renderer")
(let* ((id (json-string data 'id #f))
(selected (and id (renderer-by-id value id))))
@@ -1263,6 +1114,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-player libraries
#:allowed-agent-ids [allowed-agent-ids '()]
#:playlist-keystore [playlist-keystore #f]
#:dlna-port [dlna-port 8734])
(define normalized-agent-ids
(for/list ((app-id (in-list allowed-agent-ids)))
@@ -1272,12 +1124,25 @@
"64-character hexadecimal playback agent id"
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)))
(browser-entries
(if 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
(player libraries
(remove-duplicates normalized-agent-ids string=?)
@@ -1285,9 +1150,9 @@
(and library (music-library-id library))
'()
browser-entries
'()
(list tab)
0
(playlist-tab-tracks (list-ref tabs selected-index))
tabs
selected-index
(list (renderer "local" "Server audio output" 'local #f))
"local"
#f
@@ -1305,13 +1170,13 @@
#f
#f
#f
#f
(make-semaphore 1)
(make-semaphore 1)
(make-hash)
(network-playback #f #f #f #f #f #f #f 0 #f)
store
contexts
"local"
dlna-port))
(start-network-monitor! value)
value))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1320,19 +1185,27 @@
; post : Cached DLNA playback information has been incorporated.
; result : A JSON-compatible hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-state->jsexpr value)
(prune-stale-agents! value)
(refresh-network-state! value)
(with-state-lock
value
(λ ()
(let ((current
(and (player-current-index value)
(valid-track-index?
value
(player-current-index value))
(list-ref (player-tracks value)
(player-current-index 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)
(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
value
(λ ()
(let ((current
(and (player-current-index value)
(valid-track-index?
value
(player-current-index value))
(list-ref (player-tracks value)
(player-current-index value)))))
(hasheq
'libraries (map library->jsexpr
(player-libraries value))
@@ -1346,18 +1219,21 @@
(index (in-naturals)))
(browser-entry->jsexpr entry index)))
'tabs
(for/list ((tab (in-list (player-tabs value)))
(for/list ((tab (in-list tabs))
(index (in-naturals)))
(tab->jsexpr tab index))
'currentTab (player-current-tab-index value)
'currentTab tab-index
'tracks
(for/list ((item (in-list (player-tracks value)))
(for/list ((item (in-list tracks))
(index (in-naturals)))
(track->jsexpr item index))
'renderers (map renderer->jsexpr
(player-renderers 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))
'position (player-position value)
'duration (or (player-duration value) 'null)
@@ -1375,7 +1251,7 @@
'volume (player-volume value)
'repeat (symbol->string (player-repeat value))
'discovering (player-discovering? value)
'error (or (player-error value) 'null))))))
'error (or (player-error value) 'null))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Execute one browser player command.
@@ -1383,7 +1259,13 @@
; post : The command has completed or a concrete exception is raised.
; 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
(player-command-lock value)
(λ ()
@@ -1396,10 +1278,10 @@
(λ (exception)
(set-error! value (exn-message exception))
(raise exception))))
(when (member command playlist-context-commands)
(activate-playlist-user! value normalized))
(perform-command! value command data))))
;; State refresh can itself advance a completed network track and therefore
;; acquires command-lock. Take the snapshot after releasing this command.
(player-state->jsexpr value))
(player-state->jsexpr value #:username normalized))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Discover UPnP renderers and logical Sonos groups asynchronously.
@@ -1606,15 +1488,24 @@
; post : Player state remains unchanged.
; result : Artwork bytes and MIME type, or #f when unavailable.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-track-artwork value artwork-id)
(let ((item
(with-state-lock
(define (player-track-artwork value artwork-id #:username [username "local"])
(define item
(call-with-semaphore
(player-command-lock value)
(lambda ()
(define context
(playlist-context-for!
value
(λ ()
(findf (λ (candidate)
(string=? (track-cache-key candidate) artwork-id))
(player-tracks value))))))
(and item (track-artwork item))))
(normal-playlist-username username)))
(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))
candidates))))
(and item (track-artwork item)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Stop playback and release all player resources.
@@ -1627,38 +1518,16 @@
(λ ()
(unless (player-closed? value)
(close-backend! value)
(close-playlist-store! (player-playlist-store value))
(with-state-lock
value
(λ ()
(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)))
(set-player-closed?! value #t)))))))
(module+ test
(require rackunit
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
(make-temporary-file "rkt-web-player-~a" 'directory))
@@ -1667,9 +1536,11 @@
(λ ()
(make-directory (build-path root "Album"))
(let* ((libraries (make-music-libraries (list root)))
(playlist-keystore (build-path root "playlists.keystore"))
(test-agent-id (make-string 64 #\a))
(example-player
(make-player libraries
#:playlist-keystore playlist-keystore
#:allowed-agent-ids (list test-agent-id)))
(initial-state
(player-state->jsexpr example-player)))
@@ -1821,29 +1692,12 @@
example-player
(list (track first-file "First" "Artist" "Album" 60 "audio/flac")
(track second-file "Second" "Artist" "Album" 60 "audio/flac")))
(define test-network (player-network example-player))
(set-network-playback-prepared-index! test-network 1)
(set-network-playback-prepared-uri!
test-network
"http://renderer.test/next.flac")
(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)
;; Exercise persistence through ordinary playlist mutations while
;; restoring the original order for the playback-agent assertions.
(player-command!
example-player "track-move" (hasheq 'from 0 'to 1))
(player-command!
example-player "track-move" (hasheq 'from 1 'to 0))
(player-command! example-player "play" (hasheq 'index 0))
(define play-poll
@@ -1890,6 +1744,39 @@
example-player
"unknown"
(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))))
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
(list (header #"Set-Cookie" (auth-expired-cookie)))))
(define (state-handler _request)
(json-response (player-state->jsexpr current-player)))
(define (request-username request)
(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)
(json-response (player-state->jsexpr current-player)))
(json-response
(player-state->jsexpr
current-player
#:username (request-username request))))
(define (command-handler request command)
(with-handlers
@@ -108,7 +117,8 @@
(player-command!
current-player
command
(request-jsexpr request)))))
(request-jsexpr request)
#:username (request-username request)))))
(define (agent-register-handler request)
(with-handlers
@@ -152,8 +162,11 @@
(hasheq 'error "media token is invalid or expired")
#:code 404))))
(define (artwork-handler _request artwork-id)
(let ((value (player-track-artwork current-player artwork-id)))
(define (artwork-handler request artwork-id)
(let ((value (player-track-artwork
current-player
artwork-id
#:username (request-username request))))
(if value
(response/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"]
[#:port port exact-positive-integer? 8080]
[#: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] {
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.
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.
Use a LAN address deliberately if other devices should control the player.