refactoring

.gitignore

@@ -26,3 +26,7 @@ rkt-web-player.ini
 # Runtime playlist keystore
 data/*.keystore*
 /.scribble-build
+
+# Logging
+*.log
+*.log.*

ARCHITECTURE.md

@@ -47,9 +47,9 @@ flowchart TB
     Audio[racket-audio<br/>local backend]
     Discovery[racket-upnp + racket-sonos<br/>device discovery]
     DLNA[racket-audio-dlna<br/>transport, seeking and media publication]
-    AgentGUI[private/player-agent-gui.rkt<br/>GUI adapter]
+    AgentGUI[private-player-agent/player-agent-gui.rkt<br/>GUI adapter]
     AgentCLI[player-agent-cli.rkt<br/>CLI adapter]
-    AgentCore[private/player-agent-core.rkt<br/>polling and audio runtime]
+    AgentCore[private-player-agent/player-agent-core.rkt<br/>polling and audio runtime]
 
     Main --> Server
     Main --> Player
@@ -254,7 +254,8 @@ Italian, Swedish, Norwegian, Finnish and Icelandic with English fallback.
 Browser preferences select the initial language; a
 manual selection is stored server-side per username and therefore follows the
 user across browsers. The native agent uses the equivalent
-[`private/translate.rkt`](private/translate.rkt) module and the operating-system
+[`private-player-agent/player-agent-translate.rkt`](private-player-agent/player-agent-translate.rkt)
+module and the operating-system
 language.
 
 DOM signatures prevent rebuilding unchanged library, tab, and playlist
@@ -342,10 +343,11 @@ generally performed outside it, with their results committed in short locked
 sections. Audio callbacks use only the short-lived state lock and update the
 playback session captured when their backend was created.
 
-The server module stores the player in a module-level `current-player` variable.
+The server module creates one request-dispatcher closure for each `serve-player`
-This matches the intended one-player-per-process deployment, but it prevents
+call. That closure captures its player and authentication manager and binds them
-multiple independent player instances from being served safely within the same
+to every HTTP handler. No player or authentication state is stored in module
-Racket process.
+variables, so independent server instances do not overwrite each other's
+context within the same Racket process.
 
 ## 6. Configuration and deployment
 

README.md

@@ -242,6 +242,6 @@ geen TLS heeft.
 
 ```console
 raco test private/users.rkt private/library.rkt private/player.rkt \
-  private/player-agent-config.rkt
+  private-player-agent/player-agent-config.rkt
 raco setup --check-pkg-deps rkt-web-player
 ```

info.rkt

@@ -12,6 +12,7 @@
     "gui-lib"
     "keystore"
     "libargon2"
+    "net-ip-lib"
     "net-lib"
     "web-server-lib"
     "racket-audio"
@@ -20,7 +21,7 @@
     "racket-sonos"
     "racket-tray"
     "racket-upnp"
-    "simple-ini"
+    ("simple-ini" #:version "0.3.3")
     "simple-log"
     "uuid"))
 

main.rkt

@@ -3,7 +3,6 @@
 (require racket/cmdline
          racket/contract
          racket/list
-         racket/mpair
          racket/runtime-path
          racket/string
          simple-ini
@@ -24,15 +23,15 @@
 (define-runtime-path default-playlist-keystore
   "data/playlists.keystore")
 
+(define-runtime-path default-log-file
+  "data/rkt-web-player.log")
+
+;;; Returns the key/value pairs from one INI section in source order.
 (define (ini-section-key-values config section-name)
-  (let ((section (assoc section-name (mcdr config))))
+  (map (λ (key)
-    (if section
+         (cons (symbol->string key)
-        (for/list ((line (in-list (cdr section)))
+               (ini-get config section-name key #f)))
-                   #:when (and (pair? line)
+       (ini-keys config section-name)))
-                               (eq? (car line) 'keyval)))
-          (cons (symbol->string (cadr line))
-                (caddr line)))
-        '())))
 
 (define (configuration-list value defaults)
   (cond
@@ -65,6 +64,12 @@
                                  #:local-output? [local-output? #t]
                                  #:playlist-keystore
                                  [playlist-keystore default-playlist-keystore]
+                                 #:log-file
+                                 [log-file default-log-file]
+                                 #:log-retention-days
+                                 [log-retention-days 7]
+                                 #:log-level
+                                 [log-level 'debug]
                                  #:launch-browser? [launch-browser? #t])
   (->* ((listof library-spec/c))
        (#:allowed-agent-ids (listof string?)
@@ -76,8 +81,15 @@
         #:dlna-port exact-positive-integer?
         #:local-output? boolean?
         #:playlist-keystore (or/c path-string? #f)
+        #:log-file path-string?
+        #:log-retention-days exact-positive-integer?
+        #:log-level symbol?
         #:launch-browser? boolean?)
        any)
+
+  (sl-log-to-rotating-file log-file log-retention-days)
+  (sl-set-log-level log-level)
+
   (let* ((libraries (make-music-libraries music-paths))
          (player (make-player libraries
                               #:allowed-agent-ids allowed-agent-ids
@@ -104,6 +116,23 @@
       (λ ()
         (player-close! player)))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module main.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module+ test
+  (require rackunit)
+
+  (let ((config (make-ini)))
+    (ini-set! config 'libraries 'music "/srv/music")
+    (ini-set! config 'server 'port 8080)
+    (ini-set! config 'libraries 'archive "/srv/archive")
+    (check-equal?
+     (ini-section-key-values config 'libraries)
+     '(("music" . "/srv/music")
+       ("archive" . "/srv/archive")))
+    (check-equal? (ini-section-key-values config 'missing) '())))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Command line
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -115,6 +144,7 @@
   (define playlist-keystore #f)
   (define launch-browser? #t)
   (define config-file #f)
+  (define log-file #f)
 
   (define music-paths
     (command-line
@@ -138,6 +168,9 @@
      [("--no-browser")
       "Do not open the web interface automatically"
       (set! launch-browser? #f)]
+     [("--log-file") path
+      "Log file path, retention is normally set to 7 days, but can be changed in the INI file"
+      (set! log-file path)]
      #:args paths
      paths))
 
@@ -189,7 +222,6 @@
             music-paths
             configured-paths))
 
-  (sl-log-to-display)
   (run-web-player
    all-libraries
    #:allowed-agent-ids allowed-agent-ids
@@ -211,4 +243,17 @@
               (not (string=? (string-trim (format "~a" configured)) ""))
               configured))
        default-playlist-keystore)
-   #:launch-browser? launch-browser?))
+   #:launch-browser? launch-browser?
+   #:log-file
+   (if (eq? log-file #f)
+        default-log-file
+        (if (eq? (ini-get config 'logging 'log-file #f) #f)
+            log-file
+            (ini-get config 'logging 'log-file default-log-file)))
+   #:log-retention-days
+   (ini-get config 'logging 'log-retention-days 7)
+   #:log-level
+   (string->symbol
+     (format "~a" (ini-get config 'logging 'log-level 'debug)))
+  )
+)

player-agent-cli.rkt

@@ -5,8 +5,8 @@
          racket/format
          racket/string
          simple-log
-         "private/player-agent-config.rkt"
+         "private-player-agent/player-agent-config.rkt"
-         "private/player-agent-core.rkt")
+         "private-player-agent/player-agent-core.rkt")
 
 (provide run-player-agent-cli)
 

player-agent.rkt

@@ -17,7 +17,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (run-player-agent)
   (-> object?)
-  ((dynamic-require "private/player-agent-gui.rkt"
+  ((dynamic-require "private-player-agent/player-agent-gui.rkt"
                     'run-player-agent-gui)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

private-player-agent/player-agent-config.rkt

@@ -85,6 +85,10 @@
     (ini-set! ini 'server 'url (player-agent-config-server-url value))
     (ini->file ini (player-agent-config-file value) #:private? #t)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module library.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (module+ test
   (require rackunit
            racket/file)

private-player-agent/player-agent-core.rkt

@@ -9,7 +9,7 @@
          racket/port
          racket/string
          simple-log
-         "translate.rkt")
+         "player-agent-translate.rkt")
 
 (provide (struct-out player-agent-runtime)
          make-player-agent-runtime)
@@ -23,21 +23,26 @@
 ; pre    : Constructor fields are lifecycle/query procedures and a stable ID.
 ; post   : Creating or recognizing a value changes no external state.
 ; result : player-agent-runtime? recognizes values returned by the factory.
-; internals:
+; internals: make-player-agent-runtime stores its local start!, reconnect!,
-;          Procedures keep the mutable audio and polling state private without
+;            shutdown!, snapshot and current-track procedures in this struct.
-;          introducing a class or a second generic backend abstraction.
+;            Those procedures retain access to the factory closure, keeping the
+;            shared polling and audio state private without introducing a class.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (struct player-agent-runtime
   (start! reconnect! shutdown! snapshot current-track running? app-id)
   #:transparent)
 
+;;; Normalizes a configured server address and converts it to a URL value.
 (define (base-url value)
   (string->url
    (regexp-replace #px"/+$" (string-trim value) "")))
 
+;;; Resolves an agent API path relative to a normalized server URL.
 (define (endpoint-url base path)
   (combine-url/relative (base-url base) path))
 
+;;; Posts JSON to an agent API endpoint and reads its JSON response.
+;;; Authorization failures receive a distinct exception for poll-loop.
 (define (post-json base path data)
   (let ((input
          (post-pure-port
@@ -61,12 +66,14 @@
           response))
       (λ () (close-input-port input)))))
 
+;;; Converts racket-audio states to the state names sent to the web player.
 (define (normal-state state)
   (cond
     ((memq state '(initialized no-media)) "stopped")
     ((eq? state 'transitioning) "starting")
     (else (symbol->string state))))
 
+;;; Deletes a temporary media file and logs recoverable deletion failures.
 (define (safe-delete-file file)
   (when (and file (file-exists? file))
     (with-handlers ((exn:fail?
@@ -88,10 +95,12 @@
 ; post   : Mutable state is initialized but no worker thread or audio backend
 ;          is started until the returned start! procedure is called.
 ; result : A player-agent-runtime containing its lifecycle/query procedures.
-; internals:
+; internals: start! launches poll-loop, which registers through post-json and
-;          One closure owns the simple mutable state shared by polling,
+;            sends snapshots until it receives a command. A command worker runs
-;          command and audio callbacks. Keeping these procedures together
+;            execute-command! and acknowledges it only after completion.
-;          makes their synchronization and cleanup order directly visible.
+;            ensure-audio! connects racket-audio callbacks to update-from-audio!
+;            and advance-at-decoder-eof!. with-agent-state protects their shared
+;            state; stop! and shutdown! stop threads, audio and cached files.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (make-player-agent-runtime initial-server-url
                                             initial-name
@@ -134,28 +143,36 @@
                   'volume logical-volume
                   'error 'null)))
 
+  ;;; Runs a procedure while holding the semaphore for shared agent state.
   (define (with-agent-state proc)
     (call-with-semaphore state-lock proc))
 
+  ;;; Replaces an unavailable state value with its JSON fallback.
   (define (state-value value fallback)
     (if (eq? value #f) fallback value))
 
+  ;;; Returns the latest audio state while holding the state semaphore.
   (define (snapshot)
     (with-agent-state (λ () agent-state)))
 
+  ;;; Returns the currently audible track while holding the state semaphore.
   (define (current-track)
     (with-agent-state (λ () current-track-value)))
 
+  ;;; Stores an error in the state reported by the next poll.
   (define (set-agent-error! message)
     (with-agent-state
      (λ ()
        (set! agent-state (hash-set agent-state 'error message)))))
 
+  ;;; Removes an earlier error from the state reported by the next poll.
   (define (clear-agent-error!)
     (with-agent-state
      (λ ()
        (set! agent-state (hash-set agent-state 'error 'null)))))
 
+  ;;; Copies racket-audio state into the agent snapshot.
+  ;;; It also confirms when a prefetched track has become audible.
   (define (update-from-audio! state full-state)
     (with-agent-state
      (λ ()
@@ -184,6 +201,8 @@
            (set! pending-auto-music-id #f)
            (set! ended-counter (+ ended-counter 1)))))))
 
+  ;;; Creates and configures the audio player on first use.
+  ;;; Its callbacks update reported state and continue prefetched playback.
   (define (ensure-audio!)
     (unless audio
       (set! audio
@@ -198,6 +217,8 @@
         (audio-volume! audio (* 100.0 scaled scaled))))
     audio)
 
+  ;;; Downloads one protected media resource to a temporary local file.
+  ;;; A failed download closes its port and removes its partial file.
   (define (download-media! token filename)
     (let* ((extension
             (or (path-get-extension (string->path filename)) #""))
@@ -219,9 +240,11 @@
         (close-input-port input)
         target)))
 
+  ;;; Selects the stable cache key carried by a playback command.
   (define (command-cache-key data)
     (hash-ref data 'cacheKey (hash-ref data 'mediaToken)))
 
+  ;;; Returns cached media or downloads and records it when absent.
   (define (ensure-media-cached! data)
     (let* ((key (command-cache-key data))
            (found (hash-ref cached-media key #f)))
@@ -234,14 +257,18 @@
             (hash-set! cached-media key downloaded)
             downloaded))))
 
+  ;;; Removes every cached media file except the entry identified by keep-key.
   (define (discard-unused-media! keep-key)
-    (for ((entry (in-list (hash->list cached-media))))
+    (let loop ((remaining (hash->list cached-media)))
+      (unless (null? remaining)
+        (let ((entry (car remaining)))
           (unless (equal? (car entry) keep-key)
             (safe-delete-file (cdr entry))
-        (hash-remove! cached-media (car entry)))))
+            (hash-remove! cached-media (car entry))))
+        (loop (cdr remaining)))))
 
-  ;; Decoder EOF occurs before audible EOF. Queueing the prefetched decoder at
+  ;;; Continues with prefetched media when the current decoder reaches EOF.
-  ;; this point appends it behind racket-audio's remaining output buffer.
+  ;;; Decoder EOF precedes audible EOF, so audio-play! queues behind the buffer.
   (define (advance-at-decoder-eof! handle)
     (let ((prepared
            (with-agent-state
@@ -279,6 +306,8 @@
          (with-agent-state
           (λ () (set! ended-counter (+ ended-counter 1))))))))
 
+  ;;; Applies one server command to audio, cache and reported agent state.
+  ;;; Play and prefetch commands also maintain gapless track bookkeeping.
   (define (execute-command! command)
     (let ((action (hash-ref command 'action ""))
           (data (hash-ref command 'data (hasheq))))
@@ -323,11 +352,14 @@
             (λ () (set! prefetched-track (cons data path))))
            (info-player-agent "Prefetched ~a"
                               (hash-ref data 'filename "track"))
-           (for ((entry (in-list (hash->list cached-media))))
+           (let loop ((remaining (hash->list cached-media)))
+             (unless (null? remaining)
+               (let ((entry (car remaining)))
                  (unless (or (equal? (car entry) current-media-key)
                              (equal? (car entry) key))
                    (safe-delete-file (cdr entry))
-               (hash-remove! cached-media (car entry))))))
+                   (hash-remove! cached-media (car entry))))
+               (loop (cdr remaining))))))
         ((string=? action "pause")
          (audio-pause! (ensure-audio!) #t))
         ((string=? action "resume")
@@ -353,6 +385,8 @@
         (else
          (error 'player-agent "unknown command: ~a" action)))))
 
+  ;;; Registers the agent and repeatedly exchanges state for server commands.
+  ;;; Connection and authorization failures are reported before a delayed retry.
   (define (poll-loop)
     (with-handlers
         ((exn:fail:agent-denied?
@@ -419,12 +453,14 @@
           (sleep 1)
           (loop)))))
 
+  ;;; Starts the polling worker once and reports the connecting state.
   (define (start!)
     (unless running
       (set! running #t)
       (status-callback (tr 'connecting))
       (set! worker (thread poll-loop))))
 
+  ;;; Stops polling and command workers and clears their lifecycle state.
   (define (stop!)
     (set! running #f)
     (when (and worker (not (thread-dead? worker)))
@@ -435,6 +471,7 @@
     (set! command-worker #f)
     (set! executing-command-id 0))
 
+  ;;; Restarts the runtime with a new normalized server address and name.
   (define (reconnect! new-server-url new-name)
     (stop!)
     (set! authorization-notified? #f)
@@ -442,14 +479,17 @@
     (set! assigned-name (string-trim new-name))
     (start!))
 
+  ;;; Stops the runtime, closes audio and removes all cached media files.
   (define (shutdown!)
     (stop!)
     (when audio
       (with-handlers ((exn:fail? void))
         (audio-quit! audio))
       (set! audio #f))
-    (for ((path (in-hash-values cached-media)))
+    (let loop ((paths (hash-values cached-media)))
-      (safe-delete-file path))
+      (unless (null? paths)
+        (safe-delete-file (car paths))
+        (loop (cdr paths))))
     (hash-clear! cached-media))
 
   (player-agent-runtime start!
@@ -459,3 +499,26 @@
                         current-track
                         (λ () running)
                         app-id)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module player-agent-core.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module+ test
+  (require rackunit)
+
+  (check-equal? (normal-state 'initialized) "stopped")
+  (check-equal? (normal-state 'transitioning) "starting")
+  (check-equal? (normal-state 'playing) "playing")
+
+  (let* ((app-id (make-string 64 #\a))
+         (runtime
+          (make-player-agent-runtime "http://127.0.0.1:1234"
+                                     "Test agent"
+                                     app-id)))
+    (check-false ((player-agent-runtime-running? runtime)))
+    (check-false ((player-agent-runtime-current-track runtime)))
+    (check-equal?
+     (hash-ref ((player-agent-runtime-snapshot runtime)) 'state)
+     "stopped")
+    (check-equal? (player-agent-runtime-app-id runtime) app-id)))

private-player-agent/player-agent-gui.rkt

@@ -11,7 +11,7 @@
          simple-log
          "player-agent-config.rkt"
          "player-agent-core.rkt"
-         "translate.rkt")
+         "player-agent-translate.rkt")
 
 (provide run-player-agent-gui)
 
@@ -405,6 +405,10 @@
     (send connect-button set-label (tr 'reconnect))
     frame))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module library.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (module+ test
   (require rackunit)
 

private-player-agent/player-agent-translate.rkt

@@ -335,6 +335,10 @@
 (define (__ id)
   (tr id))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module library.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (module+ test
   (require rackunit)
 

private/dlna-playback.rkt

@@ -43,81 +43,107 @@
    lock)
   #:transparent)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (define playback-start-timeout-ms 8000)
 
+;;; Returns the current time used to measure renderer start delays.
 (define (now-ms)
   (current-inexact-milliseconds))
 
+;;; Maps renderer-specific transport states to the web player's states.
 (define (normalize-state state)
   (cond
     ((eq? state 'transitioning) 'starting)
     ((member state '(initialized no-media)) 'stopped)
     (else state)))
 
+;;; Determines whether state or position confirms that playback has started.
 ;; 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)
+  (cond
-      (and (number? position) (> position 0))))
+    ((member state '(playing starting paused)) #t)
+    ((and (number? position) (> position 0)) #t)
+    (else #f)))
 
+;;; Runs a playback operation while holding its synchronization lock.
 (define (with-lock playback proc)
   (call-with-semaphore (dlna-playback-lock playback) proc))
 
+;;; Reads the current playlist through the callback supplied by the owner.
 (define (current-tracks playback)
   ((dlna-playback-tracks playback)))
 
+;;; Checks whether index identifies a track in the current playlist.
 (define (valid-index? playback index)
   (and (exact-nonnegative-integer? index)
        (< index (length (current-tracks playback)))))
 
+;;; Returns the track at index, or #f when the index is invalid.
 (define (track-at playback index)
-  (and (valid-index? playback index)
+  (if (valid-index? playback index)
-       (list-ref (current-tracks playback) index)))
+      (list-ref (current-tracks playback) index)
+      #f))
 
+;;; Produces a complete path string for stable renderer file comparison.
 (define (normalized-file file)
   (with-handlers ((exn:fail? (λ (_) (format "~a" file))))
     (path->string (path->complete-path file))))
 
+;;; Compares two track files using the path rules of the current platform.
 (define (same-file? first second)
-  (and first
+  (cond
-       second
+    ((eq? first #f) #f)
-       ((if (eq? (system-type 'os) 'windows)
+    ((eq? second #f) #f)
+    (else
+     (let ((same-path? (if (eq? (system-type 'os) 'windows)
                            string-ci=?
-            string=?)
+                           string=?)))
-        (normalized-file first)
+       (same-path? (normalized-file first)
-        (normalized-file second))))
+                   (normalized-file second))))))
 
+;;; Selects the following playlist index according to the repeat setting.
 (define (next-index playback index)
-  (define count (length (current-tracks playback)))
+  (let ((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)))
+      (else #f))))
 
+;;; Finds the playlist index represented by renderer metadata.
+;;; A prepared index is checked first before searching the complete playlist.
 (define (track-index-for-info playback info)
-  (define info-track (dlna-info-track info))
+  (let* ((info-track (dlna-info-track info))
-  (define file (and info-track (dlna-track-info-file info-track)))
+         (file (if (eq? info-track #f)
-  (define prepared (dlna-playback-prepared-index playback))
+                   #f
-  (cond
+                   (dlna-track-info-file info-track)))
-    ((and (valid-index? playback prepared)
+         (prepared (dlna-playback-prepared-index playback)))
+    (if (and (valid-index? playback prepared)
              (same-file? file (track-file (track-at playback prepared))))
-     prepared)
+        prepared
+        (let loop ((remaining (current-tracks playback))
+                   (index 0))
+          (cond
+            ((null? remaining) #f)
+            ((same-file? file (track-file (car remaining))) index)
             (else
-     (for/first ((item (in-list (current-tracks playback)))
+             (loop (cdr remaining) (add1 index))))))))
-                 (index (in-naturals))
-                 #:when (same-file? file (track-file item)))
-       index))))
 
+;;; Sends the current playback state and renderer information to the owner.
 (define (notify! playback state info)
   ((dlna-playback-update playback)
    state
    (dlna-playback-current-index playback)
    info))
 
+;;; Records a playback failure and forwards its detail to the error callback.
 (define (report-failure! playback detail)
   (set-dlna-playback-playing-seen?! playback #f)
   (set-dlna-playback-progress-seen?! playback #f)
@@ -126,12 +152,13 @@
   (set-dlna-playback-stopped-polls! playback 0)
   ((dlna-playback-error playback) detail))
 
+;;; Prepares the next track on renderers that support gapless continuation.
 (define (prepare-next! playback)
-  (define current (dlna-playback-current-index playback))
+  (let ((current (dlna-playback-current-index playback)))
     (when (valid-index? playback current)
-    (define following (next-index playback current))
+      (let ((following (next-index playback current)))
         (cond
-      ((not following)
+          ((eq? following #f)
            (set-dlna-playback-prepared-index! playback #f))
           ((not (equal? following (dlna-playback-prepared-index playback)))
            (with-handlers
@@ -144,10 +171,11 @@
              (dlna-player-set-next-file!
               (dlna-playback-player playback)
               (track-file (track-at playback following)))
-         (set-dlna-playback-prepared-index! playback following))))))
+             (set-dlna-playback-prepared-index! playback following))))))))
 
+;;; Starts one playlist item while the caller holds the playback lock.
 (define (play-index/locked! playback index)
-  (define item (track-at playback index))
+  (let ((item (track-at playback index)))
     (unless item
       (raise-arguments-error
        'dlna-playback-play-index!
@@ -159,7 +187,7 @@
             (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)))
+      (let ((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)
@@ -170,68 +198,89 @@
         (set-dlna-playback-stop-requested?! playback #f)
         (set-dlna-playback-stopped-polls! playback 0)
         (notify! playback 'starting info)
-    (prepare-next! playback)))
+        (prepare-next! playback)))))
 
+;;; Updates the current index when renderer metadata identifies another track.
 (define (update-current-track! playback info)
-  (define index (track-index-for-info playback info))
+  (let ((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)))
+      (prepare-next! playback))))
 
+;;; Advances to the next track or stops when the playlist has ended.
 (define (advance! playback)
-  (define current (dlna-playback-current-index playback))
+  (let* ((current (dlna-playback-current-index playback))
-  (define following (and (valid-index? playback current)
+         (following (if (valid-index? playback current)
-                         (next-index playback current)))
+                        (next-index playback current)
-  (if following
+                        #f)))
-      (play-index/locked! playback following)
+    (if (eq? following #f)
         (begin
           (dlna-player-stop! (dlna-playback-player playback))
           (notify! playback
                    'stopped
-                 (dlna-player-info (dlna-playback-player playback))))))
+                   (dlna-player-info (dlna-playback-player playback))))
+        (play-index/locked! playback following))))
 
-(define (poll/locked! playback)
+;;; Processes one successful renderer poll while the playback lock is held.
-  (define info (dlna-player-info (dlna-playback-player playback)))
+;;; It updates track identity, start confirmation and end-of-track handling.
-  (cond
+(define (poll-reachable/locked! playback info)
-    ((not (dlna-info-reachable? info))
+  (let ((state (normalize-state (dlna-info-state info)))
-     (when (dlna-playback-reachable? playback)
+        (uri (dlna-info-uri info))
-       (set-dlna-playback-reachable?! playback #f)
+        (position (dlna-info-position info)))
-       ((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))
-
+    (let* ((request-ms (dlna-playback-play-request-ms playback))
-     (when (and (dlna-playback-playing-seen? playback)
+           (elapsed-ms (if (eq? request-ms #f)
+                           #f
+                           (- (now-ms) request-ms)))
+           (failed-now?
+            (and (dlna-playback-playing-seen? playback)
                  (not (dlna-playback-progress-seen? playback))
-                (dlna-playback-play-request-ms playback)
+                 elapsed-ms
-                (>= (- (now-ms)
+                 (>= elapsed-ms playback-start-timeout-ms))))
-                       (dlna-playback-play-request-ms playback))
+      ;;; Handles a stopped renderer after start and progress checks complete.
-                    playback-start-timeout-ms))
+      (define (handle-stopped!)
-       (set! failed-now? #t)
+        (cond
+          ((and (not (dlna-playback-progress-seen? playback))
+                elapsed-ms
+                (< elapsed-ms 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
+            'dlna-renderer-no-start-of-track-confirmation))
+          (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 next poll.
+           (when (or (eq? (dlna-playback-prepared-index playback) #f)
+                     (> (dlna-playback-stopped-polls playback) 1))
+             (set-dlna-playback-playing-seen?! playback #f)
+             (set-dlna-playback-stopped-polls! playback 0)
+             (advance! playback)))))
+      (when failed-now?
         (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"))
+         'dlna-renderer-no-start-of-track-confirmation))
-
       (unless (or failed-now? (dlna-playback-failure-active? playback))
         (cond
           ((eq? state 'playing)
@@ -243,42 +292,29 @@
            (set-dlna-playback-stopped-polls! playback 0))
           ((and (eq? state 'stopped)
                 (dlna-playback-playing-seen? playback))
-          (cond
+           (handle-stopped!))))
-            ((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)
+         ((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))))
 
+;;; Polls the renderer and reports a transition to an unreachable state once.
+(define (poll/locked! playback)
+  (let ((info (dlna-player-info (dlna-playback-player playback))))
+    (if (dlna-info-reachable? info)
+        (poll-reachable/locked! playback info)
+        (when (dlna-playback-reachable? playback)
+          (set-dlna-playback-reachable?! playback #f)
+          ((dlna-playback-error playback)
+           'dlna-renderer-unreachable)))))
+
+;;; Polls the renderer until playback is closed, logging recoverable failures.
 (define (monitor-loop playback poll-seconds)
   (let loop ()
     (when (dlna-playback-running? playback)
@@ -293,12 +329,21 @@
           (with-lock playback (λ () (poll/locked! playback))))
         (loop)))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Create playlist-aware playback for one network renderer.
 ; pre    : Device is a media renderer, callbacks are procedures, and
 ;          media-server is a running shared media-file-server.
 ; post   : A DLNA player and its state-monitor thread are running.
 ; result : A playback adapter that publishes through the supplied server.
+; internals: make-dlna-player creates the renderer interface; monitor-loop polls
+;            it periodically. poll/locked! reconciles URI, transport state and
+;            position with the playlist and reports updates, failures or track
+;            advancement. with-lock orders polls and commands using the
+;            dlna-playback-lock accessor generated for the struct's lock field.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (make-dlna-playback device
                             tracks
@@ -306,21 +351,34 @@
                             error
                             #:media-file-server media-server
                             #:poll-seconds [poll-seconds 1])
-  (define raw
+  (let* ((raw (make-dlna-player device
-    (make-dlna-player device
                                 #:media-file-server media-server))
-  (define playback
+         (playback
           (dlna-playback raw tracks update error 'off #f #f #f
                          #f #f #f #f 0 #f #t #t #f
-                   (make-semaphore 1)))
+                         (make-semaphore 1))))
     (set-dlna-playback-monitor!
      playback
      (thread (λ () (monitor-loop playback poll-seconds))))
-  playback)
+    playback))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Start the track at index in the current playlist.
+; pre    : Playback is open and index identifies an existing track.
+; post   : The renderer starts the track and the next track is prepared.
+; result : The result of the synchronized playback operation.
+; internals: Playback state changes and callbacks run while holding the lock.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-playback-play-index! playback index)
   (with-lock playback (λ () (play-index/locked! playback index))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Pause the current renderer transport.
+; pre    : Playback is open and the renderer accepts pause requests.
+; post   : The renderer is paused and listeners receive the new state.
+; result : The result of the synchronized playback operation.
+; internals: The renderer is queried immediately after the pause request.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-playback-pause! playback)
   (with-lock
    playback
@@ -328,6 +386,13 @@
      (dlna-player-pause! (dlna-playback-player playback))
      (notify! playback 'paused (dlna-player-info (dlna-playback-player playback))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Resume the paused renderer transport.
+; pre    : Playback is open and the renderer accepts resume requests.
+; post   : The renderer is playing and listeners receive the new state.
+; result : The result of the synchronized playback operation.
+; internals: The renderer is queried immediately after the resume request.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-playback-resume! playback)
   (with-lock
    playback
@@ -335,6 +400,13 @@
      (dlna-player-resume! (dlna-playback-player playback))
      (notify! playback 'playing (dlna-player-info (dlna-playback-player playback))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Stop the current renderer transport.
+; pre    : Playback is open.
+; post   : Pending start and failure state is cleared and listeners see stopped.
+; result : The result of the synchronized playback operation.
+; internals: stop-requested? distinguishes this stop from a finished track.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-playback-stop! playback)
   (with-lock
    playback
@@ -348,6 +420,13 @@
      (dlna-player-stop! (dlna-playback-player playback))
      (notify! playback 'stopped (dlna-player-info (dlna-playback-player playback))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Seek to a percentage of the current track.
+; pre    : Playback is open and percentage is accepted by the DLNA player.
+; post   : The renderer position and listener state reflect the requested seek.
+; result : The result of the synchronized playback operation.
+; internals: The synchronously refreshed DLNA cache is published immediately.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-playback-seek-percentage! playback percentage)
   (with-lock
    playback
@@ -355,21 +434,35 @@
      (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)))
+     (let ((info (dlna-player-info (dlna-playback-player playback))))
        (notify! playback
                 (normalize-state (dlna-info-state info))
-              info))))
+                info)))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Set the renderer volume to a percentage.
+; pre    : Playback is open and percentage is accepted by the DLNA player.
+; post   : The renderer volume and listener state reflect the requested value.
+; result : The result of the synchronized playback operation.
+; internals: The renderer is queried immediately after changing the volume.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-playback-volume! playback percentage)
   (with-lock
    playback
    (λ ()
      (dlna-player-volume! (dlna-playback-player playback) percentage)
-     (define info (dlna-player-info (dlna-playback-player playback)))
+     (let ((info (dlna-player-info (dlna-playback-player playback))))
        (notify! playback
                 (normalize-state (dlna-info-state info))
-              info))))
+                info)))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Change playlist repeat behavior.
+; pre    : Playback is open and repeat is 'off, 'one or 'all.
+; post   : The next prepared track reflects the new repeat behavior.
+; result : The result of the synchronized playback operation.
+; internals: Any previously prepared index is discarded before recalculation.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-playback-repeat! playback repeat)
   (with-lock
    playback
@@ -378,17 +471,28 @@
      (set-dlna-playback-prepared-index! playback #f)
      (prepare-next! playback))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Close playback and release its renderer resources.
+; pre    : Playback was created by make-dlna-playback.
+; post   : The monitor has stopped and the underlying DLNA player is closed.
+; result : Void.
+; internals: The running flag prevents repeated closure of the same player.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-playback-close! playback)
   (when (dlna-playback-running? playback)
     (set-dlna-playback-running?! playback #f)
-    (define monitor (dlna-playback-monitor playback))
+    (let ((monitor (dlna-playback-monitor playback)))
       (when (and monitor (not (thread-dead? monitor)))
         (kill-thread monitor))
       (set-dlna-playback-monitor! playback #f)
       (with-lock
        playback
        (λ ()
-       (dlna-player-close! (dlna-playback-player playback))))))
+         (dlna-player-close! (dlna-playback-player playback)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module dlna-playback.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (module+ test
   (require rackunit)
@@ -411,17 +515,21 @@
   (set-dlna-playback-repeat! playback 'one)
   (check-equal? (next-index playback 1) 1)
 
-  (set-dlna-playback-prepared-index! playback 1)
+  (let ((second-info
-  (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))
+          #f #f 1 60 25 #f #t)))
-   1)
+    (set-dlna-playback-prepared-index! playback 1)
+    (check-equal? (track-index-for-info playback second-info) 1)
+    (set-dlna-playback-prepared-index! playback #f)
+    (check-equal? (track-index-for-info playback second-info) 1)
+    (check-false
+     (track-index-for-info
+      playback
+      (struct-copy dlna-info second-info (track #f)))))
   (check-eq? (normalize-state 'transitioning) 'starting)
   (check-eq? (normalize-state 'no-media) 'stopped)
   (check-true (renderer-confirms-playback? 'playing #f))

private/library.rkt

@@ -45,19 +45,25 @@
     "folder.jpg" "folder.jpeg" "folder.png"
     "front.jpg" "front.jpeg" "front.png"))
 
+;;; Checks whether a path has an extension supported by racket-audio.
 (define (audio-file? file)
   (let ((extension (path-get-extension file)))
-    (and extension
+    (if (eq? extension #f)
-         (member (string-downcase
+        #f
+        (let ((extension-name
+               (string-downcase
                 (string-trim
                  (bytes->string/utf-8 extension)
-                   "."))
+                 "."))))
-                 supported-extensions)
+          (if (member extension-name supported-extensions)
-         #t)))
+              #t
+              #f)))))
 
+;;; Checks whether the final path element starts with a dot.
 (define (hidden-name? path)
   (string-prefix? (path->string path) "."))
 
+;;; Derives a fallback track title from the file name without its extension.
 (define (file-title file)
   (let* ((name (file-name-from-path file))
          (without-extension
@@ -66,12 +72,15 @@
               file)))
     (path->string without-extension)))
 
+;;; Returns a non-empty string value or the supplied fallback.
 (define (nonempty value fallback)
   (if (and (string? value)
            (not (string=? (string-trim value) "")))
       value
       fallback))
 
+;;; Reads audio metadata and converts a file path to a track value.
+;;; File-name and MIME-type fallbacks are used when metadata cannot be read.
 (define (path->track file)
   (let ((fallback-title (file-title file)))
     (with-handlers
@@ -95,6 +104,7 @@
              (track file fallback-title "" "" #f
                     (mimetype-for-ext file))))))))
 
+;;; Builds the filesystem path represented by a library-relative path.
 (define (library-path library relative-path)
   (if (null? relative-path)
       (music-library-root library)
@@ -102,6 +112,7 @@
              (music-library-root library)
              relative-path)))
 
+;;; Classifies a path as a container, supported track or unusable entry.
 (define (path-kind path)
   (cond
     ((directory-exists? path) 'container)
@@ -110,6 +121,7 @@
      'track)
     (else #f)))
 
+;;; Orders browser entries with containers first and names alphabetically.
 (define (entry<? first second)
   (cond
     ((and (eq? (browser-entry-kind first) 'container)
@@ -122,6 +134,7 @@
      (string-ci<? (browser-entry-name first)
                   (browser-entry-name second)))))
 
+;;; Recursively converts the browsable contents of a directory to tracks.
 (define (directory-tracks library relative-path)
   (append-map
    (λ (entry)
@@ -134,126 +147,196 @@
                          (browser-entry-relative-path entry))))))
    (browse-library library relative-path)))
 
-(define (library-contains-audio-file? libraries file)
+;;; Produces a resolved complete path, or #f when resolution fails.
-  (and (path-string? file)
+(define (complete-path/safe path)
-       (file-exists? file)
-       (audio-file? file)
-       (let ((full-file
   (with-handlers ((exn:fail? (λ (_) #f)))
-                (simplify-path (path->complete-path file) #t))))
+    (simplify-path (path->complete-path path) #t)))
-         (and full-file
+
-              (for/or ((library (in-list libraries)))
+;;; Checks whether file is located below root without traversing upward.
-                (define root
+(define (path-below-root? root file)
-                  (with-handlers ((exn:fail? (λ (_) #f)))
+  (let* ((relative (find-relative-path root file))
-                    (simplify-path
+         (elements (explode-path relative)))
-                     (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)))))))))))
+         (not (member 'up elements)))))
+
+;;; Recognizes a library specification containing a display name and path.
+(define (named-library-specification? specification)
+  (and (list? specification)
+       (= (length specification) 2)
+       (string? (car specification))
+       (path-string? (cadr specification))))
+
+;;; Extracts the optional display name and path from a library specification.
+(define (specification-values specification)
+  (cond
+    ((named-library-specification? specification)
+     (values (string-trim (car specification))
+             (cadr specification)))
+    ((path-string? specification)
+     (values #f specification))
+    (else
+     (raise-argument-error
+      'make-music-libraries
+      "(or/c path-string? (list/c string? path-string?))"
+      specification))))
+
+;;; Reads embedded ID3 artwork from a track, returning #f when unavailable.
+(define (embedded-artwork item)
+  (with-handlers ((exn:fail? (λ (_) #f)))
+    (call-with-id3-tags
+     (track-file item)
+     (λ (tags)
+       (if (not (tags-valid? tags))
+           #f
+           (let ((picture (tags-picture tags)))
+             (if (eq? picture #f)
+                 #f
+                 (let ((mime (id3-picture-mimetype picture)))
+                   (artwork
+                    (if (and (string? mime)
+                             (not (string=? mime "")))
+                        mime
+                        "application/octet-stream")
+                    (id3-picture-bytes picture))))))))))
+
+;;; Checks whether a path names an existing conventional cover image.
+(define (cover-file? candidate)
+  (let ((name (file-name-from-path candidate)))
+    (cond
+      ((eq? name #f) #f)
+      ((not (file-exists? candidate)) #f)
+      ((member (path->string name)
+               cover-file-names
+               string-ci=?) #t)
+      (else #f))))
+
+;;; Searches the track directory for a conventional cover image.
+(define (cover-artwork item)
+  (with-handlers ((exn:fail? (λ (_) #f)))
+    (let* ((track-directory (path-only (track-file item)))
+           (directory (if (eq? track-directory #f)
+                          (current-directory)
+                          track-directory))
+           (cover (findf cover-file?
+                         (directory-list directory #:build? #t))))
+      (if (eq? cover #f)
+          #f
+          (let ((mime (mimetype-for-ext cover)))
+            (artwork (if (string? mime)
+                         mime
+                         "application/octet-stream")
+                     (file->bytes cover)))))))
+
+;;; Validates one normalized library root and constructs its public value.
+(define (named-root->music-library named-root index)
+  (let ((configured-name (car named-root))
+        (root (cadr named-root)))
+    (unless (directory-exists? root)
+      (raise-arguments-error
+       'make-music-libraries
+       "music library is not an existing directory"
+       "path" root))
+    (let* ((name (file-name-from-path root))
+           (default-name (if (eq? name #f)
+                             (path->string root)
+                             (path->string name))))
+      (music-library
+       (format "library-~a" index)
+       (cond
+         ((eq? configured-name #f) default-name)
+         ((string=? configured-name "") default-name)
+         (else configured-name))
+       root))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Provided functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Check whether a supported audio file belongs to a music library.
+; pre    : Libraries contains music-library values; file may be any value.
+; post   : The file system remains unchanged.
+; result : #t when file exists below a configured root, otherwise #f.
+; internals: audio-file? first rejects unsupported files. complete-path/safe
+;            resolves the candidate and each library root. The named loop calls
+;            path-below-root? until one root contains the file; that helper uses
+;            find-relative-path and rejects paths containing an 'up element.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (library-contains-audio-file? libraries file)
+  (cond
+    ((not (path-string? file)) #f)
+    ((not (file-exists? file)) #f)
+    ((not (audio-file? file)) #f)
+    (else
+     (let ((full-file (complete-path/safe file)))
+       (if (eq? full-file #f)
+           #f
+           (let loop ((remaining libraries))
+             (if (null? remaining)
+                 #f
+                 (let ((root
+                        (complete-path/safe
+                         (music-library-root (car remaining)))))
+                   (cond
+                     ((eq? root #f)
+                      (loop (cdr remaining)))
+                     ((path-below-root? root full-file) #t)
+                     (else
+                      (loop (cdr remaining))))))))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Turn configured directory paths into music libraries.
 ; pre    : Every value is a path or a (display-name path) list.
 ; post   : No directory contents or audio metadata have been read.
 ; result : Libraries in configuration order, without duplicate roots.
+; internals: specification-values separates each optional name from its path.
+;            map normalizes the paths and remove-duplicates compares their
+;            roots. The named loop calls named-root->music-library to validate
+;            each directory and assign its sequential library id.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (make-music-libraries specifications)
-  (define (specification-values specification)
-    (if (and (list? specification)
-             (= (length specification) 2)
-             (string? (car specification))
-             (path-string? (cadr specification)))
-        (values (string-trim (car specification))
-                (cadr specification))
-        (if (path-string? specification)
-            (values #f specification)
-            (raise-argument-error
-             'make-music-libraries
-             "(or/c path-string? (list/c string? path-string?))"
-             specification))))
   (let ((roots
          (remove-duplicates
-          (for/list ((specification (in-list specifications)))
+          (map (λ (specification)
                  (let-values (((name path)
                                (specification-values specification)))
                    (list name
                          (normal-case-path
                           (path->complete-path path)))))
+               specifications)
           (λ (first second)
             (equal? (cadr first) (cadr second))))))
-    (for/list ((named-root (in-list roots))
+    (let loop ((remaining roots)
-               (index (in-naturals)))
+               (index 0))
-      (define configured-name (car named-root))
+      (if (null? remaining)
-      (define root (cadr named-root))
+          '()
-      (unless (directory-exists? root)
+          (cons (named-root->music-library (car remaining) index)
-        (raise-arguments-error
+                (loop (cdr remaining) (add1 index)))))))
-         'make-music-libraries
-         "music library is not an existing directory"
-         "path" root))
-      (let ((name (file-name-from-path root)))
-        (music-library
-         (format "library-~a" index)
-         (if (and configured-name
-                  (not (string=? configured-name "")))
-             configured-name
-             (if name
-                 (path->string name)
-                 (path->string root)))
-         root)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Read the artwork associated with a track.
 ; pre    : Item names a local audio file.
 ; post   : The audio file and optional neighbouring image remain unchanged.
 ; result : Embedded artwork, a conventional folder cover, or #f.
+; internals: embedded-artwork first reads the picture stored in the audio tags.
+;            Only when that returns #f does cover-artwork search the track's
+;            directory for one of the names in cover-file-names.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (track-artwork item)
-  (define embedded
+  (let ((embedded (embedded-artwork item)))
-    (with-handlers ((exn:fail? (λ (_) #f)))
+    (if (eq? embedded #f)
-      (call-with-id3-tags
+        (cover-artwork item)
-       (track-file item)
+        embedded)))
-       (λ (tags)
-         (let ((picture (and (tags-valid? tags)
-                             (tags-picture tags))))
-           (and picture
-                (artwork (let ((mime (id3-picture-mimetype picture)))
-                           (if (and (string? mime)
-                                    (not (string=? mime "")))
-                               mime
-                               "application/octet-stream"))
-                         (id3-picture-bytes picture))))))))
-  (or embedded
-      (with-handlers ((exn:fail? (λ (_) #f)))
-        (let* ((directory (or (path-only (track-file item))
-                              (current-directory)))
-               (cover
-                (findf
-                 (λ (candidate)
-                   (let ((name (file-name-from-path candidate)))
-                     (and name
-                          (file-exists? candidate)
-                          (member (path->string name)
-                                  cover-file-names
-                                  string-ci=?))))
-                 (directory-list directory #:build? #t))))
-          (and cover
-               (let ((mime (mimetype-for-ext cover)))
-                 (artwork (if (string? mime)
-                              mime
-                              "application/octet-stream")
-                          (file->bytes cover))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : List the immediate folders and supported audio files in a library.
 ; pre    : Relative-path was produced by a previous browse result.
 ; post   : Child directories are listed before tracks; metadata is not read.
 ; result : Browser entries for one directory level.
+; internals: library-path resolves the requested directory. directory-list and
+;            path-kind supply filter-map with usable children; hidden-name?
+;            removes hidden containers. sort uses entry<? to put containers
+;            first and compare names without regard to case.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (browse-library library relative-path)
   (let ((path (library-path library relative-path)))
@@ -267,13 +350,20 @@
       (λ (name)
         (let* ((full-path (build-path path name))
                (kind (path-kind full-path)))
-          (and kind
+          (cond
-               (not (and (eq? kind 'container)
+            ((eq? kind #f) #f)
-                         (hidden-name? name)))
+            ((eq? kind 'container)
+             (if (hidden-name? name)
+                 #f
                  (browser-entry
                   (path->string name)
                   kind
-                (append relative-path (list name))))))
+                  (append relative-path (list name)))))
+            (else
+             (browser-entry
+              (path->string name)
+              kind
+              (append relative-path (list name)))))))
       (directory-list path))
      entry<?)))
 
@@ -282,6 +372,9 @@
 ; pre    : Entry belongs to library and was produced by browse-library.
 ; post   : Track metadata is read; containers are traversed recursively.
 ; result : One track, or all supported tracks below the selected container.
+; internals: A track entry is resolved by library-path and read by path->track.
+;            A container is passed to directory-tracks, which recursively calls
+;            browse-library and path->track in browser sort order.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (browser-entry->tracks library entry)
   (if (eq? (browser-entry-kind entry) 'container)
@@ -292,18 +385,30 @@
         (library-path library
                       (browser-entry-relative-path entry))))))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module library.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (module+ test
   (require rackunit)
 
   (define root
     (make-temporary-file "rkt-web-library-~a" 'directory))
 
+  (define outside-file
+    (make-temporary-file "rkt-web-outside-~a.mp3"))
+
   (dynamic-wind
     void
     (λ ()
       (make-directory (build-path root "Album"))
+      (make-directory (build-path root ".Hidden"))
+      (call-with-output-file
+       (build-path root "Album" "inside.mp3") void)
       (call-with-output-file (build-path root "track.mp3") void)
       (call-with-output-file (build-path root "cover.jpg") void)
+      (call-with-output-file (build-path root "ignored.txt") void)
       (let* ((libraries (make-music-libraries (list root)))
              (entries (browse-library (car libraries) '())))
         (check-equal? (length libraries) 1)
@@ -312,6 +417,29 @@
         (check-eq? (browser-entry-kind (car entries)) 'container)
         (check-equal? (browser-entry-name (cadr entries)) "track.mp3")
         (check-eq? (browser-entry-kind (cadr entries)) 'track)
+        (check-equal?
+         (length
+          (browser-entry->tracks (car libraries) (car entries)))
+         1)
+        (check-true
+         (library-contains-audio-file?
+          libraries
+          (build-path root "track.mp3")))
+        (check-true
+         (library-contains-audio-file?
+          libraries
+          (build-path root "Album" "inside.mp3")))
+        (check-false
+         (library-contains-audio-file?
+          libraries
+          (build-path root "cover.jpg")))
+        (check-false
+         (library-contains-audio-file?
+          libraries
+          outside-file))
+        (check-equal?
+         (length (make-music-libraries (list root root)))
+         1)
         (check-equal?
          (music-library-name
           (car (make-music-libraries
@@ -324,4 +452,5 @@
                   "Track" "" "" #f "audio/mpeg")))
          "image/jpeg")))
     (λ ()
-      (delete-directory/files root))))
+      (delete-directory/files root)
+      (delete-file outside-file))))

private/player.rkt

@@ -15,7 +15,8 @@
          "library.rkt"
          "playlists.rkt")
 
-(provide make-player
+(provide player?
+         make-player
          player-state->jsexpr
          player-command!
          player-discover!
@@ -76,6 +77,16 @@
   local-music-indexes)
   #:transparent)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Hold the shared libraries, playback sessions, outputs and UI state.
+; pre    : make-player supplies all fields and owns construction of the value.
+; post   : Creating or recognizing a player does not start an HTTP server.
+; result : player? recognizes values accepted by the internal server API.
+; internals: make-player initializes the state and command locks, playlist
+;            contexts and playback sessions. player-command! mutates that
+;            state, player-state->jsexpr reads it, and player-close! releases
+;            the owned playback and persistence resources.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (struct player
   (libraries
    allowed-agent-ids
@@ -373,6 +384,13 @@
    (λ ()
      (set-playback-session-error! session message))))
 
+;;; Converts an internal error value to a JSON-compatible message or key.
+(define (error->jsexpr error)
+  (cond
+    ((eq? error #f) 'null)
+    ((symbol? error) (symbol->string error))
+    (else error)))
+
 (define (clear-session-error! value session)
   (set-session-error! value session #f))
 
@@ -1372,9 +1390,9 @@
         'volume (playback-session-volume session)
         'repeat (symbol->string (playback-session-repeat session))
         'discovering (player-discovering? value)
-        'error (or (playback-session-error session)
+        'error (error->jsexpr
-                   (player-error value)
+                (or (playback-session-error session)
-                   'null))))))))
+                    (player-error value))))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Execute one browser player command.
@@ -1722,6 +1740,12 @@
   (require rackunit
            racket/file)
 
+  (check-equal? (error->jsexpr #f) 'null)
+  (check-equal?
+   (error->jsexpr 'dlna-renderer-unreachable)
+   "dlna-renderer-unreachable")
+  (check-equal? (error->jsexpr "technical error") "technical error")
+
   (define root
     (make-temporary-file "rkt-web-player-~a" 'directory))
 

private/playlists.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require keystore
+         racket/contract
          racket/file
          racket/list
          racket/path
@@ -15,18 +16,32 @@
          load-user-language
          save-user-language!)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Represent one named playlist tab in durable player state.
+; pre    : Id is a UUID string, name is non-empty, and tracks contains tracks.
+; post   : Constructing or inspecting a value changes no external state.
+; result : persisted-tab? recognizes stored and restored playlist tabs.
+; internals: track->datum serializes the tracks and datum->tab reconstructs
+;            this value after validating its id, name and track collection.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (struct persisted-tab (id name tracks) #:transparent)
-(struct playlist-store (keystore lock) #:transparent)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Produces the keystore key containing one user's ordered playlist ids.
 (define (user-playlists-key username)
   (format "playlists-for-~a" username))
 
+;;; Produces the keystore key containing one user's language preference.
 (define (user-language-key username)
   (format "language-for-~a" username))
 
 (define supported-language-names
   '("en" "nl" "de" "fr" "es" "it" "sv" "no" "fi" "is"))
 
+;;; Serializes a track without exposing the track struct to the keystore.
 (define (track->datum item)
   (hasheq 'file (path->string (track-file item))
           'title (track-title item)
@@ -35,111 +50,177 @@
           'duration (or (track-duration item) #f)
           'mime-type (or (track-mime-type item) #f)))
 
+;;; Checks whether a stored optional value is #f or a string.
 (define (optional-string? value)
-  (or (not value) (string? value)))
+  (or (eq? value #f) (string? value)))
 
+;;; Validates and restores one stored track.
+;;; Files outside the configured libraries are deliberately rejected.
 (define (datum->track value libraries)
-  (and (hash? value)
+  (if (not (hash? value))
-       (let ((file (hash-ref value 'file #f))
+      #f
+      (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)))
+             (mime-type (hash-ref value 'mime-type #f))
+             (valid-duration?
+              (or (eq? duration #f)
+                  (and (number? duration)
+                       (not (negative? duration)))))
+             (valid-metadata?
               (and (path-string? file)
                    (string? title)
                    (string? artist)
                    (string? album)
-              (or (not duration)
+                   valid-duration?
-                  (and (number? duration) (not (negative? duration))))
+                   (optional-string? mime-type))))
-              (optional-string? mime-type)
+        (if (and valid-metadata?
-              (library-contains-audio-file? libraries file)
+                 (library-contains-audio-file? libraries file))
             (track (path->complete-path file)
-                     title artist album duration mime-type)))))
+                   title artist album duration mime-type)
+            #f))))
 
+;;; Validates and restores one tab while discarding invalid track entries.
 (define (datum->tab id value libraries)
-  (and (uuid-string? id)
+  (if (not (and (uuid-string? id) (hash? value)))
-       (hash? value)
+      #f
       (let ((name (hash-ref value 'name #f))
             (tracks (hash-ref value 'tracks #f)))
-         (and (string? name)
+        (if (and (string? name)
                  (not (string=? name ""))
-              (list? tracks)
+                 (list? tracks))
             (persisted-tab
              id
              name
              (filter-map
               (λ (item) (datum->track item libraries))
-                tracks))))))
+              tracks))
+            #f))))
 
-(define (open-playlist-store file)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  (and file
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Open the durable store used for playlists and user preferences.
+; pre    : File is #f or a writable keystore path.
+; post   : The parent directory and keystore exist when file is provided.
+; result : An open keystore handle, or #f when persistence is disabled.
+; internals: path->complete-path fixes the storage location, ks-open creates or
+;            opens the keystore, and later operations use the lock belonging to
+;            the returned handle.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define/contract (open-playlist-store file)
+  (-> (or/c path-string? #f) (or/c keystore? #f))
+  (if (eq? file #f)
+      #f
       (let ((target (path->complete-path file)))
         (make-parent-directory* target)
-         (playlist-store (ks-open target) (make-semaphore 1)))))
+        (ks-open target))))
 
-(define (close-playlist-store! store)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Close an open playlist store.
+; pre    : Store is #f or was returned by open-playlist-store.
+; post   : Its keystore handle is closed; #f remains a harmless no-op.
+; result : Void.
+; internals: ks-with-lock uses the lock belonging to the keystore handle and
+;            prevents ks-close from overlapping a load or save operation.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define/contract (close-playlist-store! store)
+  (-> (or/c keystore? #f) void?)
   (when store
-    (call-with-semaphore
+    (ks-with-lock store (λ () (ks-close store))))
-     (playlist-store-lock store)
-     (λ () (ks-close (playlist-store-keystore store)))))
   (void))
 
-(define (load-user-playlists store username libraries)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  (if (not store)
+; goal   : Restore one user's ordered playlist tabs.
+; pre    : Store is #f or open, username is normalized, and libraries are valid.
+; post   : Store contents remain unchanged and unsafe track paths are omitted.
+; result : Valid persisted-tab values in their saved order.
+; internals: ks-with-lock serializes the index and tab reads on the keystore
+;            handle. user-playlists-key locates the UUID index; datum->tab then
+;            validates each referenced tab and delegates track safety checks to
+;            datum->track.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define/contract (load-user-playlists store username libraries)
+  (-> (or/c keystore? #f)
+      string?
+      (listof music-library?)
+      (listof persisted-tab?))
+  (if (eq? store #f)
       '()
-      (call-with-semaphore
+      (ks-with-lock
-       (playlist-store-lock store)
+       store
        (λ ()
-         (define ks (playlist-store-keystore store))
+         (let ((ids (ks-get store (user-playlists-key username) '())))
-         (define ids (ks-get ks (user-playlists-key username) '()))
            (if (list? ids)
                (filter-map
                 (λ (id)
-                (datum->tab id (ks-get ks id #f) libraries))
+                  (datum->tab id (ks-get store id #f) libraries))
                 (remove-duplicates (filter uuid-string? ids) string=?))
-             '())))))
+               '()))))))
 
-(define (save-user-playlists! store username tabs)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Persist one user's complete ordered collection of playlist tabs.
+; pre    : Store is #f or open, username is normalized, and tabs are valid.
+; post   : The UUID index and tab data match tabs; omitted old tabs are removed.
+; result : Void.
+; internals: ks-with-lock prevents another operation from entering this update.
+;            ks-transaction removes stale ids from user-playlists-key, stores
+;            every tab using track->datum, and atomically replaces the index.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define/contract (save-user-playlists! store username tabs)
+  (-> (or/c keystore? #f) string? (listof persisted-tab?) void?)
   (when store
-    (call-with-semaphore
+    (ks-with-lock
-     (playlist-store-lock store)
+     store
      (λ ()
-       (define ks (playlist-store-keystore store))
+       (let* ((index-key (user-playlists-key username))
-       (define index-key (user-playlists-key username))
+              (old-ids (ks-get store index-key '()))
-       (define old-ids (ks-get ks index-key '()))
+              (ids (map persisted-tab-id tabs))
-       (define ids (map persisted-tab-id tabs))
+              (stale-ids
+               (filter
+                (λ (id)
+                  (and (string? id)
+                       (not (member id ids string=?))))
+                (if (list? old-ids) old-ids '()))))
          (ks-transaction
-        ks
+          store
-        (for ((id (in-list (if (list? old-ids) old-ids '())))
+          (for-each (λ (id) (ks-drop! store id)) stale-ids)
-              #:when (and (string? id) (not (member id ids string=?))))
+          (for-each
-          (ks-drop! ks id))
+           (λ (tab)
-        (for ((tab (in-list tabs)))
              (ks-set!
-           ks
+              store
               (persisted-tab-id tab)
               (hasheq 'name (persisted-tab-name tab)
                       'tracks (map track->datum
                                    (persisted-tab-tracks tab)))))
-        (ks-set! ks index-key ids))
+           tabs)
+          (ks-set! store index-key ids))
          (void)))))
+  (void))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Load one user's persisted interface language.
 ; pre    : Store is #f or an open playlist store; username is normalized.
 ; post   : Store contents remain unchanged.
 ; result : A supported ISO language name, or #f when none was saved.
+; internals: user-language-key selects the keystore entry while ks-with-lock
+;            holds the handle's lock. Only supported language names return.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (load-user-language store username)
+(define/contract (load-user-language store username)
-  (and store
+  (-> (or/c keystore? #f) string? (or/c string? #f))
-       (call-with-semaphore
+  (if (eq? store #f)
-        (playlist-store-lock store)
+      #f
+      (ks-with-lock
+       store
        (λ ()
-          (define value
+         (let ((value (ks-get store (user-language-key username) #f)))
-            (ks-get (playlist-store-keystore store)
+           (if (member value supported-language-names)
-                    (user-language-key username)
+               value
-                    #f))
+               #f))))))
-          (and (member value supported-language-names) value)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Persist one user's interface language.
@@ -147,22 +228,27 @@
 ;          en, nl, de, fr, es, it, sv, no, fi, or is.
 ; post   : The user's language key contains language when a store exists.
 ; result : Void.
+; internals: Validation precedes persistence. user-language-key identifies the
+;            entry and ks-with-lock serializes the ks-set! call on the handle.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (save-user-language! store username language)
+(define/contract (save-user-language! store username language)
+  (-> (or/c keystore? #f) string? string? void?)
   (unless (member language supported-language-names)
     (raise-argument-error
      'save-user-language!
      "one of en, nl, de, fr, es, it, sv, no, fi, or is"
      language))
   (when store
-    (call-with-semaphore
+    (ks-with-lock
-     (playlist-store-lock store)
+     store
      (λ ()
-       (ks-set! (playlist-store-keystore store)
+       (ks-set! store (user-language-key username) language))))
-                (user-language-key username)
-                language))))
   (void))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module playlists.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (module+ test
   (require rackunit
            uuid/random)
@@ -173,6 +259,11 @@
   (define music-two (build-path root "music-two"))
   (define outside (build-path root "outside.flac"))
   (define store-file (build-path root "data" "playlists.keystore"))
+
+  (check-false (open-playlist-store #f))
+  (check-equal? (load-user-playlists #f "hans" '()) '())
+  (check-false (load-user-language #f "hans"))
+
   (dynamic-wind
     (λ ()
       (make-directory music)
@@ -181,16 +272,19 @@
       (call-with-output-file (build-path music-two "two.flac") void)
       (call-with-output-file outside void))
     (λ ()
-      (define libraries (make-music-libraries (list music music-two)))
+      (let* ((libraries (make-music-libraries (list music music-two)))
-      (define store (open-playlist-store store-file))
+             (store (open-playlist-store store-file))
-      (define first-id (uuid-string))
+             (first-id (uuid-string))
-      (define second-id (uuid-string))
+             (second-id (uuid-string))
-      (define item
+             (item
               (track (build-path music "one.flac")
                      "One" "Artist" "Album" 60 "audio/flac"))
-      (define item-two
+             (item-two
               (track (build-path music-two "two.flac")
-               "Two" "Artist" "Album" 70 "audio/flac"))
+                     "Two" "Artist" "Album" 70 "audio/flac")))
+        (dynamic-wind
+          void
+          (λ ()
             (save-user-playlists!
              store
              "hans"
@@ -200,18 +294,19 @@
              store
              "local"
              (list (persisted-tab (uuid-string) "Local" '())))
-
+            (let ((loaded (load-user-playlists store "hans" libraries)))
-      (define loaded (load-user-playlists store "hans" libraries))
+              (check-equal? (ks-get store "playlists-for-hans")
-      (define ks (playlist-store-keystore store))
+                            (list first-id second-id))
-      (check-equal? (ks-get ks "playlists-for-hans")
+              (check-equal? (hash-ref (ks-get store first-id) 'name) "First")
+              (check-equal? (map persisted-tab-id loaded)
                             (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)))
+              (check-equal?
+               (map track-title (persisted-tab-tracks (car loaded)))
                '("One" "Two"))
               (check-equal?
-       (map persisted-tab-name (load-user-playlists store "local" libraries))
+               (map persisted-tab-name
+                    (load-user-playlists store "local" libraries))
                '("Local"))
               (check-false (load-user-language store "hans"))
               (save-user-language! store "hans" "fr")
@@ -221,23 +316,25 @@
               (check-exn exn:fail:contract?
                          (λ () (save-user-language! store "hans" "da")))
 
-      ;; Rewriting the user's GUID index durably removes the omitted playlist.
+              ;; Rewriting the user's GUID index durably removes the omitted
+              ;; playlist instead of leaving it orphaned.
               (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))
+               (map persisted-tab-id
+                    (load-user-playlists store "hans" libraries))
                (list first-id))
-      (check-false (ks-exists? ks second-id))
+              (check-false (ks-exists? store second-id))
-      ;; An omitted GUID is deleted rather than becoming orphaned.
               (check-equal?
-       (map persisted-tab-name (load-user-playlists store "local" libraries))
+               (map persisted-tab-name
+                    (load-user-playlists store "local" libraries))
                '("Local"))
 
-      ;; A playlist entry may not restore tracks outside configured libraries.
+              ;; A playlist may not restore tracks outside configured libraries.
-      (define unsafe-id (uuid-string))
+              (let ((unsafe-id (uuid-string)))
                 (ks-set!
-       (playlist-store-keystore store)
+                 store
                  unsafe-id
                  (hasheq
                   'name "Unsafe"
@@ -245,12 +342,12 @@
                   (list (hasheq 'file (path->string outside)
                                 'title "Outside" 'artist "" 'album ""
                                 'duration #f 'mime-type "audio/flac"))))
-      (ks-set! (playlist-store-keystore store)
+                (ks-set! store
                          (user-playlists-key "unsafe")
                          (list unsafe-id))
                 (check-equal?
                  (persisted-tab-tracks
                   (car (load-user-playlists store "unsafe" libraries)))
-       '())
+                 '()))))
-      (close-playlist-store! store))
+          (λ () (close-playlist-store! store)))))
     (λ () (delete-directory/files root))))

private/server.rkt

@@ -21,43 +21,46 @@
 (define-runtime-path public-directory "../public")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; HTTP handlers
+;; Supporting functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define current-player #f)
+;;; Creates a JSON response that browsers and agents may not cache.
-(define current-auth #f)
-
 (define (json-response value #:code [code 200] #:headers [headers '()])
   (response/jsexpr
    value
    #:code code
    #:headers (cons (header #"Cache-Control" #"no-store") headers)))
 
+;;; Converts an ordinary request exception to a bad-request response.
 (define (error-response exception)
   (json-response
    (hasheq 'error (exn-message exception))
    #:code 400))
 
+;;; Converts a denied playback agent exception to a forbidden response.
 (define (agent-error-response exception)
   (json-response
    (hasheq 'error (exn-message exception)
            'code "agent-not-authorized")
    #:code 403))
 
+;;; Reads a JSON request body or returns an empty object for an empty body.
 (define (request-jsexpr request)
   (let ((body (request-post-data/raw request)))
     (if (and body (positive? (bytes-length body)))
         (bytes->jsexpr body)
         (hasheq))))
 
-(define (auth-status-handler request)
+;;; Reports the authentication state belonging to the current request.
-  (let ((user (auth-request-user current-auth request)))
+(define (auth-status-handler auth request)
+  (let ((user (auth-request-user auth request)))
     (json-response
-     (hasheq 'enabled (auth-enabled? current-auth)
+     (hasheq 'enabled (auth-enabled? auth)
              'authenticated (and user #t)
              'username (or user 'null)))))
 
-(define (auth-login-handler request)
+;;; Authenticates a browser and returns its new session cookie.
+(define (auth-login-handler auth request)
   (with-handlers ((exn:fail? error-response))
     (let* ((data (request-jsexpr request))
            (username (hash-ref data 'username #f))
@@ -66,16 +69,16 @@
         (raise-arguments-error
          'login
          "username and password must be strings"))
-      (let ((result (auth-login! current-auth request username password)))
+      (let ((result (auth-login! auth request username password)))
         (cond
           ((eq? result 'rate-limited)
            (json-response
-            (hasheq 'error "Te veel mislukte aanmeldpogingen; probeer het over enkele minuten opnieuw"
+            (hasheq 'error "login-rate-limited"
                     'code "login-rate-limited")
             #:code 429))
           ((not result)
            (json-response
-            (hasheq 'error "Ongeldige gebruikersnaam of wachtwoord"
+            (hasheq 'error "invalid-credentials"
                     'code "invalid-credentials")
             #:code 401))
           (else
@@ -84,79 +87,89 @@
                     'username (string-downcase (string-trim username)))
             #:headers
             (list (header #"Set-Cookie"
-                          (auth-session-cookie current-auth result))))))))))
+                          (auth-session-cookie auth result))))))))))
 
-(define (auth-logout-handler request)
+;;; Invalidates the browser session and expires its cookie.
-  (auth-logout! current-auth request)
+(define (auth-logout-handler auth request)
+  (auth-logout! auth request)
   (json-response
    (hasheq 'authenticated #f)
    #:headers
    (list (header #"Set-Cookie" (auth-expired-cookie)))))
 
-(define (request-username request)
+;;; Resolves the authenticated username or the anonymous playlist owner.
-  (or (auth-request-user current-auth request) "anonymous"))
+(define (request-username auth request)
+  (or (auth-request-user auth request) "anonymous"))
 
-(define (state-handler request)
+;;; Returns the player state belonging to the requesting user.
+(define (state-handler player auth request)
   (json-response
    (player-state->jsexpr
-    current-player
+    player
-    #:username (request-username request))))
+    #:username (request-username auth request))))
 
-(define (discover-handler request)
+;;; Starts renderer discovery and returns the updated player state.
-  (player-discover! current-player)
+(define (discover-handler player auth request)
+  (player-discover! player)
   (json-response
    (player-state->jsexpr
-    current-player
+    player
-    #:username (request-username request))))
+    #:username (request-username auth request))))
 
-(define (command-handler request command)
+;;; Applies one player command for the requesting user.
+(define (command-handler player auth request command)
   (with-handlers
       ((exn:fail? error-response))
     (json-response
      (player-command!
-      current-player
+      player
       command
       (request-jsexpr request)
-      #:username (request-username request)))))
+      #:username (request-username auth request)))))
 
-(define (preferences-handler request)
+;;; Returns the persisted interface preferences for the requesting user.
+(define (preferences-handler player auth request)
   (json-response
    (hasheq
     'language
     (or (player-user-language
-         current-player
+         player
-         #:username (request-username request))
+         #:username (request-username auth request))
         'null))))
 
-(define (preferences-update-handler request)
+;;; Validates and persists the requesting user's interface language.
+(define (preferences-update-handler player auth request)
   (with-handlers ((exn:fail? error-response))
-    (define language (hash-ref (request-jsexpr request) 'language #f))
+    (let ((language (hash-ref (request-jsexpr request) 'language #f)))
       (player-user-language!
-     current-player
+       player
        language
-     #:username (request-username request))
+       #:username (request-username auth request))
-    (json-response (hasheq 'language language))))
+      (json-response (hasheq 'language language)))))
 
-(define (agent-register-handler request)
+;;; Registers or refreshes one allowed polling playback agent.
+(define (agent-register-handler player request)
   (with-handlers
       ((exn:fail:agent-denied? agent-error-response)
        (exn:fail? error-response))
     (json-response
      (player-agent-register!
-      current-player
+      player
       (request-jsexpr request)))))
 
-(define (agent-poll-handler request)
+;;; Processes one state report and command poll from a playback agent.
+(define (agent-poll-handler player request)
   (with-handlers
       ((exn:fail:agent-denied? agent-error-response)
        (exn:fail? error-response))
     (json-response
      (player-agent-poll!
-      current-player
+      player
       (request-jsexpr request)))))
 
-(define (agent-media-handler _request app-id token)
+;;; Streams the media file identified by an agent's opaque token.
-  (let ((file (player-agent-media current-player app-id token)))
+(define (agent-media-handler player _request app-id token)
+  (let ((file (player-agent-media player app-id token)))
     (if (and file (file-exists? file))
         (response/output
          (λ (output)
@@ -179,50 +192,34 @@
          (hasheq 'error "media token is invalid or expired")
          #:code 404))))
 
-(define (artwork-handler request artwork-id)
+;;; Streams cached artwork belonging to a track visible to the user.
+(define (artwork-handler player auth request artwork-id)
   (let ((value (player-track-artwork
-                current-player
+                player
                 artwork-id
-                #:username (request-username request))))
+                #:username (request-username auth request))))
     (if value
+        (let ((data (artwork-data value)))
           (response/output
            (λ (output)
-           (write-bytes (artwork-data value) output))
+             (write-bytes data output))
            #:mime-type
            (string->bytes/utf-8 (artwork-mime-type value))
            #:headers
            (list
             (header #"Content-Length"
                     (string->bytes/utf-8
-                   (number->string
+                     (number->string (bytes-length data))))
-                    (bytes-length (artwork-data value)))))
+            (header #"Cache-Control" #"private, max-age=3600"))))
-          (header #"Cache-Control" #"private, max-age=3600")))
         (json-response
          (hasheq 'error "track artwork is unavailable")
          #:code 404))))
 
-(define-values (api-dispatch _url)
+;;; Returns the path and query string used to classify an API request.
-  (dispatch-rules
-   [("api" "auth" "status") #:method "get" auth-status-handler]
-   [("api" "auth" "login") #:method "post" auth-login-handler]
-   [("api" "auth" "logout") #:method "post" auth-logout-handler]
-   [("api" "state") #:method "get" state-handler]
-   [("api" "discover") #:method "post" discover-handler]
-   [("api" "preferences") #:method "get" preferences-handler]
-   [("api" "preferences") #:method "post" preferences-update-handler]
-   [("api" "agent" "register") #:method "post" agent-register-handler]
-   [("api" "agent" "poll") #:method "post" agent-poll-handler]
-   [("api" "agent" "media" (string-arg) (string-arg))
-    #:method "get"
-    agent-media-handler]
-   [("api" "artwork" (string-arg)) #:method "get" artwork-handler]
-   [("api" "command" (string-arg))
-    #:method "post"
-    command-handler]))
-
 (define (request-path request)
   (url->string (request-uri request)))
 
+;;; Checks whether the request declares a JSON entity body.
 (define (json-request? request)
   (let ((content-type
          (headers-assq* #"Content-Type" (request-headers/raw request))))
@@ -230,6 +227,7 @@
          (regexp-match? #px#"(?i:^application/json(?:;|$))"
                         (header-value content-type)))))
 
+;;; Recognizes endpoints that use authentication rules separate from browsers.
 (define (public-api-request? request)
   (regexp-match? #px"^/api/(?:auth|agent)(?:/|$)"
                  (request-path request)))
@@ -251,40 +249,95 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Dispatch an API request and renew an eligible browser cookie.
-; pre    : Current-player and current-auth are initialized and request targets
+; pre    : Auth is an auth-manager, api-dispatch handles the configured routes,
-;          an API route.
+;          and request targets an API route.
 ; post   : The selected handler has run. A due browser-session renewal is
 ;          recorded and returned as Set-Cookie; agent requests never renew it.
 ; result : The HTTP response produced by the API handler, optionally extended
 ;          with the renewed session cookie.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (dispatch-api request)
+(define (dispatch-api auth api-dispatch request)
-  (define value (api-dispatch request))
+  (let* ((value (api-dispatch request))
-  (define renewed-cookie
+         (agent-request?
-    (and (not (regexp-match? #px"^/api/agent(?:/|$)"
+          (regexp-match? #px"^/api/agent(?:/|$)" (request-path request)))
-                             (request-path request)))
+         (renewed-cookie
-         (auth-renewal-cookie current-auth request)))
+          (if agent-request?
+              #f
+              (auth-renewal-cookie auth request))))
     (if renewed-cookie
         (response-add-header value (header #"Set-Cookie" renewed-cookie))
-      value))
+        value)))
 
-(define (dispatch request)
+;;; Enforces JSON and authentication requirements before route dispatch.
+(define (dispatch-request auth api-dispatch request)
   (cond
     ((and (bytes=? (request-method request) #"POST")
           (not (json-request? request)))
      (json-response
-      (hasheq 'error "Content-Type application/json is vereist"
+      (hasheq 'error "json-required"
               'code "json-required")
       #:code 415))
     ((or (public-api-request? request)
-         (auth-request-user current-auth request))
+         (auth-request-user auth request))
-     (dispatch-api request))
+     (dispatch-api auth api-dispatch request))
     (else
      (json-response
-      (hasheq 'error "Aanmelden is vereist"
+      (hasheq 'error "authentication-required"
               'code "authentication-required")
       #:code 401))))
 
+;;; Binds the player and authentication manager to every declared API route.
+(define (make-api-dispatch player auth)
+  (let-values
+      (((api-dispatch _url)
+        (dispatch-rules
+         [("api" "auth" "status")
+          #:method "get"
+          (λ (request) (auth-status-handler auth request))]
+         [("api" "auth" "login")
+          #:method "post"
+          (λ (request) (auth-login-handler auth request))]
+         [("api" "auth" "logout")
+          #:method "post"
+          (λ (request) (auth-logout-handler auth request))]
+         [("api" "state")
+          #:method "get"
+          (λ (request) (state-handler player auth request))]
+         [("api" "discover")
+          #:method "post"
+          (λ (request) (discover-handler player auth request))]
+         [("api" "preferences")
+          #:method "get"
+          (λ (request) (preferences-handler player auth request))]
+         [("api" "preferences")
+          #:method "post"
+          (λ (request) (preferences-update-handler player auth request))]
+         [("api" "agent" "register")
+          #:method "post"
+          (λ (request) (agent-register-handler player request))]
+         [("api" "agent" "poll")
+          #:method "post"
+          (λ (request) (agent-poll-handler player request))]
+         [("api" "agent" "media" (string-arg) (string-arg))
+          #:method "get"
+          (λ (request app-id token)
+            (agent-media-handler player request app-id token))]
+         [("api" "artwork" (string-arg))
+          #:method "get"
+          (λ (request artwork-id)
+            (artwork-handler player auth request artwork-id))]
+         [("api" "command" (string-arg))
+          #:method "post"
+          (λ (request command)
+            (command-handler player auth request command))])))
+    api-dispatch))
+
+;;; Creates the servlet dispatcher whose closure owns one player/auth pair.
+(define (make-dispatch player auth)
+  (let ((api-dispatch (make-api-dispatch player auth)))
+    (λ (request)
+      (dispatch-request auth api-dispatch request))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Provided functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -294,6 +347,9 @@
 ; pre    : Value is a player, listen-ip is a string, and port is valid.
 ; post   : Static files and API routes are served until the server stops.
 ; result : The result returned by serve/servlet.
+; internals: make-dispatch binds value and auth-manager into one request
+;            closure. make-api-dispatch connects that context to every route;
+;            serve/servlet then serves the closure and public-directory.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (serve-player value
                                #:auth-manager
@@ -301,14 +357,13 @@
                                #:listen-ip [listen-ip "127.0.0.1"]
                                #:port [port 8080]
                                #:launch-browser? [launch-browser? #t])
-  (->* (any/c)
+  (->* (player?)
        (#:auth-manager auth-manager?
         #:listen-ip string?
         #:port exact-positive-integer?
         #:launch-browser? boolean?)
        any)
-  (set! current-player value)
+  (let ((dispatch (make-dispatch value auth-manager)))
-  (set! current-auth auth-manager)
     (serve/servlet
      dispatch
      #:listen-ip listen-ip
@@ -318,4 +373,81 @@
      #:quit? #f
      #:banner? #t
      #:servlet-regexp #rx"^/api(?:/|$)"
-   #:extra-files-paths (list public-directory)))
+     #:extra-files-paths (list public-directory))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module server.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module+ test
+  (require racket/promise
+           rackunit)
+
+  ;;; Creates an isolated request value for handler and dispatcher tests.
+  (define (test-request method path
+                        #:headers [headers '()]
+                        #:body [body #f])
+    (request method
+             (string->url path)
+             headers
+             (delay '())
+             body
+             "127.0.0.1"
+             8080
+             "127.0.0.1"))
+
+  ;;; Reads the JSON entity produced by a response.
+  (define (response-jsexpr value)
+    (let ((output (open-output-bytes)))
+      ((response-output value) output)
+      (bytes->jsexpr (get-output-bytes output))))
+
+  (check-equal?
+   (request-jsexpr (test-request #"POST" "/api/preferences"))
+   (hasheq))
+  (check-equal?
+   (request-jsexpr
+    (test-request #"POST"
+                  "/api/preferences"
+                  #:body #"{\"language\":\"nl\"}"))
+   (hasheq 'language "nl"))
+  (check-true
+   (json-request?
+    (test-request
+     #"POST"
+     "/api/preferences"
+     #:headers (list (header #"Content-Type"
+                            #"application/json; charset=utf-8")))))
+  (check-false (json-request? (test-request #"POST" "/api/preferences")))
+  (check-true (public-api-request? (test-request #"GET" "/api/auth/status")))
+  (check-true (public-api-request? (test-request #"POST" "/api/agent/poll")))
+  (check-false (public-api-request? (test-request #"GET" "/api/state")))
+
+  (let* ((auth (make-auth-manager (list (cons "hans" "$argon2id$unused"))))
+         (request (test-request #"GET" "/api/state"))
+         (response
+          (dispatch-request auth
+                            (λ (_) (error 'test "unexpected dispatch"))
+                            request)))
+    (check-equal? (response-code response) 401)
+    (check-equal? (hash-ref (response-jsexpr response) 'error)
+                  "authentication-required"))
+
+  (let* ((auth (make-auth-manager '()))
+         (request (test-request #"POST" "/api/state"))
+         (response
+          (dispatch-request auth
+                            (λ (_) (error 'test "unexpected dispatch"))
+                            request)))
+    (check-equal? (response-code response) 415)
+    (check-equal? (hash-ref (response-jsexpr response) 'error)
+                  "json-required"))
+
+  (let* ((auth (make-auth-manager '()))
+         (dispatch (make-dispatch 'unused-player auth))
+         (response (dispatch (test-request #"GET" "/api/auth/status")))
+         (data (response-jsexpr response)))
+    (check-equal? (response-code response) 200)
+    (check-false (hash-ref data 'enabled))
+    (check-true (hash-ref data 'authenticated))
+    (check-equal? (hash-ref data 'username) "anonymous")))

private/users.rkt

@@ -2,7 +2,7 @@
 
 (require crypto
          crypto/argon2
-         net/private/ip
+         net/ip
          racket/contract
          racket/list
          racket/random
@@ -22,10 +22,16 @@
          auth-renewal-cookie
          auth-expired-cookie)
 
-(struct ip-network (address prefix) #:transparent)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal data
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Holds one authenticated browser session and its two activity timestamps.
 (struct session
   (username [last-seen #:mutable] [last-cookie-renewal #:mutable])
   #:transparent)
+
+;;; Holds the failed-login count and start time for one client address.
 (struct failures ([attempts #:mutable] [started #:mutable]) #:transparent)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -33,6 +39,8 @@
 ; pre    : Constructor fields contain normalized and parsed internal values.
 ; post   : Creating or recognizing a value does not change external state.
 ; result : auth-manager? recognizes values used by the authentication API.
+; internals: users and trusted-proxies are immutable configuration references;
+;            sessions and failed hold mutable login state protected by lock.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (struct auth-manager
   (users trusted-proxies session-seconds sessions failed lock)
@@ -53,11 +61,20 @@
 (define failure-window-seconds 300)
 (define maximum-failures 5)
 
+(define ipv4-mapped-prefix
+  #"\0\0\0\0\0\0\0\0\0\0\377\377")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided password functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Create an Argon2id password hash for configuration storage.
 ; pre    : Password is a string containing at least twelve characters.
 ; post   : No module state is changed.
 ; result : A salted Argon2id hash encoded as a string.
+; internals: pwhash uses password-kdf with password-parameters to generate the
+;            encoded hash, including its random salt and Argon2 parameters.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (make-password-hash password)
   (-> string? string?)
@@ -76,125 +93,165 @@
 ; pre    : Password and encoded are arbitrary values.
 ; post   : No module state is changed.
 ; result : #t only when both values are strings and the password matches.
+; internals: pwhash-verify checks the encoded Argon2id value. Malformed hashes
+;            are treated as a failed match rather than escaping as exceptions.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (password-hash-valid? password encoded)
   (-> any/c any/c boolean?)
-  (and (string? password)
+  (if (and (string? password) (string? encoded))
-       (string? encoded)
       (with-handlers ((exn:fail? (λ (_) #f)))
         (pwhash-verify password-kdf
                        (string->bytes/utf-8 password)
-                        encoded))))
+                       encoded))
+      #f))
 
-(define (normal-ip-bytes value)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  (define raw
+;; Supporting functions
-    (ip-address->bytes (make-ip-address value)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; Normalize IPv4-mapped IPv6 addresses to four bytes.
-  (if (and (= (bytes-length raw) 16)
-           (for/and ((index (in-range 10)))
-             (zero? (bytes-ref raw index)))
-           (= (bytes-ref raw 10) #xff)
-           (= (bytes-ref raw 11) #xff))
-      (subbytes raw 12)
-      raw))
 
+;;; Parses an address and normalizes an IPv4-mapped IPv6 value to IPv4.
+(define (normal-ip-address value)
+  (let* ((address (make-ip-address value))
+         (raw (ip-address->bytes address))
+         (ipv4-mapped?
+          (and (= (bytes-length raw) 16)
+               (bytes=? (subbytes raw 0 12) ipv4-mapped-prefix))))
+    (if ipv4-mapped?
+        (bytes->ipv4-address (subbytes raw 12))
+        address)))
+
+;;; Parses one configured IP address or CIDR value as a public net/ip network.
 (define (parse-network value)
-  (define parts (string-split (string-trim value) "/"))
+  (let ((parts (string-split (string-trim value) "/")))
     (unless (member (length parts) '(1 2))
-    (raise-argument-error 'make-auth-manager "IP address or CIDR network" value))
+      (raise-argument-error
-  (define address
+       'make-auth-manager
+       "IP address or CIDR network"
+       value))
+    (let* ((address
             (with-handlers ((exn:fail?
                              (λ (_)
                                (raise-argument-error
                                 'make-auth-manager
                                 "IP address or CIDR network"
                                 value))))
-      (normal-ip-bytes (car parts))))
+              (normal-ip-address (car parts))))
-  (define maximum (* 8 (bytes-length address)))
+           (maximum (ip-address-size address))
-  (define prefix
+           (prefix
             (if (= (length parts) 2)
                 (string->number (cadr parts))
-        maximum))
+                maximum)))
       (unless (and (exact-nonnegative-integer? prefix)
                    (<= prefix maximum))
-    (raise-argument-error 'make-auth-manager "IP address or CIDR network" value))
+        (raise-argument-error
-  (ip-network address prefix))
+         'make-auth-manager
+         "IP address or CIDR network"
+         value))
+      (make-network address prefix))))
 
+;;; Checks whether an address belongs to one configured trusted network.
 (define (network-contains? network address-string)
   (with-handlers ((exn:fail? (λ (_) #f)))
-    (define candidate (normal-ip-bytes address-string))
+    (network-member network (normal-ip-address address-string))))
-    (define expected (ip-network-address network))
-    (and (= (bytes-length candidate) (bytes-length expected))
-         (let-values (((whole remainder)
-                       (quotient/remainder (ip-network-prefix network) 8)))
-           (and (for/and ((index (in-range whole)))
-                  (= (bytes-ref candidate index)
-                     (bytes-ref expected index)))
-                (or (zero? remainder)
-                    (let ((mask
-                           (bitwise-and #xff
-                                        (arithmetic-shift #xff (- remainder 8)))))
-                      (= (bitwise-and (bytes-ref candidate whole) mask)
-                         (bitwise-and (bytes-ref expected whole) mask)))))))))
 
+;;; Reads one request header as a UTF-8 string when present.
 (define (header-string request name)
   (let ((value (headers-assq* name (request-headers/raw request))))
     (and value
          (bytes->string/utf-8 (header-value value)))))
 
+;;; Checks whether an address belongs to any configured trusted proxy network.
 (define (trusted-proxy? manager address)
   (ormap (λ (network) (network-contains? network address))
          (auth-manager-trusted-proxies manager)))
 
+;;; Resolves the effective client address, honoring only a trusted proxy header.
 (define (request-address manager request)
-  (define peer (request-client-ip request))
+  (let* ((peer (request-client-ip request))
-  (define forwarded
+         (forwarded
           (and (trusted-proxy? manager peer)
-         (header-string request #"X-Forwarded-For")))
+               (header-string request #"X-Forwarded-For"))))
     (if forwarded
         ;; A trusted reverse proxy appends the address it observed. Earlier
         ;; values can have been supplied by the untrusted client.
         (string-trim (last (string-split forwarded ",")))
-      peer))
+        peer)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Extracts the session token from the request cookies when present.
+(define (request-session-token request)
+  (let ((cookie
+         (findf
+          (λ (value)
+            (string=? (client-cookie-name value) session-cookie-name))
+          (request-cookies request))))
+    (if cookie
+        (client-cookie-value cookie)
+        #f)))
+
+;;; Removes every browser session whose idle lifetime has elapsed.
+(define (prune-sessions! manager now)
+  (for-each
+   (λ (token)
+     (let ((value (hash-ref (auth-manager-sessions manager) token)))
+       (when (> (- now (session-last-seen value))
+                (auth-manager-session-seconds manager))
+         (hash-remove! (auth-manager-sessions manager) token))))
+   (hash-keys (auth-manager-sessions manager))))
+
+;;; Checks and, when necessary, resets the failure window for one address.
+(define (failure-blocked? manager address now)
+  (let ((value (hash-ref (auth-manager-failed manager) address #f)))
+    (cond
+      ((eq? value #f) #f)
+      ((> (- now (failures-started value)) failure-window-seconds)
+       (hash-remove! (auth-manager-failed manager) address)
+       #f)
+      (else
+       (>= (failures-attempts value) maximum-failures)))))
+
+;;; Adds one failed login to the current address window or starts a new window.
+(define (record-failure! manager address now)
+  (let ((value (hash-ref (auth-manager-failed manager) address #f)))
+    (if (and value
+             (<= (- now (failures-started value)) failure-window-seconds))
+        (set-failures-attempts! value (add1 (failures-attempts value)))
+        (hash-set! (auth-manager-failed manager)
+                   address
+                   (failures 1 now)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided authentication functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Report whether browser authentication is configured.
 ; pre    : Manager is an auth-manager.
 ; post   : Manager remains unchanged.
 ; result : #t when at least one configured user can log in, otherwise #f.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (auth-enabled? manager)
   (-> auth-manager? boolean?)
   (positive? (hash-count (auth-manager-users manager))))
 
-(define (request-session-token request)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  (for/or ((cookie (in-list (request-cookies request))))
-    (and (string=? (client-cookie-name cookie) session-cookie-name)
-         (client-cookie-value cookie))))
-
-(define (prune-sessions! manager now)
-  (for ((token (in-list (hash-keys (auth-manager-sessions manager)))))
-    (let ((value (hash-ref (auth-manager-sessions manager) token)))
-      (when (> (- now (session-last-seen value))
-               (auth-manager-session-seconds manager))
-        (hash-remove! (auth-manager-sessions manager) token)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Resolve the browser user represented by a request cookie.
 ; pre    : Manager is an auth-manager and request is an HTTP request.
 ; post   : Expired sessions are removed and a valid session's last-seen time
 ;          is updated.
 ; result : "anonymous" when authentication is disabled, the normalized
 ;          username for a valid session, or #f when login is required.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; internals: request-session-token finds the cookie. The manager lock protects
+;            prune-sessions! and the session lookup; a valid lookup updates its
+;            idle timestamp before returning the stored username.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (auth-request-user manager request)
   (-> auth-manager? request? (or/c #f string?))
-  (cond
+  (if (not (auth-enabled? manager))
-    ((not (auth-enabled? manager)) "anonymous")
+      "anonymous"
-    (else
       (let ((token (request-session-token request))
             (now (current-seconds)))
-       (and token
+        (if (eq? token #f)
+            #f
             (call-with-semaphore
              (auth-manager-lock manager)
              (λ ()
@@ -202,28 +259,11 @@
                (let ((value (hash-ref (auth-manager-sessions manager)
                                       token
                                       #f)))
-                 (and value
+                 (if value
                      (begin
                        (set-session-last-seen! value now)
-                        (session-username value)))))))))))
+                       (session-username value))
-
+                     #f))))))))
-(define (failure-blocked? manager address now)
-  (define value (hash-ref (auth-manager-failed manager) address #f))
-  (and value
-       (if (> (- now (failures-started value)) failure-window-seconds)
-           (begin
-             (hash-remove! (auth-manager-failed manager) address)
-             #f)
-           (>= (failures-attempts value) maximum-failures))))
-
-(define (record-failure! manager address now)
-  (define value (hash-ref (auth-manager-failed manager) address #f))
-  (if (and value
-           (<= (- now (failures-started value)) failure-window-seconds))
-      (set-failures-attempts! value (+ 1 (failures-attempts value)))
-      (hash-set! (auth-manager-failed manager)
-                 address
-                 (failures 1 now))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Authenticate credentials and start a browser session.
@@ -232,8 +272,11 @@
 ; post   : A valid login creates a new session; a failed login updates the
 ;          rate-limit state for the effective client address.
 ; result : A new opaque token, #f for invalid credentials, or 'rate-limited.
-; internals: Unknown users follow the same Argon2id verification path as known
+; internals: request-address selects the rate-limit key and failure-blocked?
-;            users to reduce username-dependent timing differences.
+;            checks its window while the manager lock is held. Unknown users
+;            verify against dummy-password-hash to reduce username-dependent
+;            timing differences. Success creates a session; failure delegates
+;            to record-failure!.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (auth-login! manager request username password)
   (-> auth-manager?
@@ -274,6 +317,8 @@
 ; pre    : Manager is an auth-manager and request is an HTTP request.
 ; post   : The matching server-side session is removed when it exists.
 ; result : Void.
+; internals: request-session-token finds the cookie and the manager lock
+;            protects removal from the shared session hash.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (auth-logout! manager request)
   (-> auth-manager? request? void?)
@@ -290,6 +335,8 @@
 ; post   : Manager remains unchanged.
 ; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value whose Max-Age
 ;          equals the configured session lifetime.
+; internals: format combines session-cookie-name, token and the manager's
+;            configured lifetime into the complete Set-Cookie header value.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (auth-session-cookie manager token)
   (-> auth-manager? string? bytes?)
@@ -307,37 +354,48 @@
 ;          last-cookie-renewal time is advanced.
 ; result : A fresh Set-Cookie value after half the configured lifetime has
 ;          elapsed, otherwise #f.
-; internals: The server idle timer moves on every authenticated request, while
+; internals: request-session-token identifies the session. The manager lock
-;            this half-life threshold prevents the one-second player poll from
+;            protects prune-sessions! and the renewal timestamp. A half-life
-;            returning Set-Cookie every second.
+;            threshold prevents the one-second player poll from returning a
+;            new cookie every second.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (auth-renewal-cookie manager request)
   (-> auth-manager? request? (or/c #f bytes?))
-  (and (auth-enabled? manager)
+  (if (not (auth-enabled? manager))
+      #f
       (let ((token (request-session-token request))
             (now (current-seconds)))
-         (and token
+        (if (eq? token #f)
+            #f
             (call-with-semaphore
              (auth-manager-lock manager)
              (λ ()
                (prune-sessions! manager now)
                (let ((value
                       (hash-ref (auth-manager-sessions manager) token #f)))
-                   (and value
+                 (if value
-                        (>= (- now (session-last-cookie-renewal value))
+                     (let* ((elapsed
+                             (- now
+                                (session-last-cookie-renewal value)))
+                            (renewal-interval
                              (max 1
                                   (quotient
                                    (auth-manager-session-seconds manager)
-                                  2)))
+                                   2))))
+                       (if (< elapsed renewal-interval)
+                           #f
                            (begin
                              (set-session-last-cookie-renewal! value now)
-                          (auth-session-cookie manager token))))))))))
+                             (auth-session-cookie manager token))))
+                     #f))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Encode deletion of the browser session cookie.
 ; pre    : None.
 ; post   : No module state is changed.
 ; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value with Max-Age 0.
+; internals: format uses session-cookie-name and an empty value to instruct the
+;            browser to remove the cookie immediately.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (auth-expired-cookie)
   (-> bytes?)
@@ -354,6 +412,10 @@
 ; post   : No external state is changed; session and rate-limit tables start
 ;          empty.
 ; result : A new auth-manager with normalized usernames and parsed networks.
+; internals: Each user entry is validated and copied into a case-insensitive
+;            hash. parse-network converts trusted-proxy-values through the
+;            public net/ip API; fresh hashes and a semaphore protect sessions
+;            and failed-login windows.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define/contract (make-auth-manager
                   user-pairs
@@ -367,33 +429,33 @@
   (unless (exact-positive-integer? session-seconds)
     (raise-argument-error 'make-auth-manager "exact-positive-integer?"
                           session-seconds))
-  (define users (make-hash))
+  (let ((users (make-hash)))
-  (for ((entry (in-list user-pairs)))
+    (for-each
-    (unless (and (pair? entry)
+     (λ (entry)
-                 (string? (car entry))
+       (let ((username (string-trim (car entry)))
-                 (string? (cdr entry)))
+             (password-hash (cdr entry)))
-      (raise-argument-error
+         (when (string=? username "")
-       'make-auth-manager
-       "(listof (cons/c string? string?))"
-       user-pairs))
-    (when (string=? (string-trim (car entry)) "")
            (raise-arguments-error
             'make-auth-manager
             "username must not be empty"
             "username" (car entry)))
-    (unless (regexp-match? #px"^[$]argon2id[$]" (cdr entry))
+         (unless (regexp-match? #px"^[$]argon2id[$]" password-hash)
            (raise-arguments-error
             'make-auth-manager
             "user password is not an Argon2id hash"
             "username" (car entry)))
-    (hash-set! users (string-downcase (string-trim (car entry)))
+         (hash-set! users (string-downcase username) password-hash)))
-               (cdr entry)))
+     user-pairs)
     (auth-manager users
                   (map parse-network trusted-proxy-values)
                   session-seconds
                   (make-hash)
                   (make-hash)
-                (make-semaphore 1)))
+                  (make-semaphore 1))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for module users.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (module+ test
   (require net/url
@@ -410,6 +472,20 @@
      (list (cons "Hans" test-hash))
      #:trusted-proxies '("127.0.0.1/32")))
 
+  (check-true
+   (network-contains? (parse-network "192.0.2.0/24") "192.0.2.18"))
+  (check-false
+   (network-contains? (parse-network "192.0.2.0/24") "192.0.3.18"))
+  (check-true
+   (network-contains? (parse-network "2001:db8::/32") "2001:db8::12"))
+  (check-true
+   (network-contains? (parse-network "127.0.0.0/8")
+                      "0:0:0:0:0:ffff:7f00:1"))
+  (check-exn exn:fail:contract?
+             (λ () (parse-network "192.0.2.1/33")))
+  (check-exn exn:fail:contract?
+             (λ () (parse-network "not-an-address")))
+
   (define (test-request peer [headers '()])
     (request #"GET" (string->url "http://example.test/api/state")
              headers (delay '()) #f "127.0.0.1" 80 peer))
@@ -432,6 +508,13 @@
      "198.51.100.2"
      (list (header #"X-Forwarded-For" #"203.0.113.9"))))
    "198.51.100.2")
+  (check-equal?
+   (request-address
+    manager
+    (test-request
+     "0:0:0:0:0:ffff:7f00:1"
+     (list (header #"X-Forwarded-For" #"203.0.113.9"))))
+   "203.0.113.9")
   (define token
     (auth-login! manager remote "hans" "correct horse battery staple"))
   (check-true (string? token))
@@ -451,4 +534,22 @@
   (check-false (auth-renewal-cookie manager authenticated))
   (auth-logout! manager authenticated)
   (check-false (auth-request-user manager authenticated))
-  (check-false (auth-login! manager remote "hans" "wrong password")))
+  (check-false (auth-login! manager remote "hans" "wrong password"))
+
+  (let ((limited-manager (make-auth-manager '())))
+    (for-each
+     (λ (_) (record-failure! limited-manager "192.0.2.1" 100))
+     (range maximum-failures))
+    (check-true (failure-blocked? limited-manager "192.0.2.1" 100))
+    (check-false
+     (failure-blocked? limited-manager
+                       "192.0.2.1"
+                       (+ 101 failure-window-seconds))))
+
+  (let ((session-manager (make-auth-manager '() #:session-seconds 10)))
+    (hash-set! (auth-manager-sessions session-manager)
+               "expired"
+               (session "hans" 0 0))
+    (prune-sessions! session-manager 11)
+    (check-false
+     (hash-has-key? (auth-manager-sessions session-manager) "expired"))))

public/app.js

@@ -1,3 +1,20 @@
+/*
+ * Browser client for the web player.
+ *
+ * refresh and command obtain complete player-state snapshots from the server.
+ * render stores that snapshot and passes it to the selector, library, playlist,
+ * and playback renderers. Collection renderers retain a DOM signature so the
+ * one-second polling loop only rebuilds lists whose contents changed.
+ *
+ * Event handlers send commands or change local controls. command sets
+ * commandBusy while its request is active, so refresh skips polling until the
+ * returned state has been rendered.
+ */
+
+///////////////////////////////////////////////////////////////////////////////
+// Browser elements and state
+///////////////////////////////////////////////////////////////////////////////
+
 const elements = {
   renderer: document.querySelector("#renderer"),
   language: document.querySelector("#language"),
@@ -51,6 +68,7 @@ let seekBusy = false;
 let draggedTrack = null;
 let commandBusy = false;
 
+// Represents an unsuccessful API response, including its HTTP status and code.
 class ApiError extends Error {
   constructor(message, status, code) {
     super(message);
@@ -59,8 +77,16 @@ class ApiError extends Error {
   }
 }
 
+///////////////////////////////////////////////////////////////////////////////
+// API, authentication, and shared formatting
+///////////////////////////////////////////////////////////////////////////////
+
+// Converts a duration in seconds to the fixed-width time shown by the player.
 function formatTime(value) {
-  if (!Number.isFinite(value) || value < 0) return "00:00:00";
+  if (!Number.isFinite(value) || value < 0) {
+    return "00:00:00";
+  }
+
   const whole = Math.floor(value);
   const hours = Math.floor(whole / 3600).toString().padStart(2, "0");
   const minutes = Math.floor((whole % 3600) / 60).toString().padStart(2, "0");
@@ -68,18 +94,29 @@ function formatTime(value) {
   return `${hours}:${minutes}:${seconds}`;
 }
 
+// Replaces the current status message, using an empty string for no message.
 function setStatus(message) {
   elements.status.textContent = message || "";
 }
 
+// Translates an API error code while retaining literal messages as a fallback.
+function errorMessage(error) {
+  return t(error.message);
+}
+
+// Sends a GET or JSON POST request and returns its decoded JSON response.
 async function api(path, body) {
-  const options = body === undefined
+  let options;
-    ? { cache: "no-store" }
+  if (body === undefined) {
-    : {
+    options = { cache: "no-store" };
+  } else {
+    options = {
       method: "POST",
       headers: { "Content-Type": "application/json" },
       body: JSON.stringify(body),
     };
+  }
+
   const response = await fetch(path, options);
   const data = await response.json();
   if (!response.ok) {
@@ -88,21 +125,27 @@ async function api(path, body) {
   return data;
 }
 
+// Displays the login overlay and optionally reports why authentication failed.
 function showLogin(message = null) {
   const wasHidden = elements.loginOverlay.hidden;
-  if (message !== null) elements.loginError.textContent = message;
+  if (message !== null) {
+    elements.loginError.textContent = message;
+  }
+
   elements.loginOverlay.hidden = false;
   if (wasHidden) {
     window.setTimeout(() => elements.loginUsername.focus(), 0);
   }
 }
 
+// Hides the login overlay and clears credentials that must not be retained.
 function hideLogin() {
   elements.loginOverlay.hidden = true;
   elements.loginError.textContent = "";
   elements.loginPassword.value = "";
 }
 
+// Synchronizes the login controls and stored language with the current session.
 async function refreshAuth() {
   try {
     const auth = await api("/api/auth/status");
@@ -116,39 +159,62 @@ async function refreshAuth() {
       }
     }
   } catch (error) {
-    setStatus(t("authUnknown", { message: error.message }));
+    setStatus(t("authUnknown", { message: errorMessage(error) }));
   }
 }
 
+// Sends a player command and immediately renders the state returned by it.
+// commandBusy makes refresh skip polling until this request has finished.
 async function command(name, data = {}, pendingMessage = "") {
-  if (pendingMessage) setStatus(pendingMessage);
+  if (pendingMessage) {
+    setStatus(pendingMessage);
+  }
+
   commandBusy = true;
   try {
     render(await api(`/api/command/${name}`, data));
   } catch (error) {
-    setStatus(error.message);
+    setStatus(errorMessage(error));
   } finally {
     commandBusy = false;
   }
 }
 
-function replaceSelect(select, items, selectedId, signature) {
+///////////////////////////////////////////////////////////////////////////////
-  if (select.dataset.signature !== signature) {
+// Output and library selectors
-    select.replaceChildren(...items.map((item) => {
+///////////////////////////////////////////////////////////////////////////////
+
+// Creates one option for a renderer or music-library selector.
+function createOption(item) {
   const option = document.createElement("option");
   option.value = item.id;
   option.textContent = item.label;
   return option;
-    }));
+}
+
+// Rebuilds a select only when its available items changed, then selects its value.
+function replaceSelect(select, items, selectedId, signature) {
+  if (select.dataset.signature !== signature) {
+    select.replaceChildren(...items.map(createOption));
     select.dataset.signature = signature;
   }
   select.value = selectedId || "";
 }
 
+// Builds the renderer label, translating the special local-renderer kind.
+function rendererLabel(renderer) {
+  let kind = renderer.kind.toUpperCase();
+  if (renderer.kind === "local") {
+    kind = t("rendererLocal");
+  }
+  return `${renderer.name} · ${kind}`;
+}
+
+// Renders output and library choices and their current availability.
 function renderSelectors(nextState) {
   const rendererItems = nextState.renderers.map((item) => ({
     id: item.id,
-    label: `${item.name} · ${item.kind === "local" ? t("rendererLocal") : item.kind.toUpperCase()}`,
+    label: rendererLabel(item),
   }));
   replaceSelect(
     elements.renderer,
@@ -174,6 +240,11 @@ function renderSelectors(nextState) {
   elements.library.disabled = nextState.libraries.length === 0;
 }
 
+///////////////////////////////////////////////////////////////////////////////
+// Music-library browser
+///////////////////////////////////////////////////////////////////////////////
+
+// Creates an action button that does not activate its surrounding library row.
 function entryAction(label, title, handler) {
   const button = document.createElement("button");
   button.className = "entry-action";
@@ -188,20 +259,38 @@ function entryAction(label, title, handler) {
   return button;
 }
 
-function renderBrowser(nextState) {
+// Starts a library track immediately and reports which item is being loaded.
-  const selectedLibrary = nextState.libraries.find((item) => item.id === nextState.libraryId);
+function playLibraryEntry(entry) {
-  const path = [selectedLibrary?.name, ...nextState.browser.path].filter(Boolean);
+  const message = t("loadingNamed", { name: entry.name });
-  elements.breadcrumb.textContent = path.length ? path.join(" / ") : t("noLibrary");
+  command("item-play", { index: entry.index }, message);
-  elements.breadcrumb.title = elements.breadcrumb.textContent;
+}
-  elements.libraryUp.disabled = !nextState.browser.canGoUp;
-  elements.libraryEmpty.hidden = nextState.libraries.length > 0;
 
-  const signature = nextState.browser.entries
+// Adds a library item to the current playlist and reports the pending action.
-    .map((entry) => `${entry.index}:${entry.kind}:${entry.name}`)
+function addLibraryEntry(entry) {
-    .join("|");
+  const message = t("addingNamed", { name: entry.name });
-  if (elements.libraryEntries.dataset.signature === signature) return;
+  command("item-add", { index: entry.index }, message);
+}
 
-  const rows = nextState.browser.entries.map((entry) => {
+// Opens a container or starts a track, according to the entry kind.
+function activateLibraryEntry(entry) {
+  if (entry.kind === "container") {
+    command("browse", { index: entry.index });
+  } else {
+    playLibraryEntry(entry);
+  }
+}
+
+// Maps the keyboard actions supported by a focused library entry.
+function handleLibraryEntryKeydown(event, entry) {
+  if (event.key === "Enter") {
+    activateLibraryEntry(entry);
+  } else if (event.key === "+") {
+    addLibraryEntry(entry);
+  }
+}
+
+// Builds an interactive row for one container or track in the library browser.
+function createLibraryEntry(entry) {
   const row = document.createElement("li");
   row.className = "library-entry";
   row.tabIndex = 0;
@@ -218,46 +307,56 @@ function renderBrowser(nextState) {
   const actions = document.createElement("span");
   actions.className = "entry-actions";
   actions.append(
-      entryAction("▶", t("playNow", { name: entry.name }), () => {
+    entryAction("▶", t("playNow", { name: entry.name }), () => playLibraryEntry(entry)),
-        command("item-play", { index: entry.index }, t("loadingNamed", { name: entry.name }));
+    entryAction("＋", t("addNamed", { name: entry.name }), () => addLibraryEntry(entry)),
-      }),
-      entryAction("＋", t("addNamed", { name: entry.name }), () => {
-        command("item-add", { index: entry.index }, t("addingNamed", { name: entry.name }));
-      }),
   );
 
   row.append(icon, name, actions);
   if (entry.kind === "container") {
-      row.addEventListener("click", () => command("browse", { index: entry.index }));
+    row.addEventListener("click", () => activateLibraryEntry(entry));
   } else {
-      row.addEventListener("dblclick", () => {
+    row.addEventListener("dblclick", () => activateLibraryEntry(entry));
-        command("item-play", { index: entry.index }, t("loadingNamed", { name: entry.name }));
-      });
   }
-    row.addEventListener("keydown", (event) => {
+  row.addEventListener("keydown", (event) => handleLibraryEntryKeydown(event, entry));
-      if (event.key === "Enter") {
-        command(
-          entry.kind === "container" ? "browse" : "item-play",
-          { index: entry.index },
-          entry.kind === "track" ? t("loadingNamed", { name: entry.name }) : "",
-        );
-      } else if (event.key === "+") {
-        command("item-add", { index: entry.index }, t("addingNamed", { name: entry.name }));
-      }
-    });
   return row;
-  });
+}
+
+// Renders the current library path and rebuilds changed directory contents.
+function renderBrowser(nextState) {
+  const selectedLibrary = nextState.libraries.find((item) => item.id === nextState.libraryId);
+  const path = [selectedLibrary?.name, ...nextState.browser.path].filter(Boolean);
+  elements.breadcrumb.textContent = path.length ? path.join(" / ") : t("noLibrary");
+  elements.breadcrumb.title = elements.breadcrumb.textContent;
+  elements.libraryUp.disabled = !nextState.browser.canGoUp;
+  elements.libraryEmpty.hidden = nextState.libraries.length > 0;
+
+  const signature = nextState.browser.entries
+    .map((entry) => `${entry.index}:${entry.kind}:${entry.name}`)
+    .join("|");
+  if (elements.libraryEntries.dataset.signature === signature) {
+    return;
+  }
+
+  const rows = nextState.browser.entries.map(createLibraryEntry);
 
   elements.libraryEntries.replaceChildren(...rows);
   elements.libraryEntries.dataset.signature = signature;
 }
 
-function renderTabs(nextState) {
+///////////////////////////////////////////////////////////////////////////////
-  const signature = nextState.tabs
+// Playlist tabs
-    .map((tab) => `${tab.index}:${tab.name}:${tab.count}`)
+///////////////////////////////////////////////////////////////////////////////
-    .join("|");
+
-  if (elements.tabs.dataset.signature !== signature) {
+// Prompts for and submits a new name for an existing playlist tab.
-    const tabs = nextState.tabs.map((tab) => {
+function renameTab(tab) {
+  const newName = window.prompt(t("playlistName"), tab.name);
+  if (newName !== null) {
+    command("tab-rename", { index: tab.index, name: newName });
+  }
+}
+
+// Builds one playlist tab, including its count and optional delete control.
+function createTab(tab, canDelete) {
   const button = document.createElement("button");
   button.className = "tab";
   button.type = "button";
@@ -267,18 +366,16 @@ function renderTabs(nextState) {
   const name = document.createElement("span");
   name.className = "tab-name";
   name.textContent = tab.name === "Default" ? t("defaultPlaylist") : tab.name;
+
   const count = document.createElement("span");
   count.className = "tab-count";
   count.textContent = tab.count;
   button.append(name, count);
 
   button.addEventListener("click", () => command("tab-select", { index: tab.index }));
-      button.addEventListener("dblclick", () => {
+  button.addEventListener("dblclick", () => renameTab(tab));
-        const newName = window.prompt(t("playlistName"), tab.name);
-        if (newName !== null) command("tab-rename", { index: tab.index, name: newName });
-      });
 
-      if (nextState.tabs.length > 1) {
+  if (canDelete) {
     const remove = document.createElement("span");
     remove.className = "tab-delete";
     remove.textContent = "×";
@@ -289,8 +386,18 @@ function renderTabs(nextState) {
     });
     button.append(remove);
   }
+
   return button;
-    });
+}
+
+// Rebuilds changed tabs and marks the server-selected tab as active.
+function renderTabs(nextState) {
+  const signature = nextState.tabs
+    .map((tab) => `${tab.index}:${tab.name}:${tab.count}`)
+    .join("|");
+  if (elements.tabs.dataset.signature !== signature) {
+    const canDelete = nextState.tabs.length > 1;
+    const tabs = nextState.tabs.map((tab) => createTab(tab, canDelete));
     elements.tabs.replaceChildren(...tabs);
     elements.tabs.dataset.signature = signature;
   }
@@ -302,12 +409,31 @@ function renderTabs(nextState) {
   }
 }
 
-function renderPlaylist(nextState) {
+///////////////////////////////////////////////////////////////////////////////
-  const signature = nextState.tracks
+// Playlist tracks
-    .map((track) => `${track.index}:${track.title}:${track.artist}:${track.album}:${track.duration}`)
+///////////////////////////////////////////////////////////////////////////////
-    .join("|");
+
-  if (elements.playlist.dataset.signature !== signature) {
+// Maps playback and deletion keys for a focused playlist row.
-    const rows = nextState.tracks.map((track) => {
+function handlePlaylistRowKeydown(event, track) {
+  if (event.key === "Enter" || event.key === " ") {
+    event.preventDefault();
+    command("play", { index: track.index });
+  } else if (event.key === "Delete") {
+    command("track-remove", { index: track.index });
+  }
+}
+
+// Moves the dragged track to this row and clears the transient drag state.
+function dropTrack(event, track) {
+  event.preventDefault();
+  if (Number.isInteger(draggedTrack) && draggedTrack !== track.index) {
+    command("track-move", { from: draggedTrack, to: track.index });
+  }
+  draggedTrack = null;
+}
+
+// Builds a playlist table row with playback, removal, and drag actions.
+function createPlaylistRow(track) {
   const row = document.createElement("tr");
   row.className = "playlist-row";
   row.tabIndex = 0;
@@ -338,11 +464,12 @@ function renderPlaylist(nextState) {
   const action = document.createElement("td");
   action.className = "action-column";
   const remove = document.createElement("button");
+  const removeTitle = t("removeNamed", { name: track.title });
   remove.className = "row-action";
   remove.type = "button";
   remove.textContent = "×";
-      remove.title = t("removeNamed", { name: track.title });
+  remove.title = removeTitle;
-      remove.setAttribute("aria-label", t("removeNamed", { name: track.title }));
+  remove.setAttribute("aria-label", removeTitle);
   remove.addEventListener("click", (event) => {
     event.stopPropagation();
     command("track-remove", { index: track.index });
@@ -351,25 +478,22 @@ function renderPlaylist(nextState) {
 
   row.append(number, titleCell, album, duration, action);
   row.addEventListener("click", () => command("play", { index: track.index }));
-      row.addEventListener("keydown", (event) => {
+  row.addEventListener("keydown", (event) => handlePlaylistRowKeydown(event, track));
-        if (event.key === "Enter" || event.key === " ") {
+  row.addEventListener("dragstart", () => {
-          event.preventDefault();
+    draggedTrack = track.index;
-          command("play", { index: track.index });
-        } else if (event.key === "Delete") {
-          command("track-remove", { index: track.index });
-        }
   });
-      row.addEventListener("dragstart", () => { draggedTrack = track.index; });
   row.addEventListener("dragover", (event) => event.preventDefault());
-      row.addEventListener("drop", (event) => {
+  row.addEventListener("drop", (event) => dropTrack(event, track));
-        event.preventDefault();
-        if (Number.isInteger(draggedTrack) && draggedTrack !== track.index) {
-          command("track-move", { from: draggedTrack, to: track.index });
-        }
-        draggedTrack = null;
-      });
   return row;
-    });
+}
+
+// Rebuilds changed tracks and updates the active row and playlist summary.
+function renderPlaylist(nextState) {
+  const signature = nextState.tracks
+    .map((track) => `${track.index}:${track.title}:${track.artist}:${track.album}:${track.duration}`)
+    .join("|");
+  if (elements.playlist.dataset.signature !== signature) {
+    const rows = nextState.tracks.map(createPlaylistRow);
     elements.playlist.replaceChildren(...rows);
     elements.playlist.dataset.signature = signature;
   }
@@ -379,20 +503,38 @@ function renderPlaylist(nextState) {
   }
 
   elements.playlistEmpty.hidden = nextState.tracks.length > 0;
-  elements.count.textContent = `${nextState.tracks.length} ${t(nextState.tracks.length === 1 ? "oneTrack" : "manyTracks")}`;
+  const trackLabel = nextState.tracks.length === 1 ? "oneTrack" : "manyTracks";
+  elements.count.textContent = `${nextState.tracks.length} ${t(trackLabel)}`;
   elements.playlistClear.disabled = nextState.tracks.length === 0;
 }
 
-function renderPlayer(nextState) {
+///////////////////////////////////////////////////////////////////////////////
-  const current = Number.isInteger(nextState.currentIndex)
+// Playback state
-    ? nextState.tracks[nextState.currentIndex]
+///////////////////////////////////////////////////////////////////////////////
-    : null;
-  elements.title.textContent = current ? current.title : t("nothingSelected");
-  elements.meta.textContent = current
-    ? [current.artist, current.album].filter(Boolean).join(" · ") || current.source
-    : t("addTrackHint");
 
-  const artworkId = current?.artworkId || "";
+// Returns the selected track, or null when the server has no valid selection.
+function currentTrack(nextState) {
+  if (!Number.isInteger(nextState.currentIndex)) {
+    return null;
+  }
+  return nextState.tracks[nextState.currentIndex] || null;
+}
+
+// Renders the selected track's title and description or the empty-state text.
+function renderCurrentTrack(track) {
+  if (track) {
+    const description = [track.artist, track.album].filter(Boolean).join(" · ");
+    elements.title.textContent = track.title;
+    elements.meta.textContent = description || track.source;
+  } else {
+    elements.title.textContent = t("nothingSelected");
+    elements.meta.textContent = t("addTrackHint");
+  }
+}
+
+// Updates the cover source only when the selected artwork actually changes.
+function renderArtwork(track) {
+  const artworkId = track?.artworkId || "";
   if (elements.coverImage.dataset.artworkId !== artworkId) {
     elements.coverImage.dataset.artworkId = artworkId;
     if (artworkId) {
@@ -405,7 +547,10 @@ function renderPlayer(nextState) {
       elements.coverPlaceholder.hidden = false;
     }
   }
+}
 
+// Reflects playback state and command availability in the transport controls.
+function renderPlaybackControls(nextState) {
   const playing = nextState.state === "playing" || nextState.state === "starting";
   elements.play.textContent = playing ? "Ⅱ" : "▶";
   elements.play.setAttribute("aria-label", t(playing ? "pause" : "play"));
@@ -413,46 +558,67 @@ function renderPlayer(nextState) {
   elements.previous.disabled = nextState.tracks.length === 0;
   elements.next.disabled = nextState.tracks.length === 0;
   elements.stop.disabled = nextState.state === "stopped";
+}
 
+// Updates elapsed time and seek position without disturbing an active drag.
+function renderPosition(nextState) {
   elements.position.textContent = formatTime(nextState.position);
   elements.duration.textContent = formatTime(nextState.duration);
   if (!seekBusy) {
-    elements.seek.value = nextState.duration
+    let percentage = 0;
-      ? Math.min(100, (nextState.position / nextState.duration) * 100)
+    if (nextState.duration) {
-      : 0;
+      percentage = Math.min(100, (nextState.position / nextState.duration) * 100);
+    }
+    elements.seek.value = percentage;
   }
   elements.seek.disabled = !nextState.duration;
+}
 
+// Synchronizes the volume slider, value display, and accessible label.
+function renderVolume(nextState) {
   elements.volume.value = nextState.volume;
   elements.volumeValue.value = `${Math.round(nextState.volume)}%`;
   elements.volumeToggle.setAttribute(
     "aria-label",
     t("volumePercent", { value: Math.round(nextState.volume) }),
   );
+}
+
+// Shows the active repeat mode and its translated description.
+function renderRepeatMode(nextState) {
   elements.repeat.dataset.repeat = nextState.repeat;
   elements.repeat.classList.toggle("active", nextState.repeat !== "off");
   const repeatNames = { off: t("repeatOff"), all: t("repeatAll"), one: t("repeatOne") };
   elements.repeat.title = repeatNames[nextState.repeat] || repeatNames.off;
+}
 
+// Renders the technical properties reported for the current audio source.
+function renderAudioDetails(nextState) {
   elements.bits.textContent = nextState.bits ? `${nextState.bits} bit` : "— bit";
   elements.rate.textContent = nextState.rate ? `${(nextState.rate / 1000).toFixed(1)} kHz` : "— kHz";
-  elements.channels.textContent = nextState.channels
+  if (nextState.channels) {
-    ? `${nextState.channels} ${t(nextState.channels === 1 ? "oneChannel" : "channels")}`
+    const channelLabel = nextState.channels === 1 ? "oneChannel" : "channels";
-    : `— ${t("channels")}`;
+    elements.channels.textContent = `${nextState.channels} ${t(channelLabel)}`;
+  } else {
+    elements.channels.textContent = `— ${t("channels")}`;
+  }
   elements.format.textContent = nextState.format || "—";
   elements.source.textContent = nextState.source || "—";
 }
 
-elements.coverImage.addEventListener("error", () => {
+// Delegates the player portion of a state snapshot to its visible subregions.
-  elements.coverImage.hidden = true;
+function renderPlayer(nextState) {
-  elements.coverPlaceholder.hidden = false;
+  const track = currentTrack(nextState);
-});
+  renderCurrentTrack(track);
-
+  renderArtwork(track);
-elements.coverImage.addEventListener("load", () => {
+  renderPlaybackControls(nextState);
-  elements.coverImage.hidden = false;
+  renderPosition(nextState);
-  elements.coverPlaceholder.hidden = true;
+  renderVolume(nextState);
-});
+  renderRepeatMode(nextState);
+  renderAudioDetails(nextState);
+}
 
+// Stores and renders one complete state snapshot returned by the server.
 function render(nextState) {
   state = nextState;
   renderSelectors(nextState);
@@ -460,81 +626,132 @@ function render(nextState) {
   renderTabs(nextState);
   renderPlaylist(nextState);
   renderPlayer(nextState);
-  setStatus(nextState.error || (nextState.discovering ? t("searchingPlayers") : ""));
+  if (nextState.error) {
+    setStatus(t(nextState.error));
+  } else {
+    setStatus(nextState.discovering ? t("searchingPlayers") : "");
+  }
 }
 
-elements.play.addEventListener("click", () => {
+///////////////////////////////////////////////////////////////////////////////
-  if (!state) return;
+// User interaction and polling
-  const playing = state.state === "playing" || state.state === "starting";
+///////////////////////////////////////////////////////////////////////////////
-  command(playing ? "pause" : state.state === "paused" ? "resume" : "play");
+
-});
+// Chooses whether the play button must start, resume, or pause playback.
-elements.previous.addEventListener("click", () => command("previous"));
+function commandForPlayButton(playbackState) {
-elements.stop.addEventListener("click", () => command("stop"));
+  const playing = playbackState.state === "playing" || playbackState.state === "starting";
-elements.next.addEventListener("click", () => command("next"));
+  if (playing) {
-elements.repeat.addEventListener("click", () => {
+    return "pause";
-  if (!state) return;
+  }
-  const next = state.repeat === "off" ? "all" : state.repeat === "all" ? "one" : "off";
+  if (playbackState.state === "paused") {
-  command("repeat", { mode: next });
+    return "resume";
-});
+  }
-elements.renderer.addEventListener("change", () => command("renderer", { id: elements.renderer.value }));
+  return "play";
-elements.language.value = window.RktTranslate.language();
+}
-elements.language.addEventListener("change", async () => {
+
+// Sends the command represented by the play button in the current state.
+function handlePlay() {
+  if (state) {
+    command(commandForPlayButton(state));
+  }
+}
+
+// Advances repeat mode through off, all tracks, and one track.
+function nextRepeatMode(currentMode) {
+  if (currentMode === "off") {
+    return "all";
+  }
+  if (currentMode === "all") {
+    return "one";
+  }
+  return "off";
+}
+
+// Sends the next repeat mode when state has already been received.
+function handleRepeat() {
+  if (state) {
+    command("repeat", { mode: nextRepeatMode(state.repeat) });
+  }
+}
+
+// Applies and persists the language selected in the browser.
+async function handleLanguageChange() {
   window.RktTranslate.setLanguage(elements.language.value);
   try {
     await api("/api/preferences", { language: elements.language.value });
   } catch (error) {
-    setStatus(error.message);
+    setStatus(errorMessage(error));
   }
-});
+}
-window.addEventListener("rkt-language-change", () => {
+
+// Invalidates translated collections and rerenders them in the new language.
+function handleTranslationChange() {
   elements.language.value = window.RktTranslate.language();
-  for (const element of [elements.renderer, elements.libraryEntries, elements.tabs, elements.playlist]) {
+  const translatedElements = [
+    elements.renderer,
+    elements.libraryEntries,
+    elements.tabs,
+    elements.playlist,
+  ];
+  for (const element of translatedElements) {
     delete element.dataset.signature;
   }
-  if (state) render(state);
+  if (state) {
-});
+    render(state);
-elements.discover.addEventListener("click", async () => {
+  }
+}
+
+// Starts renderer discovery and renders the state returned by the server.
+async function discoverRenderers() {
   try {
     render(await api("/api/discover", {}));
   } catch (error) {
-    setStatus(error.message);
+    setStatus(errorMessage(error));
   }
-});
+}
-elements.volumeToggle.addEventListener("click", () => {
+
-  const open = !elements.volumeControl.classList.contains("open");
+// Opens or closes the volume popover and keeps its ARIA state synchronized.
+function setVolumeControlOpen(open) {
   elements.volumeControl.classList.toggle("open", open);
   elements.volumeToggle.setAttribute("aria-expanded", String(open));
-  if (open) elements.volume.focus();
+}
-});
+
-elements.volume.addEventListener("input", () => {
+// Toggles the volume popover and moves focus to its slider when opened.
-  elements.volumeValue.value = `${elements.volume.value}%`;
+function toggleVolumeControl() {
-});
+  const open = !elements.volumeControl.classList.contains("open");
-elements.volume.addEventListener("change", () => command("volume", { value: Number(elements.volume.value) }));
+  setVolumeControlOpen(open);
-document.addEventListener("pointerdown", (event) => {
+  if (open) {
-  if (!elements.volumeControl.contains(event.target)) {
+    elements.volume.focus();
-    elements.volumeControl.classList.remove("open");
-    elements.volumeToggle.setAttribute("aria-expanded", "false");
   }
-});
+}
-document.addEventListener("keydown", (event) => {
+
+// Closes the volume popover when the pointer is pressed outside its controls.
+function closeVolumeControlOnOutsideClick(event) {
+  if (!elements.volumeControl.contains(event.target)) {
+    setVolumeControlOpen(false);
+  }
+}
+
+// Closes the volume popover with Escape and returns focus to its button.
+function closeVolumeControlOnEscape(event) {
   if (event.key === "Escape" && elements.volumeControl.classList.contains("open")) {
-    elements.volumeControl.classList.remove("open");
+    setVolumeControlOpen(false);
-    elements.volumeToggle.setAttribute("aria-expanded", "false");
     elements.volumeToggle.focus();
   }
-});
+}
-elements.seek.addEventListener("pointerdown", () => { seekBusy = true; });
+
-elements.seek.addEventListener("change", () => {
+// Sends the chosen seek percentage and permits polling to update the slider again.
+function seek() {
   seekBusy = false;
   command("seek", { percentage: Number(elements.seek.value) });
-});
+}
-elements.library.addEventListener("change", () => command("library", { id: elements.library.value }));
-elements.libraryUp.addEventListener("click", () => command("up"));
-elements.tabAdd.addEventListener("click", () => command("tab-add"));
-elements.playlistClear.addEventListener("click", () => command("playlist-clear"));
 
+// Polls a complete state snapshot unless a browser command is still active.
 async function refresh() {
-  if (commandBusy) return;
+  if (commandBusy) {
+    return;
+  }
+
   try {
     render(await api("/api/state"));
     hideLogin();
@@ -542,12 +759,13 @@ async function refresh() {
     if (error.code === "authentication-required") {
       showLogin();
     } else {
-      setStatus(t("noConnection", { message: error.message }));
+      setStatus(t("noConnection", { message: errorMessage(error) }));
     }
   }
 }
 
-elements.loginForm.addEventListener("submit", async (event) => {
+// Authenticates the entered credentials, then refreshes session and player state.
+async function login(event) {
   event.preventDefault();
   elements.loginSubmit.disabled = true;
   elements.loginError.textContent = "";
@@ -560,22 +778,69 @@ elements.loginForm.addEventListener("submit", async (event) => {
     await refreshAuth();
     await refresh();
   } catch (error) {
-    showLogin(error.message);
+    showLogin(errorMessage(error));
     elements.loginPassword.select();
   } finally {
     elements.loginSubmit.disabled = false;
   }
-});
+}
 
-elements.logout.addEventListener("click", async () => {
+// Ends the server session and returns the browser to the login overlay.
+async function logout() {
   try {
     await api("/api/auth/logout", {});
   } finally {
     elements.logout.hidden = true;
     showLogin(t("loggedOut"));
   }
-});
+}
 
+///////////////////////////////////////////////////////////////////////////////
+// Event registration and initialization
+///////////////////////////////////////////////////////////////////////////////
+
+elements.coverImage.addEventListener("error", () => {
+  elements.coverImage.hidden = true;
+  elements.coverPlaceholder.hidden = false;
+});
+elements.coverImage.addEventListener("load", () => {
+  elements.coverImage.hidden = false;
+  elements.coverPlaceholder.hidden = true;
+});
+elements.play.addEventListener("click", handlePlay);
+elements.previous.addEventListener("click", () => command("previous"));
+elements.stop.addEventListener("click", () => command("stop"));
+elements.next.addEventListener("click", () => command("next"));
+elements.repeat.addEventListener("click", handleRepeat);
+elements.renderer.addEventListener("change", () => {
+  command("renderer", { id: elements.renderer.value });
+});
+elements.language.addEventListener("change", handleLanguageChange);
+window.addEventListener("rkt-language-change", handleTranslationChange);
+elements.discover.addEventListener("click", discoverRenderers);
+elements.volumeToggle.addEventListener("click", toggleVolumeControl);
+elements.volume.addEventListener("input", () => {
+  elements.volumeValue.value = `${elements.volume.value}%`;
+});
+elements.volume.addEventListener("change", () => {
+  command("volume", { value: Number(elements.volume.value) });
+});
+document.addEventListener("pointerdown", closeVolumeControlOnOutsideClick);
+document.addEventListener("keydown", closeVolumeControlOnEscape);
+elements.seek.addEventListener("pointerdown", () => {
+  seekBusy = true;
+});
+elements.seek.addEventListener("change", seek);
+elements.library.addEventListener("change", () => {
+  command("library", { id: elements.library.value });
+});
+elements.libraryUp.addEventListener("click", () => command("up"));
+elements.tabAdd.addEventListener("click", () => command("tab-add"));
+elements.playlistClear.addEventListener("click", () => command("playlist-clear"));
+elements.loginForm.addEventListener("submit", login);
+elements.logout.addEventListener("click", logout);
+
+elements.language.value = window.RktTranslate.language();
 refreshAuth();
 refresh();
 setInterval(refresh, 1000);

public/translate.js

@@ -25,6 +25,12 @@
       channels: "channels", oneChannel: "channel", searchingPlayers: "Searching for network players…",
       authUnknown: "Authentication status unknown: {message}", noConnection: "No connection: {message}",
       loggedOut: "You have been logged out.", volumePercent: "Set volume, {value} percent",
+      "login-rate-limited": "Too many failed sign-in attempts; try again in a few minutes.",
+      "invalid-credentials": "Invalid username or password.",
+      "json-required": "Content-Type application/json is required.",
+      "authentication-required": "Sign-in is required.",
+      "dlna-renderer-no-start-of-track-confirmation": "The DLNA renderer did not confirm the start of the track.",
+      "dlna-renderer-unreachable": "The DLNA renderer is unreachable.",
     },
     nl: {
       output: "UITVOER", searchPlayers: "Netwerkspelers zoeken", logout: "UITLOGGEN",
@@ -49,6 +55,12 @@
       channels: "kanalen", oneChannel: "kanaal", searchingPlayers: "Netwerkspelers zoeken…",
       authUnknown: "Authenticatiestatus onbekend: {message}", noConnection: "Geen verbinding: {message}",
       loggedOut: "Je bent uitgelogd.", volumePercent: "Volume instellen, {value} procent",
+      "login-rate-limited": "Te veel mislukte aanmeldpogingen; probeer het over enkele minuten opnieuw.",
+      "invalid-credentials": "Ongeldige gebruikersnaam of ongeldig wachtwoord.",
+      "json-required": "Content-Type application/json is vereist.",
+      "authentication-required": "Aanmelden is vereist.",
+      "dlna-renderer-no-start-of-track-confirmation": "De DLNA-renderer bevestigde de start van de track niet.",
+      "dlna-renderer-unreachable": "De DLNA-renderer is niet bereikbaar.",
     },
     de: {
       output: "AUSGABE", searchPlayers: "Netzwerkplayer suchen", logout: "ABMELDEN",
@@ -73,6 +85,12 @@
       channels: "Kanäle", oneChannel: "Kanal", searchingPlayers: "Netzwerkplayer werden gesucht…",
       authUnknown: "Authentifizierungsstatus unbekannt: {message}", noConnection: "Keine Verbindung: {message}",
       loggedOut: "Sie wurden abgemeldet.", volumePercent: "Lautstärke einstellen, {value} Prozent",
+      "login-rate-limited": "Zu viele fehlgeschlagene Anmeldeversuche; versuchen Sie es in einigen Minuten erneut.",
+      "invalid-credentials": "Ungültiger Benutzername oder ungültiges Passwort.",
+      "json-required": "Content-Type application/json ist erforderlich.",
+      "authentication-required": "Eine Anmeldung ist erforderlich.",
+      "dlna-renderer-no-start-of-track-confirmation": "Der DLNA-Renderer hat den Start des Titels nicht bestätigt.",
+      "dlna-renderer-unreachable": "Der DLNA-Renderer ist nicht erreichbar.",
     },
     fr: {
       output: "SORTIE", searchPlayers: "Rechercher les lecteurs réseau", logout: "DÉCONNEXION",
@@ -97,6 +115,12 @@
       channels: "canaux", oneChannel: "canal", searchingPlayers: "Recherche des lecteurs réseau…",
       authUnknown: "État d’authentification inconnu : {message}", noConnection: "Aucune connexion : {message}",
       loggedOut: "Vous avez été déconnecté.", volumePercent: "Régler le volume, {value} pour cent",
+      "login-rate-limited": "Trop de tentatives de connexion ont échoué ; réessayez dans quelques minutes.",
+      "invalid-credentials": "Nom d’utilisateur ou mot de passe incorrect.",
+      "json-required": "Le Content-Type application/json est requis.",
+      "authentication-required": "La connexion est requise.",
+      "dlna-renderer-no-start-of-track-confirmation": "Le lecteur DLNA n’a pas confirmé le démarrage de la piste.",
+      "dlna-renderer-unreachable": "Le lecteur DLNA est inaccessible.",
     },
     es: {
       output: "SALIDA", searchPlayers: "Buscar reproductores de red", logout: "CERRAR SESIÓN",
@@ -121,6 +145,12 @@
       channels: "canales", oneChannel: "canal", searchingPlayers: "Buscando reproductores de red…",
       authUnknown: "Estado de autenticación desconocido: {message}", noConnection: "Sin conexión: {message}",
       loggedOut: "Has cerrado la sesión.", volumePercent: "Ajustar volumen, {value} por ciento",
+      "login-rate-limited": "Demasiados intentos de inicio de sesión fallidos; inténtalo de nuevo en unos minutos.",
+      "invalid-credentials": "Nombre de usuario o contraseña no válidos.",
+      "json-required": "Se requiere Content-Type application/json.",
+      "authentication-required": "Es necesario iniciar sesión.",
+      "dlna-renderer-no-start-of-track-confirmation": "El renderizador DLNA no confirmó el inicio de la pista.",
+      "dlna-renderer-unreachable": "No se puede acceder al renderizador DLNA.",
     },
     it: {
       output: "USCITA", searchPlayers: "Cerca lettori di rete", logout: "ESCI",
@@ -145,6 +175,12 @@
       channels: "canali", oneChannel: "canale", searchingPlayers: "Ricerca dei lettori di rete…",
       authUnknown: "Stato di autenticazione sconosciuto: {message}", noConnection: "Nessuna connessione: {message}",
       loggedOut: "Hai effettuato la disconnessione.", volumePercent: "Regola il volume, {value} percento",
+      "login-rate-limited": "Troppi tentativi di accesso non riusciti; riprova tra qualche minuto.",
+      "invalid-credentials": "Nome utente o password non validi.",
+      "json-required": "È richiesto Content-Type application/json.",
+      "authentication-required": "È necessario effettuare l’accesso.",
+      "dlna-renderer-no-start-of-track-confirmation": "Il renderer DLNA non ha confermato l’avvio della traccia.",
+      "dlna-renderer-unreachable": "Il renderer DLNA non è raggiungibile.",
     },
     sv: {
       output: "UTGÅNG", searchPlayers: "Sök efter nätverksspelare", logout: "LOGGA UT",
@@ -169,6 +205,12 @@
       channels: "kanaler", oneChannel: "kanal", searchingPlayers: "Söker efter nätverksspelare…",
       authUnknown: "Okänd autentiseringsstatus: {message}", noConnection: "Ingen anslutning: {message}",
       loggedOut: "Du har loggats ut.", volumePercent: "Ställ in volymen på {value} procent",
+      "login-rate-limited": "För många misslyckade inloggningsförsök; försök igen om några minuter.",
+      "invalid-credentials": "Ogiltigt användarnamn eller lösenord.",
+      "json-required": "Content-Type application/json krävs.",
+      "authentication-required": "Inloggning krävs.",
+      "dlna-renderer-no-start-of-track-confirmation": "DLNA-renderaren bekräftade inte att spåret startade.",
+      "dlna-renderer-unreachable": "DLNA-renderaren kan inte nås.",
     },
     no: {
       output: "UTGANG", searchPlayers: "Søk etter nettverksspillere", logout: "LOGG UT",
@@ -193,6 +235,12 @@
       channels: "kanaler", oneChannel: "kanal", searchingPlayers: "Søker etter nettverksspillere…",
       authUnknown: "Ukjent autentiseringsstatus: {message}", noConnection: "Ingen tilkobling: {message}",
       loggedOut: "Du er logget ut.", volumePercent: "Still inn volumet på {value} prosent",
+      "login-rate-limited": "For mange mislykkede innloggingsforsøk; prøv igjen om noen minutter.",
+      "invalid-credentials": "Ugyldig brukernavn eller passord.",
+      "json-required": "Content-Type application/json er påkrevd.",
+      "authentication-required": "Innlogging er påkrevd.",
+      "dlna-renderer-no-start-of-track-confirmation": "DLNA-gjengiveren bekreftet ikke at sporet startet.",
+      "dlna-renderer-unreachable": "DLNA-gjengiveren kan ikke nås.",
     },
     fi: {
       output: "ULOSTULO", searchPlayers: "Etsi verkkosoittimia", logout: "KIRJAUDU ULOS",
@@ -217,6 +265,12 @@
       channels: "kanavaa", oneChannel: "kanava", searchingPlayers: "Etsitään verkkosoittimia…",
       authUnknown: "Todennuksen tila ei ole tiedossa: {message}", noConnection: "Ei yhteyttä: {message}",
       loggedOut: "Olet kirjautunut ulos.", volumePercent: "Säädä äänenvoimakkuudeksi {value} prosenttia",
+      "login-rate-limited": "Liian monta epäonnistunutta kirjautumisyritystä; yritä uudelleen muutaman minuutin kuluttua.",
+      "invalid-credentials": "Virheellinen käyttäjänimi tai salasana.",
+      "json-required": "Content-Type application/json vaaditaan.",
+      "authentication-required": "Kirjautuminen vaaditaan.",
+      "dlna-renderer-no-start-of-track-confirmation": "DLNA-toistin ei vahvistanut kappaleen käynnistymistä.",
+      "dlna-renderer-unreachable": "DLNA-toistimeen ei saada yhteyttä.",
     },
     is: {
       output: "ÚTTAK", searchPlayers: "Leita að netspilurum", logout: "SKRÁ ÚT",
@@ -241,6 +295,12 @@
       channels: "rásir", oneChannel: "rás", searchingPlayers: "Leita að netspilurum…",
       authUnknown: "Staða auðkenningar óþekkt: {message}", noConnection: "Engin tenging: {message}",
       loggedOut: "Þú hefur skráð þig út.", volumePercent: "Stilla hljóðstyrk á {value} prósent",
+      "login-rate-limited": "Of margar misheppnaðar innskráningartilraunir; reyndu aftur eftir nokkrar mínútur.",
+      "invalid-credentials": "Ógilt notandanafn eða lykilorð.",
+      "json-required": "Content-Type application/json er áskilið.",
+      "authentication-required": "Innskráningar er krafist.",
+      "dlna-renderer-no-start-of-track-confirmation": "DLNA-spilarinn staðfesti ekki að spilun lagsins hefði hafist.",
+      "dlna-renderer-unreachable": "Ekki næst samband við DLNA-spilarann.",
     },
   };
 

rkt-web-player.ini.example

@@ -6,6 +6,7 @@ port=8080
 dlna-port=8734
 ; Set to false when the server itself must not appear as an audio output.
 local-output=true
+; playlist-keystore=./data/playlists.keystore
 
 [libraries]
 ; muziek=D:\Muziek
@@ -29,3 +30,9 @@ session-seconds=604800
 ;
 ; hans=$argon2id$v=19$m=19456,t=2,p=1$...
 ;
+
+[logging]
+; log-file=./data/rkt-web-player.log 
+; log-retention-days=7
+; log-level=debug
+