playlists and DLNA playback

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)))

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
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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))))

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))))

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)