DLNA playback

ARCHITECTURE.md

@@ -147,8 +147,13 @@ a more useful perceived volume curve.
 
 Network outputs use `racket-audio-dlna`. The backend controls the chosen media
 renderer and publishes local files over HTTP on the configured DLNA port and
-path. Unlike the callback-driven local backend, network playback information is
+path. After starting a track, the server publishes the following track and sets
-refreshed by calling the renderer whenever a state snapshot is requested.
+it as the renderer's `NextAVTransportURI`. Network playback information is
+refreshed whenever a state snapshot is requested. A changed current URI
+promotes the prepared playlist index and immediately prepares its successor.
+If a renderer does not perform the prepared transition, a confirmed natural
+stop advances through a server-driven fallback. Explicit stops and failed play
+requests are tracked separately and never trigger that fallback.
 
 Changing the selected renderer closes the existing backend and resets playback
 state. The replacement backend remains lazy and is created only when it is

README.md

@@ -88,6 +88,14 @@ wordt pas geïnitialiseerd bij het eerste afspeelcommando. De knop naast de
 uitvoerkeuze start UPnP-discovery; gevonden Sonos-zones worden als logische
 groepen aangeboden en niet nogmaals als losse UPnP-renderers.
 
+Voor UPnP- en Sonos-weergave publiceert de server ook de volgende playlisttrack
+en stelt deze vooraf in als `NextAVTransportURI`. Een renderer die dit
+ondersteunt kan daardoor zelf zonder serverronde naar de volgende track
+overgaan. De server volgt de nieuwe URI en playlistindex. Renderers zonder
+betrouwbare next-ondersteuning krijgen na het natuurlijke trackeinde een
+servergestuurde fallback. Een expliciet stopcommando start nooit de volgende
+track.
+
 Playlisttabs kunnen worden toegevoegd, geselecteerd, hernoemd door dubbel te
 klikken en verwijderd. Tracks kunnen worden afgespeeld, verwijderd en met
 drag-and-drop verplaatst. De tabs zijn in deze versie alleen in het geheugen

private/player.rkt

