diff --git a/.gitignore b/.gitignore index 746f237..1bb8cbc 100644 --- a/.gitignore +++ b/.gitignore @@ -26,3 +26,7 @@ rkt-web-player.ini # Runtime playlist keystore data/*.keystore* /.scribble-build + +# Logging +*.log +*.log.* diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md index 725bf7b..b0132fe 100644 --- a/ARCHITECTURE.md +++ b/ARCHITECTURE.md @@ -47,9 +47,9 @@ flowchart TB Audio[racket-audio
local backend] Discovery[racket-upnp + racket-sonos
device discovery] DLNA[racket-audio-dlna
transport, seeking and media publication] - AgentGUI[private/player-agent-gui.rkt
GUI adapter] + AgentGUI[private-player-agent/player-agent-gui.rkt
GUI adapter] AgentCLI[player-agent-cli.rkt
CLI adapter] - AgentCore[private/player-agent-core.rkt
polling and audio runtime] + AgentCore[private-player-agent/player-agent-core.rkt
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. -This matches the intended one-player-per-process deployment, but it prevents -multiple independent player instances from being served safely within the same -Racket process. +The server module creates one request-dispatcher closure for each `serve-player` +call. That closure captures its player and authentication manager and binds them +to every HTTP handler. No player or authentication state is stored in module +variables, so independent server instances do not overwrite each other's +context within the same Racket process. ## 6. Configuration and deployment diff --git a/README.md b/README.md index 3cb2765..b219121 100644 --- a/README.md +++ b/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 ``` diff --git a/info.rkt b/info.rkt index c8acfbe..43e8fb6 100644 --- a/info.rkt +++ b/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")) diff --git a/main.rkt b/main.rkt index 3e66245..6cb1a89 100644 --- a/main.rkt +++ b/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)))) - (if section - (for/list ((line (in-list (cdr section))) - #:when (and (pair? line) - (eq? (car line) 'keyval))) - (cons (symbol->string (cadr line)) - (caddr line))) - '()))) + (map (λ (key) + (cons (symbol->string key) + (ini-get config section-name key #f))) + (ini-keys config section-name))) (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))) + ) +) diff --git a/player-agent-cli.rkt b/player-agent-cli.rkt index d9639f2..928d87d 100644 --- a/player-agent-cli.rkt +++ b/player-agent-cli.rkt @@ -5,8 +5,8 @@ racket/format racket/string simple-log - "private/player-agent-config.rkt" - "private/player-agent-core.rkt") + "private-player-agent/player-agent-config.rkt" + "private-player-agent/player-agent-core.rkt") (provide run-player-agent-cli) diff --git a/player-agent.rkt b/player-agent.rkt index 8f466cb..e88c295 100644 --- a/player-agent.rkt +++ b/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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/private/player-agent-config.rkt b/private-player-agent/player-agent-config.rkt similarity index 96% rename from private/player-agent-config.rkt rename to private-player-agent/player-agent-config.rkt index 0624a74..c3ff1a8 100644 --- a/private/player-agent-config.rkt +++ b/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) diff --git a/private/player-agent-core.rkt b/private-player-agent/player-agent-core.rkt similarity index 77% rename from private/player-agent-core.rkt rename to private-player-agent/player-agent-core.rkt index df96f74..69e316f 100644 --- a/private/player-agent-core.rkt +++ b/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: -; Procedures keep the mutable audio and polling state private without -; introducing a class or a second generic backend abstraction. +; internals: make-player-agent-runtime stores its local start!, reconnect!, +; shutdown!, snapshot and current-track procedures in this struct. +; 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: -; One closure owns the simple mutable state shared by polling, -; command and audio callbacks. Keeping these procedures together -; makes their synchronization and cleanup order directly visible. +; internals: start! launches poll-loop, which registers through post-json and +; sends snapshots until it receives a command. A command worker runs +; execute-command! and acknowledges it only after completion. +; 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)))) - (unless (equal? (car entry) keep-key) - (safe-delete-file (cdr entry)) - (hash-remove! cached-media (car entry))))) + (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)))) + (loop (cdr remaining))))) - ;; Decoder EOF occurs before audible EOF. Queueing the prefetched decoder at - ;; this point appends it behind racket-audio's remaining output buffer. + ;;; Continues with prefetched media when the current decoder reaches EOF. + ;;; 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)))) - (unless (or (equal? (car entry) current-media-key) - (equal? (car entry) key)) - (safe-delete-file (cdr entry)) - (hash-remove! cached-media (car entry)))))) + (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)))) + (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))) - (safe-delete-file path)) + (let loop ((paths (hash-values cached-media))) + (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))) diff --git a/private/player-agent-gui.rkt b/private-player-agent/player-agent-gui.rkt similarity index 98% rename from private/player-agent-gui.rkt rename to private-player-agent/player-agent-gui.rkt index fb64f14..2ed3909 100644 --- a/private/player-agent-gui.rkt +++ b/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) diff --git a/private/translate.rkt b/private-player-agent/player-agent-translate.rkt similarity index 98% rename from private/translate.rkt rename to private-player-agent/player-agent-translate.rkt index c31cfd1..705163d 100644 --- a/private/translate.rkt +++ b/private-player-agent/player-agent-translate.rkt @@ -335,6 +335,10 @@ (define (__ id) (tr id)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests for module library.rkt +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (module+ test (require rackunit) diff --git a/private/dlna-playback.rkt b/private/dlna-playback.rkt index 956c2b8..53cd690 100644 --- a/private/dlna-playback.rkt +++ b/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) - (and (number? position) (> position 0)))) + (cond + ((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) - (list-ref (current-tracks playback) index))) + (if (valid-index? 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 - second - ((if (eq? (system-type 'os) 'windows) - string-ci=? - string=?) - (normalized-file first) - (normalized-file second)))) - -(define (next-index playback index) - (define count (length (current-tracks playback))) (cond - ((zero? count) #f) - ((eq? (dlna-playback-repeat playback) 'one) index) - ((< (+ index 1) count) (+ index 1)) - ((eq? (dlna-playback-repeat playback) 'all) 0) - (else #f))) - -(define (track-index-for-info playback info) - (define info-track (dlna-info-track info)) - (define file (and info-track (dlna-track-info-file info-track))) - (define prepared (dlna-playback-prepared-index playback)) - (cond - ((and (valid-index? playback prepared) - (same-file? file (track-file (track-at playback prepared)))) - prepared) + ((eq? first #f) #f) + ((eq? second #f) #f) (else - (for/first ((item (in-list (current-tracks playback))) - (index (in-naturals)) - #:when (same-file? file (track-file item))) - index)))) + (let ((same-path? (if (eq? (system-type 'os) 'windows) + string-ci=? + string=?))) + (same-path? (normalized-file first) + (normalized-file second)))))) +;;; Selects the following playlist index according to the repeat setting. +(define (next-index playback index) + (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)))) + +;;; 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) + (let* ((info-track (dlna-info-track info)) + (file (if (eq? info-track #f) + #f + (dlna-track-info-file info-track))) + (prepared (dlna-playback-prepared-index playback))) + (if (and (valid-index? playback prepared) + (same-file? file (track-file (track-at playback prepared)))) + prepared + (let loop ((remaining (current-tracks playback)) + (index 0)) + (cond + ((null? remaining) #f) + ((same-file? file (track-file (car remaining))) index) + (else + (loop (cdr remaining) (add1 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,159 +152,169 @@ (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)) - (when (valid-index? playback current) - (define following (next-index playback current)) - (cond - ((not following) - (set-dlna-playback-prepared-index! playback #f)) - ((not (equal? following (dlna-playback-prepared-index playback))) - (with-handlers - ((exn:fail? - (λ (exception) - (set-dlna-playback-prepared-index! playback #f) - (warn-web-player-dlna - "Could not prepare next DLNA track: ~a" - (exn-message exception))))) - (dlna-player-set-next-file! - (dlna-playback-player playback) - (track-file (track-at playback following))) - (set-dlna-playback-prepared-index! playback following)))))) + (let ((current (dlna-playback-current-index playback))) + (when (valid-index? playback current) + (let ((following (next-index playback current))) + (cond + ((eq? following #f) + (set-dlna-playback-prepared-index! playback #f)) + ((not (equal? following (dlna-playback-prepared-index playback))) + (with-handlers + ((exn:fail? + (λ (exception) + (set-dlna-playback-prepared-index! playback #f) + (warn-web-player-dlna + "Could not prepare next DLNA track: ~a" + (exn-message exception))))) + (dlna-player-set-next-file! + (dlna-playback-player playback) + (track-file (track-at playback following))) + (set-dlna-playback-prepared-index! playback following)))))))) +;;; Starts one playlist item while the caller holds the playback lock. (define (play-index/locked! playback index) - (define item (track-at playback index)) - (unless item - (raise-arguments-error - 'dlna-playback-play-index! - "track index is outside the playlist" - "index" index)) - (with-handlers - ((exn:fail? - (λ (exception) - (report-failure! playback (exn-message exception)) - (raise exception)))) - (dlna-player-play! (dlna-playback-player playback) (track-file item)) - (define info (dlna-player-info (dlna-playback-player playback))) - (set-dlna-playback-current-index! playback index) - (set-dlna-playback-current-uri! playback (dlna-info-uri info)) - (set-dlna-playback-prepared-index! playback #f) - (set-dlna-playback-playing-seen?! playback #t) - (set-dlna-playback-progress-seen?! playback #f) - (set-dlna-playback-failure-active?! playback #f) - (set-dlna-playback-play-request-ms! playback (now-ms)) - (set-dlna-playback-stop-requested?! playback #f) - (set-dlna-playback-stopped-polls! playback 0) - (notify! playback 'starting info) - (prepare-next! playback))) + (let ((item (track-at playback index))) + (unless item + (raise-arguments-error + 'dlna-playback-play-index! + "track index is outside the playlist" + "index" index)) + (with-handlers + ((exn:fail? + (λ (exception) + (report-failure! playback (exn-message exception)) + (raise exception)))) + (dlna-player-play! (dlna-playback-player playback) (track-file item)) + (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) + (set-dlna-playback-playing-seen?! playback #t) + (set-dlna-playback-progress-seen?! playback #f) + (set-dlna-playback-failure-active?! playback #f) + (set-dlna-playback-play-request-ms! playback (now-ms)) + (set-dlna-playback-stop-requested?! playback #f) + (set-dlna-playback-stopped-polls! playback 0) + (notify! playback 'starting info) + (prepare-next! playback))))) +;;; Updates the current index when renderer metadata identifies another track. (define (update-current-track! playback info) - (define index (track-index-for-info playback info)) - (when (valid-index? playback index) - (unless (equal? index (dlna-playback-current-index playback)) - (set-dlna-playback-progress-seen?! playback #f) - (set-dlna-playback-play-request-ms! playback (now-ms))) - (set-dlna-playback-current-index! playback index) - (set-dlna-playback-prepared-index! playback #f) - (prepare-next! playback))) + (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)))) +;;; Advances to the next track or stops when the playlist has ended. (define (advance! playback) - (define current (dlna-playback-current-index playback)) - (define following (and (valid-index? playback current) - (next-index playback current))) - (if following - (play-index/locked! playback following) - (begin - (dlna-player-stop! (dlna-playback-player playback)) - (notify! playback - 'stopped - (dlna-player-info (dlna-playback-player playback)))))) + (let* ((current (dlna-playback-current-index playback)) + (following (if (valid-index? playback current) + (next-index playback current) + #f))) + (if (eq? following #f) + (begin + (dlna-player-stop! (dlna-playback-player playback)) + (notify! playback + 'stopped + (dlna-player-info (dlna-playback-player playback)))) + (play-index/locked! playback following)))) -(define (poll/locked! playback) - (define info (dlna-player-info (dlna-playback-player playback))) - (cond - ((not (dlna-info-reachable? info)) - (when (dlna-playback-reachable? playback) - (set-dlna-playback-reachable?! playback #f) - ((dlna-playback-error playback) "De DLNA-renderer is niet bereikbaar"))) - (else - (set-dlna-playback-reachable?! playback #t) - (define state (normalize-state (dlna-info-state info))) - (define uri (dlna-info-uri info)) - (define position (dlna-info-position info)) - (define failed-now? #f) - - (when (and (string? uri) - (not (string=? uri "")) - (not (equal? uri (dlna-playback-current-uri playback)))) - (set-dlna-playback-current-uri! playback uri) - (set-dlna-playback-stopped-polls! playback 0) - (update-current-track! playback info)) - - (when (renderer-confirms-playback? state position) - (set-dlna-playback-progress-seen?! playback #t)) - - (when (and (dlna-playback-playing-seen? playback) - (not (dlna-playback-progress-seen? playback)) - (dlna-playback-play-request-ms playback) - (>= (- (now-ms) - (dlna-playback-play-request-ms playback)) - playback-start-timeout-ms)) - (set! failed-now? #t) - (warn-web-player-dlna - "DLNA start was not confirmed: state=~a position=~a uri=~a" - state position (or uri "")) - (report-failure! - playback - "De DLNA-renderer bevestigde de start van de track niet")) - - (unless (or failed-now? (dlna-playback-failure-active? playback)) +;;; Processes one successful renderer poll while the playback lock is held. +;;; It updates track identity, start confirmation and end-of-track handling. +(define (poll-reachable/locked! playback info) + (let ((state (normalize-state (dlna-info-state info))) + (uri (dlna-info-uri info)) + (position (dlna-info-position info))) + (set-dlna-playback-reachable?! playback #t) + (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)) + (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)) + elapsed-ms + (>= elapsed-ms playback-start-timeout-ms)))) + ;;; Handles a stopped renderer after start and progress checks complete. + (define (handle-stopped!) + (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 + 'dlna-renderer-no-start-of-track-confirmation)) + (unless (or failed-now? (dlna-playback-failure-active? playback)) + (cond + ((eq? state 'playing) + (set-dlna-playback-playing-seen?! playback #t) + (set-dlna-playback-stopped-polls! playback 0)) + ((and (eq? state 'stopped) + (dlna-playback-stop-requested? playback)) + (set-dlna-playback-stop-requested?! playback #f) + (set-dlna-playback-stopped-polls! playback 0)) + ((and (eq? state 'stopped) + (dlna-playback-playing-seen? playback)) + (handle-stopped!)))) + (notify! + playback (cond - ((eq? state 'playing) - (set-dlna-playback-playing-seen?! playback #t) - (set-dlna-playback-stopped-polls! playback 0)) - ((and (eq? state 'stopped) - (dlna-playback-stop-requested? playback)) - (set-dlna-playback-stop-requested?! playback #f) - (set-dlna-playback-stopped-polls! playback 0)) - ((and (eq? state 'stopped) - (dlna-playback-playing-seen? playback)) - (cond - ((and (not (dlna-playback-progress-seen? playback)) - (dlna-playback-play-request-ms playback) - (< (- (now-ms) - (dlna-playback-play-request-ms playback)) - 5000)) - (void)) - ((not (dlna-playback-progress-seen? playback)) - (warn-web-player-dlna - "DLNA renderer stopped without confirming playback: position=~a uri=~a" - position (or uri "")) - (report-failure! - playback - "De DLNA-renderer bevestigde de start van de track niet")) - (else - (set-dlna-playback-stopped-polls! - playback - (+ 1 (dlna-playback-stopped-polls playback))) - ;; Give SetNextAVTransportURI one poll to take over. Some - ;; renderers need the explicit fallback on the following poll. - (when (or (not (dlna-playback-prepared-index playback)) - (> (dlna-playback-stopped-polls playback) 1)) - (set-dlna-playback-playing-seen?! playback #f) - (set-dlna-playback-stopped-polls! playback 0) - (advance! playback))))))) + ((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)))) - (notify! - playback - (cond - ((or failed-now? (dlna-playback-failure-active? playback)) 'stopped) - ((and (dlna-playback-playing-seen? playback) - (not (dlna-playback-progress-seen? playback))) - 'starting) - (else state)) - info)))) +;;; 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 - (make-dlna-player device - #:media-file-server media-server)) - (define playback - (dlna-playback raw tracks update error 'off #f #f #f - #f #f #f #f 0 #f #t #t #f - (make-semaphore 1))) - (set-dlna-playback-monitor! - playback - (thread (λ () (monitor-loop playback poll-seconds)))) - playback) + (let* ((raw (make-dlna-player device + #:media-file-server media-server)) + (playback + (dlna-playback raw tracks update error 'off #f #f #f + #f #f #f #f 0 #f #t #t #f + (make-semaphore 1)))) + (set-dlna-playback-monitor! + playback + (thread (λ () (monitor-loop playback poll-seconds)))) + 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))) - (notify! playback - (normalize-state (dlna-info-state info)) - info)))) + (let ((info (dlna-player-info (dlna-playback-player playback)))) + (notify! playback + (normalize-state (dlna-info-state 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))) - (notify! playback - (normalize-state (dlna-info-state info)) - info)))) + (let ((info (dlna-player-info (dlna-playback-player playback)))) + (notify! playback + (normalize-state (dlna-info-state 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)) - (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)))))) + (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))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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) - (check-equal? - (track-index-for-info - playback - (dlna-info - 'playing - (dlna-track-info (track-file second) "Second" "Artist" "Album" - #f #f #f 60 #f #f #f) - "http://renderer.test/02.flac" - #f #f 1 60 25 #f #t)) - 1) + (let ((second-info + (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))) + (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)) diff --git a/private/library.rkt b/private/library.rkt index c1bf338..dfdfd2d 100644 --- a/private/library.rkt +++ b/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 - (member (string-downcase - (string-trim - (bytes->string/utf-8 extension) - ".")) - supported-extensions) - #t))) + (if (eq? extension #f) + #f + (let ((extension-name + (string-downcase + (string-trim + (bytes->string/utf-8 extension) + ".")))) + (if (member extension-name supported-extensions) + #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 (entrycomplete-path file) #t)))) - (and full-file - (for/or ((library (in-list libraries))) - (define root - (with-handlers ((exn:fail? (λ (_) #f))) - (simplify-path - (path->complete-path (music-library-root library)) - #t))) - (and root - (let ((relative (find-relative-path root full-file))) - (and (relative-path? relative) - (not (member 'up (explode-path relative))))))))))) +;;; Produces a resolved complete path, or #f when resolution fails. +(define (complete-path/safe path) + (with-handlers ((exn:fail? (λ (_) #f))) + (simplify-path (path->complete-path path) #t))) + +;;; Checks whether file is located below root without traversing upward. +(define (path-below-root? root file) + (let* ((relative (find-relative-path root file)) + (elements (explode-path relative))) + (and (relative-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))) - (let-values (((name path) - (specification-values specification))) - (list name - (normal-case-path - (path->complete-path path))))) + (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)) - (index (in-naturals))) - (define configured-name (car named-root)) - (define 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))) - (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))))) + (let loop ((remaining roots) + (index 0)) + (if (null? remaining) + '() + (cons (named-root->music-library (car remaining) index) + (loop (cdr remaining) (add1 index))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 - (with-handlers ((exn:fail? (λ (_) #f))) - (call-with-id3-tags - (track-file item) - (λ (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)))))))) + (let ((embedded (embedded-artwork item))) + (if (eq? embedded #f) + (cover-artwork item) + embedded))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 entrystring name) - kind - (append relative-path (list name)))))) + (cond + ((eq? kind #f) #f) + ((eq? kind 'container) + (if (hidden-name? name) + #f + (browser-entry + (path->string name) + kind + (append relative-path (list name))))) + (else + (browser-entry + (path->string name) + kind + (append relative-path (list name))))))) (directory-list path)) entrytrack. +; 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)))) diff --git a/private/player.rkt b/private/player.rkt index dcb563c..1afb22e 100644 --- a/private/player.rkt +++ b/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! @@ -73,9 +74,19 @@ [volume #:mutable] [repeat #:mutable] [error #:mutable] - local-music-indexes) + 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) - (player-error value) - 'null)))))))) + 'error (error->jsexpr + (or (playback-session-error session) + (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)) diff --git a/private/playlists.rkt b/private/playlists.rkt index 72ceba6..dafdecd 100644 --- a/private/playlists.rkt +++ b/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) - (let ((file (hash-ref value 'file #f)) + (if (not (hash? value)) + #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))) - (and (path-string? file) - (string? title) - (string? artist) - (string? album) - (or (not duration) - (and (number? duration) (not (negative? duration)))) - (optional-string? mime-type) - (library-contains-audio-file? libraries file) - (track (path->complete-path file) - title artist album duration mime-type))))) + (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) + valid-duration? + (optional-string? mime-type)))) + (if (and valid-metadata? + (library-contains-audio-file? libraries file)) + (track (path->complete-path file) + 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) - (hash? value) - (let ((name (hash-ref value 'name #f)) - (tracks (hash-ref value 'tracks #f))) - (and (string? name) - (not (string=? name "")) - (list? tracks) - (persisted-tab - id - name - (filter-map - (λ (item) (datum->track item libraries)) - tracks)))))) + (if (not (and (uuid-string? id) (hash? value))) + #f + (let ((name (hash-ref value 'name #f)) + (tracks (hash-ref value 'tracks #f))) + (if (and (string? name) + (not (string=? name "")) + (list? tracks)) + (persisted-tab + id + name + (filter-map + (λ (item) (datum->track item libraries)) + tracks)) + #f)))) -(define (open-playlist-store file) - (and file - (let ((target (path->complete-path file))) - (make-parent-directory* target) - (playlist-store (ks-open target) (make-semaphore 1))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Provided functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (close-playlist-store! store) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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) + (ks-open target)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; 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 - (playlist-store-lock store) - (λ () (ks-close (playlist-store-keystore store))))) + (ks-with-lock store (λ () (ks-close 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 - (playlist-store-lock store) + (ks-with-lock + store (λ () - (define ks (playlist-store-keystore store)) - (define ids (ks-get ks (user-playlists-key username) '())) - (if (list? ids) - (filter-map - (λ (id) - (datum->tab id (ks-get ks id #f) libraries)) - (remove-duplicates (filter uuid-string? ids) string=?)) - '()))))) + (let ((ids (ks-get store (user-playlists-key username) '()))) + (if (list? ids) + (filter-map + (λ (id) + (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 - (playlist-store-lock store) + (ks-with-lock + store (λ () - (define ks (playlist-store-keystore store)) - (define index-key (user-playlists-key username)) - (define old-ids (ks-get ks index-key '())) - (define ids (map persisted-tab-id tabs)) - (ks-transaction - ks - (for ((id (in-list (if (list? old-ids) old-ids '()))) - #:when (and (string? id) (not (member id ids string=?)))) - (ks-drop! ks id)) - (for ((tab (in-list tabs))) - (ks-set! - ks - (persisted-tab-id tab) - (hasheq 'name (persisted-tab-name tab) - 'tracks (map track->datum - (persisted-tab-tracks tab))))) - (ks-set! ks index-key ids)) - (void))))) + (let* ((index-key (user-playlists-key username)) + (old-ids (ks-get store index-key '())) + (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 + store + (for-each (λ (id) (ks-drop! store id)) stale-ids) + (for-each + (λ (tab) + (ks-set! + store + (persisted-tab-id tab) + (hasheq 'name (persisted-tab-name tab) + 'tracks (map track->datum + (persisted-tab-tracks tab))))) + 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) - (and store - (call-with-semaphore - (playlist-store-lock store) - (λ () - (define value - (ks-get (playlist-store-keystore store) - (user-language-key username) - #f)) - (and (member value supported-language-names) value))))) +(define/contract (load-user-language store username) + (-> (or/c keystore? #f) string? (or/c string? #f)) + (if (eq? store #f) + #f + (ks-with-lock + store + (λ () + (let ((value (ks-get store (user-language-key username) #f))) + (if (member value supported-language-names) + value + #f)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 - (playlist-store-lock store) + (ks-with-lock + store (λ () - (ks-set! (playlist-store-keystore store) - (user-language-key username) - language)))) + (ks-set! store (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,76 +272,82 @@ (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))) - (define store (open-playlist-store store-file)) - (define first-id (uuid-string)) - (define second-id (uuid-string)) - (define item - (track (build-path music "one.flac") - "One" "Artist" "Album" 60 "audio/flac")) - (define item-two - (track (build-path music-two "two.flac") - "Two" "Artist" "Album" 70 "audio/flac")) - (save-user-playlists! - store - "hans" - (list (persisted-tab first-id "First" (list item item-two)) - (persisted-tab second-id "Second" '()))) - (save-user-playlists! - store - "local" - (list (persisted-tab (uuid-string) "Local" '()))) + (let* ((libraries (make-music-libraries (list music music-two))) + (store (open-playlist-store store-file)) + (first-id (uuid-string)) + (second-id (uuid-string)) + (item + (track (build-path music "one.flac") + "One" "Artist" "Album" 60 "audio/flac")) + (item-two + (track (build-path music-two "two.flac") + "Two" "Artist" "Album" 70 "audio/flac"))) + (dynamic-wind + void + (λ () + (save-user-playlists! + store + "hans" + (list (persisted-tab first-id "First" (list item item-two)) + (persisted-tab second-id "Second" '()))) + (save-user-playlists! + store + "local" + (list (persisted-tab (uuid-string) "Local" '()))) + (let ((loaded (load-user-playlists store "hans" libraries))) + (check-equal? (ks-get store "playlists-for-hans") + (list first-id second-id)) + (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? (persisted-tab-name (car loaded)) "First") + (check-equal? + (map track-title (persisted-tab-tracks (car loaded))) + '("One" "Two")) + (check-equal? + (map persisted-tab-name + (load-user-playlists store "local" libraries)) + '("Local")) + (check-false (load-user-language store "hans")) + (save-user-language! store "hans" "fr") + (check-equal? (load-user-language store "hans") "fr") + (save-user-language! store "hans" "fi") + (check-equal? (load-user-language store "hans") "fi") + (check-exn exn:fail:contract? + (λ () (save-user-language! store "hans" "da"))) - (define loaded (load-user-playlists store "hans" libraries)) - (define ks (playlist-store-keystore store)) - (check-equal? (ks-get ks "playlists-for-hans") - (list first-id second-id)) - (check-equal? (hash-ref (ks-get ks first-id) 'name) "First") - (check-equal? (map persisted-tab-id loaded) (list first-id second-id)) - (check-equal? (persisted-tab-name (car loaded)) "First") - (check-equal? (map track-title (persisted-tab-tracks (car loaded))) - '("One" "Two")) - (check-equal? - (map persisted-tab-name (load-user-playlists store "local" libraries)) - '("Local")) - (check-false (load-user-language store "hans")) - (save-user-language! store "hans" "fr") - (check-equal? (load-user-language store "hans") "fr") - (save-user-language! store "hans" "fi") - (check-equal? (load-user-language store "hans") "fi") - (check-exn exn:fail:contract? - (λ () (save-user-language! store "hans" "da"))) + ;; 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)) + (list first-id)) + (check-false (ks-exists? store second-id)) + (check-equal? + (map persisted-tab-name + (load-user-playlists store "local" libraries)) + '("Local")) - ;; Rewriting the user's GUID index durably removes the omitted playlist. - (save-user-playlists! - store "hans" - (list (persisted-tab first-id "First" (list item item-two)))) - (check-equal? - (map persisted-tab-id (load-user-playlists store "hans" libraries)) - (list first-id)) - (check-false (ks-exists? ks second-id)) - ;; An omitted GUID is deleted rather than becoming orphaned. - (check-equal? - (map persisted-tab-name (load-user-playlists store "local" libraries)) - '("Local")) - - ;; A playlist entry may not restore tracks outside configured libraries. - (define unsafe-id (uuid-string)) - (ks-set! - (playlist-store-keystore store) - unsafe-id - (hasheq - 'name "Unsafe" - 'tracks - (list (hasheq 'file (path->string outside) - 'title "Outside" 'artist "" 'album "" - 'duration #f 'mime-type "audio/flac")))) - (ks-set! (playlist-store-keystore store) - (user-playlists-key "unsafe") - (list unsafe-id)) - (check-equal? - (persisted-tab-tracks - (car (load-user-playlists store "unsafe" libraries))) - '()) - (close-playlist-store! store)) + ;; A playlist may not restore tracks outside configured libraries. + (let ((unsafe-id (uuid-string))) + (ks-set! + store + unsafe-id + (hasheq + 'name "Unsafe" + 'tracks + (list (hasheq 'file (path->string outside) + 'title "Outside" 'artist "" 'album "" + 'duration #f 'mime-type "audio/flac")))) + (ks-set! store + (user-playlists-key "unsafe") + (list unsafe-id)) + (check-equal? + (persisted-tab-tracks + (car (load-user-playlists store "unsafe" libraries))) + '())))) + (λ () (close-playlist-store! store))))) (λ () (delete-directory/files root)))) diff --git a/private/server.rkt b/private/server.rkt index 5f43ba9..e07d23f 100644 --- a/private/server.rkt +++ b/private/server.rkt @@ -21,43 +21,46 @@ (define-runtime-path public-directory "../public") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; HTTP handlers +;; Supporting functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define current-player #f) -(define current-auth #f) - +;;; Creates a JSON response that browsers and agents may not cache. (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) - (let ((user (auth-request-user current-auth request))) +;;; Reports the authentication state belonging to the current 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) - (auth-logout! current-auth request) +;;; Invalidates the browser session and expires its cookie. +(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) - (or (auth-request-user current-auth request) "anonymous")) +;;; Resolves the authenticated username or the anonymous playlist owner. +(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 - #:username (request-username request)))) + player + #:username (request-username auth request)))) -(define (discover-handler request) - (player-discover! current-player) +;;; Starts renderer discovery and returns the updated player state. +(define (discover-handler player auth request) + (player-discover! player) (json-response (player-state->jsexpr - current-player - #:username (request-username request)))) + player + #: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 - #:username (request-username request)) + player + #: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)) - (player-user-language! - current-player - language - #:username (request-username request)) - (json-response (hasheq 'language language)))) + (let ((language (hash-ref (request-jsexpr request) 'language #f))) + (player-user-language! + player + language + #:username (request-username auth request)) + (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) - (let ((file (player-agent-media current-player app-id token))) +;;; Streams the media file identified by an agent's opaque 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 - (response/output - (λ (output) - (write-bytes (artwork-data value) output)) - #:mime-type - (string->bytes/utf-8 (artwork-mime-type value)) - #:headers - (list - (header #"Content-Length" - (string->bytes/utf-8 - (number->string - (bytes-length (artwork-data value))))) - (header #"Cache-Control" #"private, max-age=3600"))) + (let ((data (artwork-data value))) + (response/output + (λ (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 (bytes-length data)))) + (header #"Cache-Control" #"private, max-age=3600")))) (json-response (hasheq 'error "track artwork is unavailable") #:code 404)))) -(define-values (api-dispatch _url) - (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])) - +;;; Returns the path and query string used to classify an API request. (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 -; an API route. +; pre : Auth is an auth-manager, api-dispatch handles the configured routes, +; 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 value (api-dispatch request)) - (define renewed-cookie - (and (not (regexp-match? #px"^/api/agent(?:/|$)" - (request-path request))) - (auth-renewal-cookie current-auth request))) - (if renewed-cookie - (response-add-header value (header #"Set-Cookie" renewed-cookie)) - value)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (dispatch-api auth api-dispatch request) + (let* ((value (api-dispatch request)) + (agent-request? + (regexp-match? #px"^/api/agent(?:/|$)" (request-path request))) + (renewed-cookie + (if agent-request? + #f + (auth-renewal-cookie auth request)))) + (if renewed-cookie + (response-add-header value (header #"Set-Cookie" renewed-cookie)) + 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)) - (dispatch-api request)) + (auth-request-user auth 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,21 +357,97 @@ #: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) - (set! current-auth auth-manager) - (serve/servlet - dispatch - #:listen-ip listen-ip - #:port port - #:connection-close? #t - #:launch-browser? launch-browser? - #:quit? #f - #:banner? #t - #:servlet-regexp #rx"^/api(?:/|$)" - #:extra-files-paths (list public-directory))) + (let ((dispatch (make-dispatch value auth-manager))) + (serve/servlet + dispatch + #:listen-ip listen-ip + #:port port + #:connection-close? #t + #:launch-browser? launch-browser? + #:quit? #f + #:banner? #t + #:servlet-regexp #rx"^/api(?:/|$)" + #: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"))) diff --git a/private/users.rkt b/private/users.rkt index 36c374b..c2e2ddb 100644 --- a/private/users.rkt +++ b/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) - (string? encoded) - (with-handlers ((exn:fail? (λ (_) #f))) - (pwhash-verify password-kdf - (string->bytes/utf-8 password) - encoded)))) + (if (and (string? password) (string? encoded)) + (with-handlers ((exn:fail? (λ (_) #f))) + (pwhash-verify password-kdf + (string->bytes/utf-8 password) + encoded)) + #f)) -(define (normal-ip-bytes value) - (define raw - (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)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Supporting functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 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) "/")) - (unless (member (length parts) '(1 2)) - (raise-argument-error 'make-auth-manager "IP address or CIDR network" value)) - (define address - (with-handlers ((exn:fail? - (λ (_) - (raise-argument-error - 'make-auth-manager - "IP address or CIDR network" - value)))) - (normal-ip-bytes (car parts)))) - (define maximum (* 8 (bytes-length address))) - (define prefix - (if (= (length parts) 2) - (string->number (cadr parts)) - maximum)) - (unless (and (exact-nonnegative-integer? prefix) - (<= prefix maximum)) - (raise-argument-error 'make-auth-manager "IP address or CIDR network" value)) - (ip-network address prefix)) + (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)) + (let* ((address + (with-handlers ((exn:fail? + (λ (_) + (raise-argument-error + 'make-auth-manager + "IP address or CIDR network" + value)))) + (normal-ip-address (car parts)))) + (maximum (ip-address-size address)) + (prefix + (if (= (length parts) 2) + (string->number (cadr parts)) + maximum))) + (unless (and (exact-nonnegative-integer? prefix) + (<= prefix maximum)) + (raise-argument-error + '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)) - (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))))))))) + (network-member network (normal-ip-address address-string)))) +;;; 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)) - (define forwarded - (and (trusted-proxy? manager peer) - (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)) + (let* ((peer (request-client-ip request)) + (forwarded + (and (trusted-proxy? manager peer) + (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))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 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 - ((not (auth-enabled? manager)) "anonymous") - (else - (let ((token (request-session-token request)) - (now (current-seconds))) - (and token + (if (not (auth-enabled? manager)) + "anonymous" + (let ((token (request-session-token request)) + (now (current-seconds))) + (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 - (begin - (set-session-last-seen! value now) - (session-username value))))))))))) - -(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)))) + (if value + (begin + (set-session-last-seen! value now) + (session-username value)) + #f)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 -; users to reduce username-dependent timing differences. +; internals: request-address selects the rate-limit key and failure-blocked? +; 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 -; this half-life threshold prevents the one-second player poll from -; returning Set-Cookie every second. +; internals: request-session-token identifies the session. The manager lock +; protects prune-sessions! and the renewal timestamp. A half-life +; 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) - (let ((token (request-session-token request)) - (now (current-seconds))) - (and token - (call-with-semaphore - (auth-manager-lock manager) - (λ () - (prune-sessions! manager now) - (let ((value - (hash-ref (auth-manager-sessions manager) token #f))) - (and value - (>= (- now (session-last-cookie-renewal value)) - (max 1 - (quotient - (auth-manager-session-seconds manager) - 2))) - (begin - (set-session-last-cookie-renewal! value now) - (auth-session-cookie manager token)))))))))) + (if (not (auth-enabled? manager)) + #f + (let ((token (request-session-token request)) + (now (current-seconds))) + (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))) + (if value + (let* ((elapsed + (- now + (session-last-cookie-renewal value))) + (renewal-interval + (max 1 + (quotient + (auth-manager-session-seconds manager) + 2)))) + (if (< elapsed renewal-interval) + #f + (begin + (set-session-last-cookie-renewal! value now) + (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)) - (for ((entry (in-list user-pairs))) - (unless (and (pair? entry) - (string? (car entry)) - (string? (cdr entry))) - (raise-argument-error - '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)) - (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))) - (cdr entry))) - (auth-manager users - (map parse-network trusted-proxy-values) - session-seconds - (make-hash) - (make-hash) - (make-semaphore 1))) + (let ((users (make-hash))) + (for-each + (λ (entry) + (let ((username (string-trim (car entry))) + (password-hash (cdr entry))) + (when (string=? username "") + (raise-arguments-error + 'make-auth-manager + "username must not be empty" + "username" (car 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 username) password-hash))) + user-pairs) + (auth-manager users + (map parse-network trusted-proxy-values) + session-seconds + (make-hash) + (make-hash) + (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")))) diff --git a/public/app.js b/public/app.js index 0e3cd99..2e085c2 100644 --- a/public/app.js +++ b/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 - ? { cache: "no-store" } - : { - method: "POST", - headers: { "Content-Type": "application/json" }, - body: JSON.stringify(body), - }; + let options; + 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; } } +/////////////////////////////////////////////////////////////////////////////// +// Output and library selectors +/////////////////////////////////////////////////////////////////////////////// + +// 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((item) => { - const option = document.createElement("option"); - option.value = item.id; - option.textContent = item.label; - return option; - })); + 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,6 +259,69 @@ function entryAction(label, title, handler) { return button; } +// Starts a library track immediately and reports which item is being loaded. +function playLibraryEntry(entry) { + const message = t("loadingNamed", { name: entry.name }); + command("item-play", { index: entry.index }, message); +} + +// Adds a library item to the current playlist and reports the pending action. +function addLibraryEntry(entry) { + const message = t("addingNamed", { name: entry.name }); + command("item-add", { index: entry.index }, message); +} + +// 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; + + const icon = document.createElement("span"); + icon.className = "entry-icon"; + icon.textContent = entry.kind === "container" ? "▸" : "♪"; + + const name = document.createElement("span"); + name.className = "entry-name"; + name.textContent = entry.name; + name.title = entry.name; + + const actions = document.createElement("span"); + actions.className = "entry-actions"; + actions.append( + entryAction("▶", t("playNow", { name: entry.name }), () => playLibraryEntry(entry)), + entryAction("＋", t("addNamed", { name: entry.name }), () => addLibraryEntry(entry)), + ); + + row.append(icon, name, actions); + if (entry.kind === "container") { + row.addEventListener("click", () => activateLibraryEntry(entry)); + } else { + row.addEventListener("dblclick", () => activateLibraryEntry(entry)); + } + row.addEventListener("keydown", (event) => handleLibraryEntryKeydown(event, entry)); + 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); @@ -199,98 +333,71 @@ function renderBrowser(nextState) { const signature = nextState.browser.entries .map((entry) => `${entry.index}:${entry.kind}:${entry.name}`) .join("|"); - if (elements.libraryEntries.dataset.signature === signature) return; + if (elements.libraryEntries.dataset.signature === signature) { + return; + } - const rows = nextState.browser.entries.map((entry) => { - const row = document.createElement("li"); - row.className = "library-entry"; - row.tabIndex = 0; - - const icon = document.createElement("span"); - icon.className = "entry-icon"; - icon.textContent = entry.kind === "container" ? "▸" : "♪"; - - const name = document.createElement("span"); - name.className = "entry-name"; - name.textContent = entry.name; - name.title = entry.name; - - const actions = document.createElement("span"); - actions.className = "entry-actions"; - actions.append( - entryAction("▶", t("playNow", { name: entry.name }), () => { - command("item-play", { index: entry.index }, t("loadingNamed", { name: entry.name })); - }), - 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 })); - } else { - row.addEventListener("dblclick", () => { - command("item-play", { index: entry.index }, t("loadingNamed", { name: entry.name })); - }); - } - row.addEventListener("keydown", (event) => { - 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; - }); + const rows = nextState.browser.entries.map(createLibraryEntry); elements.libraryEntries.replaceChildren(...rows); elements.libraryEntries.dataset.signature = signature; } +/////////////////////////////////////////////////////////////////////////////// +// Playlist tabs +/////////////////////////////////////////////////////////////////////////////// + +// Prompts for and submits a new name for an existing playlist 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"; + button.dataset.index = tab.index; + button.setAttribute("role", "tab"); + + 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", () => renameTab(tab)); + + if (canDelete) { + const remove = document.createElement("span"); + remove.className = "tab-delete"; + remove.textContent = "×"; + remove.title = t("removePlaylist"); + remove.addEventListener("click", (event) => { + event.stopPropagation(); + command("tab-delete", { index: tab.index }); + }); + 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 tabs = nextState.tabs.map((tab) => { - const button = document.createElement("button"); - button.className = "tab"; - button.type = "button"; - button.dataset.index = tab.index; - button.setAttribute("role", "tab"); - - 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", () => { - const newName = window.prompt(t("playlistName"), tab.name); - if (newName !== null) command("tab-rename", { index: tab.index, name: newName }); - }); - - if (nextState.tabs.length > 1) { - const remove = document.createElement("span"); - remove.className = "tab-delete"; - remove.textContent = "×"; - remove.title = t("removePlaylist"); - remove.addEventListener("click", (event) => { - event.stopPropagation(); - command("tab-delete", { index: tab.index }); - }); - button.append(remove); - } - return button; - }); + 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,74 +409,91 @@ function renderTabs(nextState) { } } +/////////////////////////////////////////////////////////////////////////////// +// Playlist tracks +/////////////////////////////////////////////////////////////////////////////// + +// Maps playback and deletion keys for a focused playlist row. +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; + row.draggable = true; + row.dataset.index = track.index; + + const number = document.createElement("td"); + number.className = "track-number number-column"; + number.textContent = String(track.index + 1); + + const titleCell = document.createElement("td"); + const title = document.createElement("div"); + title.className = "track-title"; + title.textContent = track.title; + const artist = document.createElement("div"); + artist.className = "track-artist"; + artist.textContent = track.artist || track.source; + titleCell.append(title, artist); + + const album = document.createElement("td"); + album.className = "track-album"; + album.textContent = track.album; + + const duration = document.createElement("td"); + duration.className = "track-duration duration-column"; + duration.textContent = formatTime(track.duration); + + 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 = removeTitle; + remove.setAttribute("aria-label", removeTitle); + remove.addEventListener("click", (event) => { + event.stopPropagation(); + command("track-remove", { index: track.index }); + }); + action.append(remove); + + row.append(number, titleCell, album, duration, action); + row.addEventListener("click", () => command("play", { index: track.index })); + row.addEventListener("keydown", (event) => handlePlaylistRowKeydown(event, track)); + row.addEventListener("dragstart", () => { + draggedTrack = track.index; + }); + row.addEventListener("dragover", (event) => event.preventDefault()); + row.addEventListener("drop", (event) => dropTrack(event, track)); + 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((track) => { - const row = document.createElement("tr"); - row.className = "playlist-row"; - row.tabIndex = 0; - row.draggable = true; - row.dataset.index = track.index; - - const number = document.createElement("td"); - number.className = "track-number number-column"; - number.textContent = String(track.index + 1); - - const titleCell = document.createElement("td"); - const title = document.createElement("div"); - title.className = "track-title"; - title.textContent = track.title; - const artist = document.createElement("div"); - artist.className = "track-artist"; - artist.textContent = track.artist || track.source; - titleCell.append(title, artist); - - const album = document.createElement("td"); - album.className = "track-album"; - album.textContent = track.album; - - const duration = document.createElement("td"); - duration.className = "track-duration duration-column"; - duration.textContent = formatTime(track.duration); - - const action = document.createElement("td"); - action.className = "action-column"; - const remove = document.createElement("button"); - remove.className = "row-action"; - remove.type = "button"; - remove.textContent = "×"; - remove.title = t("removeNamed", { name: track.title }); - remove.setAttribute("aria-label", t("removeNamed", { name: track.title })); - remove.addEventListener("click", (event) => { - event.stopPropagation(); - command("track-remove", { index: track.index }); - }); - action.append(remove); - - row.append(number, titleCell, album, duration, action); - row.addEventListener("click", () => command("play", { index: track.index })); - row.addEventListener("keydown", (event) => { - if (event.key === "Enter" || event.key === " ") { - event.preventDefault(); - 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) => { - event.preventDefault(); - if (Number.isInteger(draggedTrack) && draggedTrack !== track.index) { - command("track-move", { from: draggedTrack, to: track.index }); - } - draggedTrack = null; - }); - return row; - }); + 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) - ? 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"); +/////////////////////////////////////////////////////////////////////////////// +// Playback state +/////////////////////////////////////////////////////////////////////////////// - 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 - ? Math.min(100, (nextState.position / nextState.duration) * 100) - : 0; + let percentage = 0; + if (nextState.duration) { + 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 - ? `${nextState.channels} ${t(nextState.channels === 1 ? "oneChannel" : "channels")}` - : `— ${t("channels")}`; + if (nextState.channels) { + const channelLabel = nextState.channels === 1 ? "oneChannel" : "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", () => { - elements.coverImage.hidden = true; - elements.coverPlaceholder.hidden = false; -}); - -elements.coverImage.addEventListener("load", () => { - elements.coverImage.hidden = false; - elements.coverPlaceholder.hidden = true; -}); +// Delegates the player portion of a state snapshot to its visible subregions. +function renderPlayer(nextState) { + const track = currentTrack(nextState); + renderCurrentTrack(track); + renderArtwork(track); + renderPlaybackControls(nextState); + renderPosition(nextState); + 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; - const playing = state.state === "playing" || state.state === "starting"; - command(playing ? "pause" : state.state === "paused" ? "resume" : "play"); -}); -elements.previous.addEventListener("click", () => command("previous")); -elements.stop.addEventListener("click", () => command("stop")); -elements.next.addEventListener("click", () => command("next")); -elements.repeat.addEventListener("click", () => { - if (!state) return; - const next = state.repeat === "off" ? "all" : state.repeat === "all" ? "one" : "off"; - command("repeat", { mode: next }); -}); -elements.renderer.addEventListener("change", () => command("renderer", { id: elements.renderer.value })); -elements.language.value = window.RktTranslate.language(); -elements.language.addEventListener("change", async () => { +/////////////////////////////////////////////////////////////////////////////// +// User interaction and polling +/////////////////////////////////////////////////////////////////////////////// + +// Chooses whether the play button must start, resume, or pause playback. +function commandForPlayButton(playbackState) { + const playing = playbackState.state === "playing" || playbackState.state === "starting"; + if (playing) { + return "pause"; + } + if (playbackState.state === "paused") { + return "resume"; + } + return "play"; +} + +// 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); -}); -elements.discover.addEventListener("click", async () => { + if (state) { + render(state); + } +} + +// 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", () => { - elements.volumeValue.value = `${elements.volume.value}%`; -}); -elements.volume.addEventListener("change", () => command("volume", { value: Number(elements.volume.value) })); -document.addEventListener("pointerdown", (event) => { - if (!elements.volumeControl.contains(event.target)) { - elements.volumeControl.classList.remove("open"); - elements.volumeToggle.setAttribute("aria-expanded", "false"); +} + +// Toggles the volume popover and moves focus to its slider when opened. +function toggleVolumeControl() { + const open = !elements.volumeControl.classList.contains("open"); + setVolumeControlOpen(open); + if (open) { + elements.volume.focus(); } -}); -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"); - elements.volumeToggle.setAttribute("aria-expanded", "false"); + setVolumeControlOpen(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); diff --git a/public/translate.js b/public/translate.js index 37e9a7b..eb8ed55 100644 --- a/public/translate.js +++ b/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.", }, }; diff --git a/rkt-web-player.ini.example b/rkt-web-player.ini.example index d543aa6..aedae76 100644 --- a/rkt-web-player.ini.example +++ b/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 +