diff --git a/.gitignore b/.gitignore
index bbb3b8e..a9e5940 100644
--- a/.gitignore
+++ b/.gitignore
@@ -23,3 +23,5 @@ scrbl/*.css
rkt-web-player.ini
+# Runtime playlist keystore
+data/*.keystore*
diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md
index b62d596..fa62be8 100644
--- a/ARCHITECTURE.md
+++ b/ARCHITECTURE.md
@@ -39,11 +39,13 @@ flowchart TB
Server[private/server.rkt
HTTP adapter]
Users[private/users.rkt
users, networks and sessions]
Player[private/player.rkt
application state and commands]
+ Playlists[private/playlists.rkt
durable playlist tabs]
+ DLNAAdapter[private/dlna-playback.rkt
playlist transition orchestration]
Library[private/library.rkt
filesystem and metadata]
UI[public/index.html + styles.css + app.js
browser UI]
Audio[racket-audio
local backend]
Discovery[racket-upnp + racket-sonos
device discovery]
- DLNA[racket-audio-dlna
network backend and media server]
+ DLNA[racket-audio-dlna
transport, seeking and media publication]
AgentGUI[private/player-agent-gui.rkt
GUI adapter]
AgentCLI[player-agent-cli.rkt
CLI adapter]
AgentCore[private/player-agent-core.rkt
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-` 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.
diff --git a/README.md b/README.md
index 792472d..da18f13 100644
--- a/README.md
+++ b/README.md
@@ -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-` 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
diff --git a/data/.gitkeep b/data/.gitkeep
new file mode 100644
index 0000000..8b13789
--- /dev/null
+++ b/data/.gitkeep
@@ -0,0 +1 @@
+
diff --git a/info.rkt b/info.rkt
index dd78c4b..40d7828 100644
--- a/info.rkt
+++ b/info.rkt
@@ -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"
diff --git a/main.rkt b/main.rkt
index a3bb816..4c125c7 100644
--- a/main.rkt
+++ b/main.rkt
@@ -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?))
diff --git a/private/dlna-playback.rkt b/private/dlna-playback.rkt
new file mode 100644
index 0000000..448b3d9
--- /dev/null
+++ b/private/dlna-playback.rkt
@@ -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)))
diff --git a/private/library.rkt b/private/library.rkt
index 5f0d358..35b683d 100644
--- a/private/library.rkt
+++ b/private/library.rkt
@@ -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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/private/player.rkt b/private/player.rkt
index e0ae96a..473da8e 100644
--- a/private/player.rkt
+++ b/private/player.rkt
@@ -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))))
diff --git a/private/playlists.rkt b/private/playlists.rkt
new file mode 100644
index 0000000..ba1dd7c
--- /dev/null
+++ b/private/playlists.rkt
@@ -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))))
diff --git a/private/server.rkt b/private/server.rkt
index 9636fd4..4ccb257 100644
--- a/private/server.rkt
+++ b/private/server.rkt
@@ -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)
diff --git a/scribblings/rkt-web-player.scrbl b/scribblings/rkt-web-player.scrbl
index f583bee..13eeb61 100644
--- a/scribblings/rkt-web-player.scrbl
+++ b/scribblings/rkt-web-player.scrbl
@@ -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.