From 69433abee136895760739c0df1eb8cfe2a0dcdec Mon Sep 17 00:00:00 2001
From: Hans Dijkema <hans@dijkewijk.nl>
Date: Thu, 27 Aug 2026 17:51:39 +0200
Subject: [PATCH] DLNA playback

---
 ARCHITECTURE.md    |   9 +-
 README.md          |   8 +
 private/player.rkt | 499 +++++++++++++++++++++++++++++++++++----------
 3 files changed, 401 insertions(+), 115 deletions(-)

diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md
index 1febb6e..b62d596 100644
--- a/ARCHITECTURE.md
+++ b/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
-refreshed by calling the renderer whenever a state snapshot is requested.
+path. After starting a track, the server publishes the following track and sets
+it as the renderer's `NextAVTransportURI`. Network playback information is
+refreshed whenever a state snapshot is requested. A changed current URI
+promotes the prepared playlist index and immediately prepares its successor.
+If a renderer does not perform the prepared transition, a confirmed natural
+stop advances through a server-driven fallback. Explicit stops and failed play
+requests are tracked separately and never trigger that fallback.
 
 Changing the selected renderer closes the existing backend and resets playback
 state. The replacement backend remains lazy and is created only when it is
diff --git a/README.md b/README.md
index 75539dc..792472d 100644
--- a/README.md
+++ b/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
diff --git a/private/player.rkt b/private/player.rkt
index 35bc17b..e0ae96a 100644
--- a/private/player.rkt
+++ b/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)
-  (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)
-          (let ((reported
-                 (playback-agent-reported-state
-                  (player-backend value))))
-            ;; Keep the server's optimistic command state visible until the
-            ;; agent acknowledges playback-changing work. Prefetching does not
-            ;; change playback state and may continue in the background.
-            (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
-         (λ ()
+(define (refresh-agent-state! value)
+  (define reported
+    (playback-agent-reported-state (player-backend value)))
+  ;; Keep optimistic command state until playback-changing work is acknowledged.
+  (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 (dlna-info-state info)))
-           (set-player-position!
-            value
-            (or (dlna-info-position info) 0))
-           (set-player-duration!
-            value
-            (dlna-info-duration info))
-           (set-player-rate!
-            value
-            (and track-info
-                 (dlna-track-info-sample-rate track-info)))
-           (set-player-channels!
-            value
-            (and track-info
-                 (dlna-track-info-channels track-info)))
-           (set-player-bits! value #f)
-           (set-player-decoder! value 'dlna)
-           (when (number? (dlna-info-volume info))
-             (set-player-volume! value
-                                 (dlna-info-volume info))))))))))
+            (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)))
+       (set-player-error! value (json-string reported 'error #f))))))
+
+(define (refresh-dlna-state! value)
+  (define info (dlna-player-info (player-backend value)))
+  (define track-info (dlna-info-track info))
+  (define new-state (normalize-state (dlna-info-state info)))
+  (define position (or (dlna-info-position info) 0))
+  (define prepare-next? #f)
+  (define advance? #f)
+  (define playback-failed? #f)
+  (with-state-lock
+   value
+   (λ ()
+     (define network (player-network value))
+     (define uri (dlna-info-uri info))
+     (when (and (string? uri)
+                (not (string=? uri ""))
+                (not (equal? uri (network-playback-current-uri network))))
+       (set-network-playback-current-uri! network uri)
+       (set-network-playback-stopped-polls! network 0)
+       (let ((detected-index (network-info-track-index value info)))
+         (when (valid-track-index? value detected-index)
+           (unless (equal? detected-index (player-current-index value))
+             (set-network-playback-progress-seen?! network #f)
+             (set-network-playback-failure-active?! network #f)
+             (set-network-playback-play-request-ms! network (now-ms)))
+           (set-player-current-index! value detected-index)
+           (set-network-playback-prepared-index! network #f)
+           (set-network-playback-prepared-uri! network #f)
+           (set! prepare-next? #t))))
+
+     (when (and (not (network-playback-failure-active? network))
+                (member new-state '(playing starting paused)))
+       (when (eq? new-state 'playing)
+         (set-network-playback-playing-seen?! network #t)
+         (set-network-playback-stopped-polls! network 0))
+       (when (and (number? position) (> position 0))
+         (set-network-playback-progress-seen?! network #t)))
+
+     (let ((requested-at (network-playback-play-request-ms network)))
+       (when (and (network-playback-playing-seen? network)
+                  (not (network-playback-progress-seen? network))
+                  requested-at
+                  (>= (- (now-ms) requested-at) 8000))
+         (set-network-playback-playing-seen?! network #f)
+         (set-network-playback-stopped-polls! network 0)
+         (set-network-playback-failure-active?! network #t)
+         (set-player-error! value "De DLNA-renderer kon de track niet starten")
+         (set! playback-failed? #t)))
+
+     (when (and (eq? new-state 'stopped)
+                (not playback-failed?)
+                (not (network-playback-failure-active? network)))
+       (when (and (network-playback-playing-seen? network)
+                  (network-playback-progress-seen? network))
+         (set-network-playback-stopped-polls!
+          network
+          (+ 1 (network-playback-stopped-polls network))))
+       (let* ((requested-at (network-playback-play-request-ms network))
+              (decision
+               (network-stop-decision
+                (network-playback-stop-requested? network)
+                (network-playback-playing-seen? network)
+                (network-playback-progress-seen? network)
+                (if requested-at (- (now-ms) requested-at) 10000)
+                (exact-nonnegative-integer?
+                 (network-playback-prepared-index network))
+                (network-playback-stopped-polls network))))
+         (case decision
+           ((requested-stop)
+            (set-network-playback-stop-requested?! network #f)
+            (set-network-playback-stopped-polls! network 0))
+           ((playback-failed)
+            (set-network-playback-playing-seen?! network #f)
+            (set-network-playback-stopped-polls! network 0)
+            (set-network-playback-failure-active?! network #t)
+            (set-player-error! value "De DLNA-renderer kon de track niet starten"))
+           ((advance)
+            (set-network-playback-playing-seen?! network #f)
+            (set-network-playback-stopped-polls! network 0)
+            (set! advance? #t)))))
+
+     (set-player-state!
+      value
+      (cond
+        ((or playback-failed?
+             (network-playback-failure-active? network))
+         'stopped)
+        ((and (network-playback-playing-seen? network)
+              (not (network-playback-progress-seen? network)))
+         'starting)
+        (else new-state)))
+     (set-player-position! value position)
+     (set-player-duration! value (dlna-info-duration info))
+     (set-player-rate!
+      value
+      (and track-info (dlna-track-info-sample-rate track-info)))
+     (set-player-channels!
+      value
+      (and track-info (dlna-track-info-channels track-info)))
+     (set-player-bits! value #f)
+     (set-player-decoder! value 'dlna)
+     (when (number? (dlna-info-volume info))
+       (set-player-volume! value (dlna-info-volume info)))))
+  (when prepare-next?
+    (prepare-next-network-track! value))
+  (when advance?
+    (let ((index (next-index value 1)))
+      (if index
+          (play-index! value index)
+          (stop-playback! value)))))
+
+(define (refresh-network-state! value)
+  (call-with-semaphore
+   (player-command-lock value)
+   (λ ()
+     (when (and (player-backend value)
+                (not (eq? (player-backend-kind value) 'local)))
+       (with-handlers
+           ((exn:fail?
+             (λ (exception)
+               (set-error! value (exn-message exception)))))
+         (if (eq? (player-backend-kind value) 'agent)
+             (refresh-agent-state! value)
+             (refresh-dlna-state! value)))))))
+
+(define (start-network-monitor! value)
+  (set-player-network-monitor!
+   value
+   (thread
+    (λ ()
+      (let loop ()
+        (sleep 1)
+        (unless (player-closed? value)
+          (refresh-network-state! value)
+          (loop)))))))
 
 (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
-            (remove-duplicates normalized-agent-ids string=?)
-            '()
-            (and library (music-library-id library))
-            '()
-            browser-entries
-            '()
-            (list tab)
-            0
-            (list (renderer "local" "Server audio output" 'local #f))
-            "local"
-            #f
-            #f
-            #f
-            'stopped
-            0
-            #f
-            #f
-            #f
-            #f
-            #f
-            50
-            'off
-            #f
-            #f
-            #f
-            (make-semaphore 1)
-            (make-semaphore 1)
-            (make-hash)
-            dlna-port)))
+    (define value
+      (player libraries
+              (remove-duplicates normalized-agent-ids string=?)
+              '()
+              (and library (music-library-id library))
+              '()
+              browser-entries
+              '()
+              (list tab)
+              0
+              (list (renderer "local" "Server audio output" 'local #f))
+              "local"
+              #f
+              #f
+              #f
+              'stopped
+              0
+              #f
+              #f
+              #f
+              #f
+              #f
+              50
+              'off
+              #f
+              #f
+              #f
+              #f
+              (make-semaphore 1)
+              (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))
-     (player-state->jsexpr value))))
+       (perform-command! value command data))))
+  ;; State refresh can itself advance a completed network track and therefore
+  ;; acquires command-lock. Take the snapshot after releasing this command.
+  (player-state->jsexpr value))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; 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!