@@ -47,6 +47,18 @@
   (id [name #:mutable] [tracks #:mutable])
   #:transparent)
 
+(struct network-playback
+  ([current-uri #:mutable]
+   [prepared-uri #:mutable]
+   [prepared-index #:mutable]
+   [playing-seen? #:mutable]
+   [progress-seen? #:mutable]
+   [failure-active? #:mutable]
+   [stop-requested? #:mutable]
+   [stopped-polls #:mutable]
+   [play-request-ms #:mutable])
+  #:transparent)
+
 (struct player
   (libraries
    allowed-agent-ids
@@ -74,9 +86,11 @@
    [error #:mutable]
    [discovering? #:mutable]
    [closed? #:mutable]
+   [network-monitor #:mutable]
    state-lock
    command-lock
    local-music-indexes
+   network
    dlna-port)
   #:transparent)
 
@@ -247,6 +261,94 @@
   (set-player-bits! value #f)
   (set-player-decoder! value #f))
 
+(define (now-ms)
+  (current-inexact-milliseconds))
+
+(define (reset-network-playback! value)
+  (define network (player-network value))
+  (set-network-playback-current-uri! network #f)
+  (set-network-playback-prepared-uri! network #f)
+  (set-network-playback-prepared-index! network #f)
+  (set-network-playback-playing-seen?! network #f)
+  (set-network-playback-progress-seen?! network #f)
+  (set-network-playback-failure-active?! network #f)
+  (set-network-playback-stop-requested?! network #f)
+  (set-network-playback-stopped-polls! network 0)
+  (set-network-playback-play-request-ms! network #f))
+
+(define (same-track-file? first second)
+  (and first
+       second
+       (with-handlers ((exn:fail? (lambda (_) #f)))
+         (equal? (normal-case-path first)
+                 (normal-case-path second)))))
+
+(define (network-info-track-index value info)
+  (define network (player-network value))
+  (define info-track (dlna-info-track info))
+  (define file (and info-track (dlna-track-info-file info-track)))
+  (define uri (dlna-info-uri info))
+  (define prepared-index (network-playback-prepared-index network))
+  (define prepared-uri (network-playback-prepared-uri network))
+  (cond
+    ((and (valid-track-index? value prepared-index)
+          (or (same-track-file?
+               file
+               (track-file (list-ref (player-tracks value) prepared-index)))
+              (and (string? uri)
+                   (string? prepared-uri)
+                   (string=? uri prepared-uri))))
+     prepared-index)
+    (else
+     (for/first ((item (in-list (player-tracks value)))
+                 (index (in-naturals))
+                 #:when (same-track-file? file (track-file item)))
+       index))))
+
+(define (prepare-next-network-track! value)
+  (define backend (player-backend value))
+  (define network (player-network value))
+  (when (and backend
+             (member (player-backend-kind value) '(upnp sonos))
+             (valid-track-index? value (player-current-index value)))
+    (define index (next-index value 1))
+    (cond
+      ((not index)
+       (set-network-playback-prepared-index! network #f)
+       (set-network-playback-prepared-uri! network #f))
+      ((not (equal? index (network-playback-prepared-index network)))
+       (with-handlers
+           ((exn:fail?
+             (lambda (exception)
+               (set-network-playback-prepared-index! network #f)
+               (set-network-playback-prepared-uri! network #f)
+               (warn-web-player
+                "Could not prepare next DLNA track: ~a"
+                (exn-message exception)))))
+         (dlna-player-set-next-file!
+          backend
+          (track-file (list-ref (player-tracks value) index)))
+         (define prepared-info (dlna-player-info backend))
+         (set-network-playback-prepared-index! network index)
+         (set-network-playback-prepared-uri!
+          network
+          (dlna-info-next-uri prepared-info)))))))
+
+;; Result used when a renderer reports stopped after a play request.
+(define (network-stop-decision stop-requested?
+                               playing-seen?
+                               progress-seen?
+                               elapsed-ms
+                               prepared?
+                               stopped-polls)
+  (cond
+    (stop-requested? 'requested-stop)
+    ((not playing-seen?) 'none)
+    ((and (not progress-seen?) (< elapsed-ms 5000)) 'wait-for-start)
+    ((not progress-seen?) 'playback-failed)
+    ((and prepared? (<= stopped-polls 1)) 'wait-for-next)
+    (else 'advance)))
+
 (define (local-state-callback value handle state full-state)
   (with-state-lock
    value
@@ -363,6 +465,7 @@
     (with-state-lock
      value
      (λ ()
+       (reset-network-playback! value)
        (set-player-backend! value #f)
        (set-player-backend-kind! value #f)
        (set-player-state! value 'stopped)
@@ -380,6 +483,15 @@
                                (player-backend value)
                                "stop"))
       (else
+       (with-state-lock
+        value
+        (λ ()
+          (define network (player-network value))
+          (set-network-playback-stop-requested?! network #t)
+          (set-network-playback-playing-seen?! network #f)
+          (set-network-playback-progress-seen?! network #f)
+          (set-network-playback-failure-active?! network #f)
+          (set-network-playback-stopped-polls! network 0)))
        (dlna-player-stop! (player-backend value)))))
   (with-state-lock
    value
@@ -447,7 +559,24 @@
            (enqueue-agent-command!
             value backend "prefetch" following-data))))
       (else
-       (dlna-player-play! backend (track-file item))))
+       (dlna-player-play! backend (track-file item))
+       (let ((info (dlna-player-info backend)))
+         (with-state-lock
+          value
+          (λ ()
+            (define network (player-network value))
+            (set-network-playback-current-uri!
+             network
+             (dlna-info-uri info))
+            (set-network-playback-prepared-uri! network #f)
+            (set-network-playback-prepared-index! network #f)
+            (set-network-playback-playing-seen?! network #t)
+            (set-network-playback-progress-seen?! network #f)
+            (set-network-playback-failure-active?! network #f)
+            (set-network-playback-stop-requested?! network #f)
+            (set-network-playback-stopped-polls! network 0)
+            (set-network-playback-play-request-ms! network (now-ms)))))
+       (prepare-next-network-track! value)))
     (clear-error! value)))
 
 (define (next-index value direction)
@@ -467,86 +596,172 @@
             (if (positive? direction) 0 (- count 1)))
            (else #f)))))))
 
-(define (refresh-network-state! value)
+(define (refresh-agent-state! value)
-  (when (and (player-backend value)
+  (define reported
-             (not (eq? (player-backend-kind value) 'local)))
+    (playback-agent-reported-state (player-backend value)))
-    (with-handlers
+  ;; Keep optimistic command state until playback-changing work is acknowledged.
-        ((exn:fail?
+  (when (and (hash? reported)
-          (λ (exception)
+             (andmap
-            (set-error! value (exn-message exception)))))
+              (λ (command)
-      (if (eq? (player-backend-kind value) 'agent)
+                (string=? (hash-ref command 'action "") "prefetch"))
-          (let ((reported
+              (playback-agent-commands (player-backend value))))
-                 (playback-agent-reported-state
+    (with-state-lock
-                  (player-backend value))))
+     value
-            ;; Keep the server's optimistic command state visible until the
+     (λ ()
-            ;; agent acknowledges playback-changing work. Prefetching does not
+       (let ((state (hash-ref reported 'state #f)))
-            ;; change playback state and may continue in the background.
+         (when (string? state)
-            (when (and (hash? reported)
-                       (andmap
-                        (λ (command)
-                          (string=? (hash-ref command 'action "")
-                                    "prefetch"))
-                        (playback-agent-commands
-                         (player-backend value))))
-              (with-state-lock
-               value
-               (λ ()
-                 (let ((state (hash-ref reported 'state #f)))
-                   (when (string? state)
-                     (set-player-state!
-                      value
-                      (normalize-state (string->symbol state)))))
-                 (set-player-position!
-                  value
-                  (or (json-number reported 'position #f) 0))
-                 (set-player-duration!
-                  value
-                  (json-number reported 'duration #f))
-                 (set-player-rate!
-                  value
-                  (json-number reported 'rate #f))
-                 (set-player-channels!
-                  value
-                  (json-number reported 'channels #f))
-                 (set-player-bits!
-                  value
-                  (json-number reported 'bits #f))
-                 (let ((decoder (json-string reported 'format #f)))
-                   (set-player-decoder!
-                    value
-                    (and decoder (string->symbol decoder))))
-                 (let ((volume (json-number reported 'volume #f)))
-                   (when volume
-                     (set-player-volume! value volume)))
-                 (let ((error (json-string reported 'error #f)))
-                   (set-player-error! value error))))))
-          (let* ((info (dlna-player-info (player-backend value)))
-                 (track-info (dlna-info-track info)))
-        (with-state-lock
-         value
-         (λ ()
            (set-player-state!
             value
-            (normalize-state (dlna-info-state info)))
+            (normalize-state (string->symbol state)))))
-           (set-player-position!
+       (set-player-position! value
-            value
+                             (or (json-number reported 'position #f) 0))
-            (or (dlna-info-position info) 0))
+       (set-player-duration! value
-           (set-player-duration!
+                             (json-number reported 'duration #f))
-            value
+       (set-player-rate! value (json-number reported 'rate #f))
-            (dlna-info-duration info))
+       (set-player-channels! value (json-number reported 'channels #f))
-           (set-player-rate!
+       (set-player-bits! value (json-number reported 'bits #f))
-            value
+       (let ((decoder (json-string reported 'format #f)))
-            (and track-info
+         (set-player-decoder!
-                 (dlna-track-info-sample-rate track-info)))
+          value
-           (set-player-channels!
+          (and decoder (string->symbol decoder))))
-            value
+       (let ((volume (json-number reported 'volume #f)))
-            (and track-info
+         (when volume (set-player-volume! value volume)))
-                 (dlna-track-info-channels track-info)))
+       (set-player-error! value (json-string reported 'error #f))))))
-           (set-player-bits! value #f)
+
-           (set-player-decoder! value 'dlna)
+(define (refresh-dlna-state! value)
-           (when (number? (dlna-info-volume info))
+  (define info (dlna-player-info (player-backend value)))
-             (set-player-volume! value
+  (define track-info (dlna-info-track info))
-                                 (dlna-info-volume info))))))))))
+  (define new-state (normalize-state (dlna-info-state info)))
+  (define position (or (dlna-info-position info) 0))
+  (define prepare-next? #f)
+  (define advance? #f)
+  (define playback-failed? #f)
+  (with-state-lock
+   value
+   (λ ()
+     (define network (player-network value))
+     (define uri (dlna-info-uri info))
+     (when (and (string? uri)
+                (not (string=? uri ""))
+                (not (equal? uri (network-playback-current-uri network))))
+       (set-network-playback-current-uri! network uri)
+       (set-network-playback-stopped-polls! network 0)
+       (let ((detected-index (network-info-track-index value info)))
+         (when (valid-track-index? value detected-index)
+           (unless (equal? detected-index (player-current-index value))
+             (set-network-playback-progress-seen?! network #f)
+             (set-network-playback-failure-active?! network #f)
+             (set-network-playback-play-request-ms! network (now-ms)))
+           (set-player-current-index! value detected-index)
+           (set-network-playback-prepared-index! network #f)
+           (set-network-playback-prepared-uri! network #f)
+           (set! prepare-next? #t))))
+
+     (when (and (not (network-playback-failure-active? network))
+                (member new-state '(playing starting paused)))
+       (when (eq? new-state 'playing)
+         (set-network-playback-playing-seen?! network #t)
+         (set-network-playback-stopped-polls! network 0))
+       (when (and (number? position) (> position 0))
+         (set-network-playback-progress-seen?! network #t)))
+
+     (let ((requested-at (network-playback-play-request-ms network)))
+       (when (and (network-playback-playing-seen? network)
+                  (not (network-playback-progress-seen? network))
+                  requested-at
+                  (>= (- (now-ms) requested-at) 8000))
+         (set-network-playback-playing-seen?! network #f)
+         (set-network-playback-stopped-polls! network 0)
+         (set-network-playback-failure-active?! network #t)
+         (set-player-error! value "De DLNA-renderer kon de track niet starten")
+         (set! playback-failed? #t)))
+
+     (when (and (eq? new-state 'stopped)
+                (not playback-failed?)
+                (not (network-playback-failure-active? network)))
+       (when (and (network-playback-playing-seen? network)
+                  (network-playback-progress-seen? network))
+         (set-network-playback-stopped-polls!
+          network
+          (+ 1 (network-playback-stopped-polls network))))
+       (let* ((requested-at (network-playback-play-request-ms network))
+              (decision
+               (network-stop-decision
+                (network-playback-stop-requested? network)
+                (network-playback-playing-seen? network)
+                (network-playback-progress-seen? network)
+                (if requested-at (- (now-ms) requested-at) 10000)
+                (exact-nonnegative-integer?
+                 (network-playback-prepared-index network))
+                (network-playback-stopped-polls network))))
+         (case decision
+           ((requested-stop)
+            (set-network-playback-stop-requested?! network #f)
+            (set-network-playback-stopped-polls! network 0))
+           ((playback-failed)
+            (set-network-playback-playing-seen?! network #f)
+            (set-network-playback-stopped-polls! network 0)
+            (set-network-playback-failure-active?! network #t)
+            (set-player-error! value "De DLNA-renderer kon de track niet starten"))
+           ((advance)
+            (set-network-playback-playing-seen?! network #f)
+            (set-network-playback-stopped-polls! network 0)
+            (set! advance? #t)))))
+
+     (set-player-state!
+      value
+      (cond
+        ((or playback-failed?
+             (network-playback-failure-active? network))
+         'stopped)
+        ((and (network-playback-playing-seen? network)
+              (not (network-playback-progress-seen? network)))
+         'starting)
+        (else new-state)))
+     (set-player-position! value position)
+     (set-player-duration! value (dlna-info-duration info))
+     (set-player-rate!
+      value
+      (and track-info (dlna-track-info-sample-rate track-info)))
+     (set-player-channels!
+      value
+      (and track-info (dlna-track-info-channels track-info)))
+     (set-player-bits! value #f)
+     (set-player-decoder! value 'dlna)
+     (when (number? (dlna-info-volume info))
+       (set-player-volume! value (dlna-info-volume info)))))
+  (when prepare-next?
+    (prepare-next-network-track! value))
+  (when advance?
+    (let ((index (next-index value 1)))
+      (if index
+          (play-index! value index)
+          (stop-playback! value)))))
+
+(define (refresh-network-state! value)
+  (call-with-semaphore
+   (player-command-lock value)
+   (λ ()
+     (when (and (player-backend value)
+                (not (eq? (player-backend-kind value) 'local)))
+       (with-handlers
+           ((exn:fail?
+             (λ (exception)
+               (set-error! value (exn-message exception)))))
+         (if (eq? (player-backend-kind value) 'agent)
+             (refresh-agent-state! value)
+             (refresh-dlna-state! value)))))))
+
+(define (start-network-monitor! value)
+  (set-player-network-monitor!
+   value
+   (thread
+    (λ ()
+      (let loop ()
+        (sleep 1)
+        (unless (player-closed? value)
+          (refresh-network-state! value)
+          (loop)))))))
 
 (define (entry-by-index value index)
   (and (exact-nonnegative-integer? index)
@@ -1010,7 +1225,12 @@
        (with-state-lock
         value
         (λ ()
-          (set-player-repeat! value mode)))))
+          (set-player-repeat! value mode)))
+       (when (member (player-backend-kind value) '(upnp sonos))
+         ;; Replace the renderer's prepared URI when repeat mode changes.
+         (set-network-playback-prepared-index! (player-network value) #f)
+         (set-network-playback-prepared-uri! (player-network value) #f)
+         (prepare-next-network-track! value))))
     ((string=? command "renderer")
      (let* ((id (json-string data 'id #f))
             (selected (and id (renderer-by-id value id))))
@@ -1058,36 +1278,41 @@
               (browse-library library '())
               '()))
          (tab (playlist-tab "default" "Default" '())))
-    (player libraries
+    (define value
-            (remove-duplicates normalized-agent-ids string=?)
+      (player libraries
-            '()
+              (remove-duplicates normalized-agent-ids string=?)
-            (and library (music-library-id library))
+              '()
-            '()
+              (and library (music-library-id library))
-            browser-entries
+              '()
-            '()
+              browser-entries
-            (list tab)
+              '()
-            0
+              (list tab)
-            (list (renderer "local" "Server audio output" 'local #f))
+              0
-            "local"
+              (list (renderer "local" "Server audio output" 'local #f))
-            #f
+              "local"
-            #f
+              #f
-            #f
+              #f
-            'stopped
+              #f
-            0
+              'stopped
-            #f
+              0
-            #f
+              #f
-            #f
+              #f
-            #f
+              #f
-            #f
+              #f
-            50
+              #f
-            'off
+              50
-            #f
+              'off
-            #f
+              #f
-            #f
+              #f
-            (make-semaphore 1)
+              #f
-            (make-semaphore 1)
+              #f
-            (make-hash)
+              (make-semaphore 1)
-            dlna-port)))
+              (make-semaphore 1)
+              (make-hash)
+              (network-playback #f #f #f #f #f #f #f 0 #f)
+              dlna-port))
+    (start-network-monitor! value)
+    value))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Return the complete browser-visible player state.
@@ -1171,8 +1396,10 @@
            (λ (exception)
              (set-error! value (exn-message exception))
              (raise exception))))
-       (perform-command! value command data))
+       (perform-command! value command data))))
-     (player-state->jsexpr value))))
+  ;; State refresh can itself advance a completed network track and therefore
+  ;; acquires command-lock. Take the snapshot after releasing this command.
+  (player-state->jsexpr value))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Discover UPnP renderers and logical Sonos groups asynchronously.
@@ -1403,12 +1630,35 @@
        (with-state-lock
         value
         (λ ()
-          (set-player-closed?! value #t)))))))
+          (set-player-closed?! value #t))))))
+  (let ((monitor (player-network-monitor value)))
+    (when (and monitor (not (thread-dead? monitor)))
+      (kill-thread monitor))
+    (set-player-network-monitor! value #f)))
 
 (module+ test
   (require rackunit
            racket/file)
 
+  (check-eq?
+   (network-stop-decision #t #t #t 6000 #f 1)
+   'requested-stop)
+  (check-eq?
+   (network-stop-decision #f #t #f 1000 #f 0)
+   'wait-for-start)
+  (check-eq?
+   (network-stop-decision #f #t #f 6000 #f 0)
+   'playback-failed)
+  (check-eq?
+   (network-stop-decision #f #t #t 6000 #t 1)
+   'wait-for-next)
+  (check-eq?
+   (network-stop-decision #f #t #t 6000 #t 2)
+   'advance)
+  (check-eq?
+   (network-stop-decision #f #t #t 6000 #f 1)
+   'advance)
+
   (define root
     (make-temporary-file "rkt-web-player-~a" 'directory))
 
@@ -1572,6 +1822,29 @@
          (list (track first-file "First" "Artist" "Album" 60 "audio/flac")
                (track second-file "Second" "Artist" "Album" 60 "audio/flac")))
 
+        (define test-network (player-network example-player))
+        (set-network-playback-prepared-index! test-network 1)
+        (set-network-playback-prepared-uri!
+         test-network
+         "http://renderer.test/next.flac")
+        (check-equal?
+         (network-info-track-index
+          example-player
+          (dlna-info
+           'playing
+           (dlna-track-info second-file "Second" "Artist" "Album"
+                            #f #f #f 60 #f #f #f)
+           "http://renderer.test/current.flac"
+           #f #f 0 60 25 #f #t))
+         1)
+        (check-equal?
+         (network-info-track-index
+          example-player
+          (dlna-info 'playing #f "http://renderer.test/next.flac"
+                     #f #f 0 60 25 #f #t))
+         1)
+        (reset-network-playback! example-player)
+
         (player-command! example-player "play" (hasheq 'index 0))
         (define play-poll
           (player-agent-poll!