play local files to a DLNA Renderer

README.md

@@ -1,3 +1,81 @@
 # racket-audio-dlna
 
-Playing to your DLNA/UPnP Renderer over the network
+`racket-audio-dlna` plays local audio files on UPnP/DLNA media renderers.
+It combines TagLib metadata from `racket-audio` with the HTTP server,
+DIDL-Lite support, and renderer controls from `racket-upnp`.
+
+```racket
+#lang racket/base
+
+(require racket-audio-dlna
+         racket-upnp)
+
+(define renderer
+  (get-media-renderer "Denon"))
+
+(define player
+  (make-dlna-player renderer))
+
+(dlna-player-play!
+ player
+ "/muziek/radiohead/in-rainbows.flac")
+
+(dlna-player-set-next-file!
+ player
+ "/muziek/radiohead/bodysnatchers.flac")
+```
+
+The constructor determines the local address used to reach the renderer and
+starts a media file server on port 8080. The address, port, and URL path can be
+overridden when required:
+
+```racket
+(make-dlna-player
+ renderer
+ #:listen-ip "10.7.3.108"
+ #:port 8081
+ #:path "/music/")
+```
+
+## Controls
+
+```racket
+(dlna-player-pause! player)
+(dlna-player-resume! player)
+(dlna-player-seek! player 120)
+(dlna-player-seek-percentage! player 50)
+(dlna-player-volume! player 35)
+(dlna-player-muted! player #t)
+(dlna-player-stop! player)
+```
+
+`dlna-player-info` returns a cached snapshot:
+
+```racket
+(define info (dlna-player-info player))
+
+(dlna-info-state info)
+(dlna-info-position info)
+(dlna-info-duration info)
+(dlna-info-volume info)
+(dlna-info-reachable? info)
+```
+
+Transport state and position are refreshed by a background thread. Position is
+advanced locally between polls. Volume and mute state use a slower cache.
+Commands update the cache immediately after the renderer accepts them.
+
+Use `#:refresh? #t` for a synchronous refresh:
+
+```racket
+(dlna-player-info player #:refresh? #t)
+```
+
+Close the player when it is no longer needed:
+
+```racket
+(dlna-player-close! player)
+```
+
+Closing stops playback, removes published files, stops the web server, and
+terminates the polling thread.

dlna-player.rkt

@@ -0,0 +1,693 @@
+#lang racket/base
+
+;; Stateful local-file player built on racket-audio metadata and racket-upnp.
+
+(require racket/file
+         racket/path
+         racket/string
+         racket/udp
+         racket-audio/taglib
+         racket-upnp)
+
+(provide make-dlna-player
+         dlna-player?
+         dlna-player-play!
+         dlna-player-set-next-file!
+         dlna-player-pause!
+         dlna-player-resume!
+         dlna-player-stop!
+         dlna-player-seek!
+         dlna-player-seek-percentage!
+         dlna-player-volume!
+         dlna-player-muted!
+         dlna-player-info
+         dlna-player-close!
+         (struct-out dlna-track-info)
+         (struct-out dlna-info))
+
+(struct dlna-track-info
+  (file title artist album genre year track duration
+        sample-rate bit-rate channels)
+  #:transparent)
+
+(struct dlna-info
+  (state track uri next-track next-uri position duration
+         volume muted? reachable?)
+  #:transparent)
+
+(struct publication
+  (track uri metadata)
+  #:transparent)
+
+(struct dlna-player
+  (renderer
+   server
+   poll-seconds
+   volume-poll-seconds
+   transport-lock
+   cache-lock
+   [current #:mutable]
+   [next #:mutable]
+   [cached-info #:mutable]
+   [position-stamp #:mutable]
+   [volume-stamp #:mutable]
+   metadata-cache
+   [counter #:mutable]
+   [running? #:mutable]
+   [poll-thread #:mutable])
+  #:constructor-name make-dlna-player-state)
+
+(define (now-ms)
+  (current-inexact-monotonic-milliseconds))
+
+(define (check-player who player)
+  (unless (dlna-player? player)
+    (raise-argument-error who "dlna-player?" player))
+  (unless (dlna-player-running? player)
+    (raise-arguments-error who "DLNA player has been closed")))
+
+(define (nonempty-string value)
+  (and (string? value)
+       (not (string=? (string-trim value) ""))
+       value))
+
+(define (positive-tag-number value)
+  (and (exact-integer? value)
+       (positive? value)
+       value))
+
+(define (tag-string value)
+  (cond
+    [(string? value) (nonempty-string value)]
+    [(and (list? value) (andmap string? value))
+     (nonempty-string (string-join value " / "))]
+    [else #f]))
+
+(define (file-title path)
+  (let* ([name (path->string (file-name-from-path path))]
+         [without-extension
+          (regexp-replace #px"[.][^.]*$" name "")])
+    (if (string=? without-extension "")
+        name
+        without-extension)))
+
+(define (fallback-track-info path)
+  (dlna-track-info path
+                   (file-title path)
+                   #f
+                   #f
+                   #f
+                   #f
+                   #f
+                   #f
+                   #f
+                   #f
+                   #f))
+
+(define (read-track-info path)
+  (with-handlers ([exn:fail? (lambda (_) (fallback-track-info path))])
+    (call-with-id3-tags
+     path
+     (lambda (tags)
+       (if (tags-valid? tags)
+           (let* ([artist
+                   (or (nonempty-string (tags-artist tags))
+                       (tag-string (tags-album-artist tags)))]
+                  [duration (positive-tag-number (tags-length tags))])
+             (dlna-track-info
+              path
+              (or (nonempty-string (tags-title tags))
+                  (file-title path))
+              artist
+              (nonempty-string (tags-album tags))
+              (nonempty-string (tags-genre tags))
+              (positive-tag-number (tags-year tags))
+              (positive-tag-number (tags-track tags))
+              duration
+              (positive-tag-number (tags-sample-rate tags))
+              (positive-tag-number (tags-bit-rate tags))
+              (positive-tag-number (tags-channels tags))))
+           (fallback-track-info path))))))
+
+(define (track-cache-key path)
+  (list path
+        (file-size path)
+        (file-or-directory-modify-seconds path)))
+
+(define (player-track-info who player file)
+  (unless (path-string? file)
+    (raise-argument-error who "path-string?" file))
+  (let ([path (path->complete-path file)])
+    (unless (file-exists? path)
+      (raise-arguments-error
+       who
+       "audio file does not exist"
+       "file" file))
+    (let* ([key (track-cache-key path)]
+           [cached
+            (call-with-semaphore
+             (dlna-player-cache-lock player)
+             (lambda ()
+               (hash-ref (dlna-player-metadata-cache player) key #f)))])
+      (or cached
+          (let ([info (read-track-info path)])
+            (call-with-semaphore
+             (dlna-player-cache-lock player)
+             (lambda ()
+               (when (>= (hash-count
+                          (dlna-player-metadata-cache player))
+                         128)
+                 (hash-clear! (dlna-player-metadata-cache player)))
+               (hash-set! (dlna-player-metadata-cache player) key info)))
+            info)))))
+
+(define (file-extension path)
+  (let ([match
+         (regexp-match #px"(?i:[.]([a-z0-9]+))$"
+                       (path->string path))])
+    (if match
+        (string-append "." (cadr match))
+        "")))
+
+(define (next-publication-name player path)
+  (call-with-semaphore
+   (dlna-player-cache-lock player)
+   (lambda ()
+     (let ([number (add1 (dlna-player-counter player))])
+       (set-dlna-player-counter! player number)
+       (format "track-~a~a" number (file-extension path))))))
+
+(define (publish-track! player track)
+  (let* ([server (dlna-player-server player)]
+         [uri
+          (media-file-server-publish!
+           server
+           (dlna-track-info-file track)
+           (next-publication-name
+            player
+            (dlna-track-info-file track)))])
+    (with-handlers
+        ([exn:fail?
+          (lambda (exception)
+            (media-file-server-unpublish! server uri)
+            (raise exception))])
+      (publication
+       track
+       uri
+       (media-file-server-didl-lite
+        server
+        uri
+        #:title (dlna-track-info-title track)
+        #:artist (dlna-track-info-artist track)
+        #:album (dlna-track-info-album track)
+        #:genre (dlna-track-info-genre track)
+        #:year (dlna-track-info-year track)
+        #:track (dlna-track-info-track track)
+        #:duration (dlna-track-info-duration track))))))
+
+(define (safe-unpublish! player item)
+  (when item
+    (with-handlers ([exn:fail? (lambda (_) (void))])
+      (media-file-server-unpublish!
+       (dlna-player-server player)
+       (publication-uri item)))))
+
+(define (update-cache! player proc #:position? [position? #f])
+  (call-with-semaphore
+   (dlna-player-cache-lock player)
+   (lambda ()
+     (set-dlna-player-cached-info!
+      player
+      (proc (dlna-player-cached-info player)))
+     (when position?
+       (set-dlna-player-position-stamp! player (now-ms))))))
+
+(define (set-reachable! player reachable?)
+  (update-cache!
+   player
+   (lambda (info)
+     (struct-copy dlna-info info [reachable? reachable?]))))
+
+(define (estimated-info player)
+  (call-with-semaphore
+   (dlna-player-cache-lock player)
+   (lambda ()
+     (let* ([info (dlna-player-cached-info player)]
+            [position (dlna-info-position info)]
+            [duration (dlna-info-duration info)]
+            [elapsed
+             (/ (- (now-ms) (dlna-player-position-stamp player))
+                1000.0)]
+            [estimated
+             (if (and (eq? (dlna-info-state info) 'playing)
+                      (number? position))
+                 (+ position (max 0 elapsed))
+                 position)])
+       (struct-copy
+        dlna-info
+        info
+        [position
+         (if (and (number? duration) (number? estimated))
+             (min duration estimated)
+             estimated)])))))
+
+(define (call-renderer player proc)
+  (check-player 'dlna-player player)
+  (with-handlers
+      ([exn:fail?
+        (lambda (exception)
+          (set-reachable! player #f)
+          (raise exception))])
+    (let ([result
+           (call-with-semaphore
+            (dlna-player-transport-lock player)
+            proc)])
+      (set-reachable! player #t)
+      result)))
+
+(define (promote-or-clear-publications! player uri)
+  (let ([old-current #f]
+        [old-next #f])
+    (when (nonempty-string uri)
+      (call-with-semaphore
+       (dlna-player-cache-lock player)
+       (lambda ()
+         (let ([current (dlna-player-current player)]
+               [next (dlna-player-next player)])
+           (cond
+             [(and next (string=? uri (publication-uri next)))
+              (set! old-current current)
+              (set-dlna-player-current! player next)
+              (set-dlna-player-next! player #f)]
+             [(and current
+                   (not (string=? uri (publication-uri current))))
+              (set! old-current current)
+              (set! old-next next)
+              (set-dlna-player-current! player #f)
+              (set-dlna-player-next! player #f)])))))
+    (safe-unpublish! player old-current)
+    (safe-unpublish! player old-next)))
+
+(define (volume-refresh-due? player)
+  (call-with-semaphore
+   (dlna-player-cache-lock player)
+   (lambda ()
+     (>= (- (now-ms) (dlna-player-volume-stamp player))
+         (* 1000.0 (dlna-player-volume-poll-seconds player))))))
+
+(define (refresh-volume! player #:force? [force? #f])
+  (when (or force? (volume-refresh-due? player))
+    (let ([renderer (dlna-player-renderer player)])
+      (with-handlers ([exn:fail? (lambda (_) (void))])
+        (let ([volume (media-renderer-volume renderer)])
+          (update-cache!
+           player
+           (lambda (info)
+             (struct-copy dlna-info info [volume volume])))))
+      (with-handlers ([exn:fail? (lambda (_) (void))])
+        (let ([muted? (media-renderer-muted? renderer)])
+          (update-cache!
+           player
+           (lambda (info)
+             (struct-copy dlna-info info [muted? muted?])))))
+      (call-with-semaphore
+       (dlna-player-cache-lock player)
+       (lambda ()
+         (set-dlna-player-volume-stamp! player (now-ms)))))))
+
+(define (refresh-player! player #:force-volume? [force-volume? #f])
+  (with-handlers
+      ([exn:fail?
+        (lambda (_)
+          (set-reachable! player #f)
+          #f)])
+    (call-with-semaphore
+     (dlna-player-transport-lock player)
+     (lambda ()
+       (let* ([renderer (dlna-player-renderer player)]
+              [state (media-renderer-status renderer)]
+              [position
+               (with-handlers ([exn:fail? (lambda (_) #f)])
+                 (media-renderer-position renderer))]
+              [uri (and position (transport-position-uri position))]
+              [seconds
+               (and position (transport-position-seconds position))]
+              [renderer-duration
+               (and position
+                    (transport-position-duration position))])
+         (promote-or-clear-publications! player uri)
+         (let* ([current (dlna-player-current player)]
+                [next (dlna-player-next player)]
+                [track (and current (publication-track current))]
+                [track-duration
+                 (and track (dlna-track-info-duration track))]
+                [duration
+                 (if (and (number? renderer-duration)
+                          (positive? renderer-duration))
+                     renderer-duration
+                     track-duration)])
+           (update-cache!
+            player
+            (lambda (info)
+              (struct-copy
+               dlna-info
+               info
+               [state state]
+               [track track]
+               [uri (or (nonempty-string uri)
+                        (and current (publication-uri current)))]
+               [next-track (and next (publication-track next))]
+               [next-uri (and next (publication-uri next))]
+               [position (if (number? seconds)
+                             seconds
+                             (dlna-info-position info))]
+               [duration duration]
+               [reachable? #t]))
+            #:position? #t))
+         (refresh-volume! player #:force? force-volume?)
+         #t)))))
+
+(define (poll-player player)
+  (let loop ()
+    (when (dlna-player-running? player)
+      (sleep (dlna-player-poll-seconds player))
+      (when (dlna-player-running? player)
+        (refresh-player! player)
+        (loop)))))
+
+(define (renderer-local-address renderer)
+  (let ([socket (udp-open-socket)])
+    (dynamic-wind
+      void
+      (lambda ()
+        (udp-connect! socket (media-renderer-address renderer) 1900)
+        (let-values ([(local-host _local-port
+                                 _remote-host _remote-port)
+                      (udp-addresses socket #t)])
+          local-host))
+      (lambda ()
+        (udp-close socket)))))
+
+(define (server-base-url listen-ip port path)
+  (unless (and (exact-integer? port) (<= 1 port 65535))
+    (raise-argument-error 'make-dlna-player
+                          "exact-integer? between 1 and 65535"
+                          port))
+  (unless (string? path)
+    (raise-argument-error 'make-dlna-player "string?" path))
+  (let* ([with-leading
+          (if (string-prefix? path "/")
+              path
+              (string-append "/" path))]
+         [normalized
+          (if (string-suffix? with-leading "/")
+              with-leading
+              (string-append with-leading "/"))])
+    (format "http://~a:~a~a" listen-ip port normalized)))
+
+(define (make-dlna-player renderer
+                          #:listen-ip [listen-ip #f]
+                          #:port [port 8080]
+                          #:path [path "/racket-audio-dlna/"]
+                          #:poll-seconds [poll-seconds 1.0]
+                          #:volume-poll-seconds
+                          [volume-poll-seconds 5.0])
+  (unless (media-renderer? renderer)
+    (raise-argument-error 'make-dlna-player "media-renderer?" renderer))
+  (unless (or (not listen-ip) (string? listen-ip))
+    (raise-argument-error 'make-dlna-player
+                          "(or/c #f string?)"
+                          listen-ip))
+  (unless (and (rational? poll-seconds) (positive? poll-seconds))
+    (raise-argument-error 'make-dlna-player
+                          "positive-real?"
+                          poll-seconds))
+  (unless (and (rational? volume-poll-seconds)
+               (positive? volume-poll-seconds))
+    (raise-argument-error 'make-dlna-player
+                          "positive-real?"
+                          volume-poll-seconds))
+  (let* ([local-address
+          (or listen-ip (renderer-local-address renderer))]
+         [server
+          (start-media-file-server
+           (server-base-url local-address port path)
+           #:listen-ip local-address)]
+         [player
+          (make-dlna-player-state
+           renderer
+           server
+           poll-seconds
+           volume-poll-seconds
+           (make-semaphore 1)
+           (make-semaphore 1)
+           #f
+           #f
+           (dlna-info 'unknown #f #f #f #f
+                      0 #f #f #f #f)
+           (now-ms)
+           0
+           (make-hash)
+           0
+           #t
+           #f)])
+    (refresh-player! player #:force-volume? #t)
+    (set-dlna-player-poll-thread!
+     player
+     (thread (lambda () (poll-player player))))
+    player))
+
+(define (dlna-player-play! player file)
+  (check-player 'dlna-player-play! player)
+  (let* ([track (player-track-info 'dlna-player-play! player file)]
+         [item (publish-track! player track)])
+    (with-handlers
+        ([exn:fail?
+          (lambda (exception)
+            (safe-unpublish! player item)
+            (raise exception))])
+      (call-renderer
+       player
+       (lambda ()
+         (media-renderer-play-uri!
+          (dlna-player-renderer player)
+          (publication-uri item)
+          #:metadata (publication-metadata item))))
+      (let ([old-current #f]
+            [old-next #f])
+        (call-with-semaphore
+         (dlna-player-cache-lock player)
+         (lambda ()
+           (set! old-current (dlna-player-current player))
+           (set! old-next (dlna-player-next player))
+           (set-dlna-player-current! player item)
+           (set-dlna-player-next! player #f)
+           (set-dlna-player-cached-info!
+            player
+            (dlna-info
+             'playing
+             track
+             (publication-uri item)
+             #f
+             #f
+             0
+             (dlna-track-info-duration track)
+             (dlna-info-volume (dlna-player-cached-info player))
+             (dlna-info-muted? (dlna-player-cached-info player))
+             #t))
+           (set-dlna-player-position-stamp! player (now-ms))))
+        (safe-unpublish! player old-current)
+        (safe-unpublish! player old-next))
+      (void))))
+
+(define (dlna-player-set-next-file! player file)
+  (check-player 'dlna-player-set-next-file! player)
+  (let* ([track
+          (player-track-info
+           'dlna-player-set-next-file!
+           player
+           file)]
+         [item (publish-track! player track)])
+    (with-handlers
+        ([exn:fail?
+          (lambda (exception)
+            (safe-unpublish! player item)
+            (raise exception))])
+      (call-renderer
+       player
+       (lambda ()
+         (media-renderer-set-next-uri!
+          (dlna-player-renderer player)
+          (publication-uri item)
+          #:metadata (publication-metadata item))))
+      (let ([old-next #f])
+        (call-with-semaphore
+         (dlna-player-cache-lock player)
+         (lambda ()
+           (set! old-next (dlna-player-next player))
+           (set-dlna-player-next! player item)
+           (set-dlna-player-cached-info!
+            player
+            (struct-copy
+             dlna-info
+             (dlna-player-cached-info player)
+             [next-track track]
+             [next-uri (publication-uri item)]))))
+        (safe-unpublish! player old-next))
+      (void))))
+
+(define (dlna-player-pause! player)
+  (check-player 'dlna-player-pause! player)
+  (let ([position (dlna-info-position (estimated-info player))])
+    (call-renderer
+     player
+     (lambda ()
+       (media-renderer-pause! (dlna-player-renderer player))))
+    (update-cache!
+     player
+     (lambda (info)
+       (struct-copy dlna-info
+                    info
+                    [state 'paused]
+                    [position position]))
+     #:position? #t)
+    (void)))
+
+(define (dlna-player-resume! player)
+  (check-player 'dlna-player-resume! player)
+  (call-renderer
+   player
+   (lambda ()
+     (media-renderer-play! (dlna-player-renderer player))))
+  (update-cache!
+   player
+   (lambda (info)
+     (struct-copy dlna-info info [state 'playing]))
+   #:position? #t)
+  (void))
+
+(define (dlna-player-stop! player)
+  (check-player 'dlna-player-stop! player)
+  (call-renderer
+   player
+   (lambda ()
+     (media-renderer-stop! (dlna-player-renderer player))))
+  (update-cache!
+   player
+   (lambda (info)
+     (struct-copy dlna-info
+                  info
+                  [state 'stopped]
+                  [position 0]))
+   #:position? #t)
+  (void))
+
+(define (dlna-player-seek! player seconds)
+  (check-player 'dlna-player-seek! player)
+  (unless (and (rational? seconds) (not (negative? seconds)))
+    (raise-argument-error 'dlna-player-seek!
+                          "nonnegative-real?"
+                          seconds))
+  (call-renderer
+   player
+   (lambda ()
+     (media-renderer-seek!
+      (dlna-player-renderer player)
+      seconds)))
+  (update-cache!
+   player
+   (lambda (info)
+     (struct-copy dlna-info info [position seconds]))
+   #:position? #t)
+  (void))
+
+(define (dlna-player-seek-percentage! player percentage)
+  (check-player 'dlna-player-seek-percentage! player)
+  (unless (rational? percentage)
+    (raise-argument-error 'dlna-player-seek-percentage!
+                          "real?"
+                          percentage))
+  (let* ([initial (dlna-player-info player)]
+         [info
+          (if (number? (dlna-info-duration initial))
+              initial
+              (dlna-player-info player #:refresh? #t))]
+         [duration (dlna-info-duration info)])
+    (unless (and (number? duration) (positive? duration))
+      (raise-arguments-error
+       'dlna-player-seek-percentage!
+       "track duration is not available"))
+    (dlna-player-seek!
+     player
+     (* duration (/ (min 100 (max 0 percentage)) 100.0)))))
+
+(define (dlna-player-volume! player percentage)
+  (check-player 'dlna-player-volume! player)
+  (unless (rational? percentage)
+    (raise-argument-error 'dlna-player-volume! "real?" percentage))
+  (let ([volume
+         (min 100
+              (max 0
+                   (inexact->exact (round percentage))))])
+    (call-renderer
+     player
+     (lambda ()
+       (media-renderer-set-volume!
+        (dlna-player-renderer player)
+        volume)))
+    (update-cache!
+     player
+     (lambda (info)
+       (struct-copy dlna-info info [volume volume])))
+    (call-with-semaphore
+     (dlna-player-cache-lock player)
+     (lambda ()
+       (set-dlna-player-volume-stamp! player (now-ms))))
+    (void)))
+
+(define (dlna-player-muted! player muted?)
+  (check-player 'dlna-player-muted! player)
+  (unless (boolean? muted?)
+    (raise-argument-error 'dlna-player-muted! "boolean?" muted?))
+  (call-renderer
+   player
+   (lambda ()
+     (media-renderer-set-muted!
+      (dlna-player-renderer player)
+      muted?)))
+  (update-cache!
+   player
+   (lambda (info)
+     (struct-copy dlna-info info [muted? muted?])))
+  (void))
+
+(define (dlna-player-info player #:refresh? [refresh? #f])
+  (check-player 'dlna-player-info player)
+  (unless (boolean? refresh?)
+    (raise-argument-error 'dlna-player-info "boolean?" refresh?))
+  (when refresh?
+    (refresh-player! player #:force-volume? #t))
+  (estimated-info player))
+
+(define (dlna-player-close! player)
+  (unless (dlna-player? player)
+    (raise-argument-error 'dlna-player-close! "dlna-player?" player))
+  (when (dlna-player-running? player)
+    (set-dlna-player-running?! player #f)
+    (let ([poll-thread (dlna-player-poll-thread player)])
+      (when poll-thread
+        (kill-thread poll-thread)
+        (set-dlna-player-poll-thread! player #f)))
+    (with-handlers ([exn:fail? (lambda (_) (void))])
+      (call-with-semaphore
+       (dlna-player-transport-lock player)
+       (lambda ()
+         (media-renderer-stop! (dlna-player-renderer player)))))
+    (let ([current (dlna-player-current player)]
+          [next (dlna-player-next player)])
+      (safe-unpublish! player current)
+      (safe-unpublish! player next)
+      (set-dlna-player-current! player #f)
+      (set-dlna-player-next! player #f))
+    (media-file-server-stop! (dlna-player-server player)))
+  (void))

examples/simple.rkt

@@ -0,0 +1,26 @@
+#lang racket/base
+
+(require racket-audio-dlna
+         racket-upnp)
+
+(define renderer
+  (get-media-renderer "Denon"))
+
+(unless renderer
+  (error 'racket-audio-dlna "Denon renderer not found"))
+
+(define player
+  (make-dlna-player renderer))
+
+(dlna-player-play!
+ player
+ "/muziek/radiohead/in-rainbows.flac")
+
+(define info
+  (dlna-player-info player))
+
+(printf "State: ~a, position: ~a, duration: ~a, volume: ~a\n"
+        (dlna-info-state info)
+        (dlna-info-position info)
+        (dlna-info-duration info)
+        (dlna-info-volume info))

info.rkt

@@ -0,0 +1,22 @@
+#lang info
+
+(define pkg-authors '(hnmdijkema))
+(define version "0.1.0")
+(define license 'GPL-2.0-or-later)
+(define collection "racket-audio-dlna")
+(define pkg-desc
+  "Play local racket-audio files through racket-upnp media renderers")
+
+(define deps
+  '("base"
+    "net-lib"
+    "racket-audio"
+    ("racket-upnp" #:version "0.1.3")))
+
+(define build-deps
+  '("racket-doc"
+    "rackunit-lib"
+    "scribble-lib"))
+
+(define scribblings
+  '(("scribblings/racket-audio-dlna.scrbl" (multi-page) (library))))

main.rkt

@@ -0,0 +1,6 @@
+#lang racket/base
+
+(require "dlna-player.rkt")
+
+(provide
+ (all-from-out "dlna-player.rkt"))

scribblings/racket-audio-dlna.scrbl

@@ -0,0 +1,187 @@
+#lang scribble/manual
+
+@(require
+  (for-label
+   racket/base
+   racket/contract
+   racket-audio-dlna
+   racket-upnp))
+
+@title{racket-audio-dlna}
+@author{Hans Dijkema}
+
+@defmodule[racket-audio-dlna]
+
+This package plays local audio files on UPnP and DLNA media renderers.  It
+uses @racketmodname[racket-audio/taglib] for metadata and audio properties,
+and @racketmodname[racket-upnp] for HTTP publication, DIDL-Lite, and renderer
+control.
+
+@section{Creating a player}
+
+@defproc[(make-dlna-player
+          [renderer media-renderer?]
+          [#:listen-ip listen-ip (or/c #f string?) #f]
+          [#:port port exact-integer? 8080]
+          [#:path path string? "/racket-audio-dlna/"]
+          [#:poll-seconds poll-seconds (and/c rational? positive?) 1.0]
+          [#:volume-poll-seconds
+           volume-poll-seconds (and/c rational? positive?) 5.0])
+         dlna-player?]{
+
+Creates a player for @racket[renderer] and starts its local HTTP media server.
+When @racket[listen-ip] is @racket[#f], the address is selected from the
+network route to the renderer.
+
+The player polls transport state and position every @racket[poll-seconds].
+Volume and mute state are refreshed every @racket[volume-poll-seconds].
+}
+
+@defproc[(dlna-player? [value any/c]) boolean?]
+
+@section{Files and playback}
+
+@defproc[(dlna-player-play!
+          [player dlna-player?]
+          [file path-string?])
+         void?]{
+
+Reads the file with TagLib, publishes it through the internal HTTP server,
+generates matching DIDL-Lite, installs the URI, and starts playback.  Missing
+titles fall back to the file name.  Other missing tags are omitted.
+}
+
+@defproc[(dlna-player-set-next-file!
+          [player dlna-player?]
+          [file path-string?])
+         void?]{
+
+Publishes and preloads the file with @tt{SetNextAVTransportURI}.  Replacing the
+next file removes the previous next-file publication.
+}
+
+@defproc[(dlna-player-pause! [player dlna-player?]) void?]
+@defproc[(dlna-player-resume! [player dlna-player?]) void?]
+@defproc[(dlna-player-stop! [player dlna-player?]) void?]
+
+@defproc[(dlna-player-seek!
+          [player dlna-player?]
+          [seconds (and/c rational? (not/c negative?))])
+         void?]{
+
+Seeks using the AVTransport @tt{REL_TIME} unit.
+}
+
+@defproc[(dlna-player-seek-percentage!
+          [player dlna-player?]
+          [percentage real?])
+         void?]{
+
+Converts the clamped percentage to seconds using the cached track duration and
+then seeks with @racket[dlna-player-seek!].
+}
+
+@section{Volume and mute}
+
+@defproc[(dlna-player-volume!
+          [player dlna-player?]
+          [percentage real?])
+         void?]
+
+@defproc[(dlna-player-muted!
+          [player dlna-player?]
+          [muted? boolean?])
+         void?]
+
+Values are limited to the renderer range where applicable.  A successful
+command updates the cache immediately.
+
+@section{Cached information}
+
+@defproc[(dlna-player-info
+          [player dlna-player?]
+          [#:refresh? refresh? boolean? #f])
+         dlna-info?]{
+
+Returns the cached player snapshot.  While playing, the cached position is
+advanced locally between renderer polls and limited to the known duration.
+
+When @racket[refresh?] is true, transport, position, volume, and mute state are
+queried synchronously before the snapshot is returned.  A failed refresh keeps
+the previous values and sets @racket[dlna-info-reachable?] to @racket[#f].
+}
+
+@defproc[(dlna-info-state [info dlna-info?]) symbol?]
+@defproc[(dlna-info-track [info dlna-info?])
+         (or/c #f dlna-track-info?)]
+@defproc[(dlna-info-uri [info dlna-info?]) (or/c #f string?)]
+@defproc[(dlna-info-next-track [info dlna-info?])
+         (or/c #f dlna-track-info?)]
+@defproc[(dlna-info-next-uri [info dlna-info?]) (or/c #f string?)]
+@defproc[(dlna-info-position [info dlna-info?]) (or/c #f real?)]
+@defproc[(dlna-info-duration [info dlna-info?]) (or/c #f real?)]
+@defproc[(dlna-info-volume [info dlna-info?])
+         (or/c #f exact-nonnegative-integer?)]
+@defproc[(dlna-info-muted? [info dlna-info?]) (or/c #f boolean?)]
+@defproc[(dlna-info-reachable? [info dlna-info?]) boolean?]
+
+@section{Track metadata}
+
+@defproc[(dlna-track-info-file [track dlna-track-info?]) path?]
+@defproc[(dlna-track-info-title [track dlna-track-info?]) string?]
+@defproc[(dlna-track-info-artist [track dlna-track-info?])
+         (or/c #f string?)]
+@defproc[(dlna-track-info-album [track dlna-track-info?])
+         (or/c #f string?)]
+@defproc[(dlna-track-info-genre [track dlna-track-info?])
+         (or/c #f string?)]
+@defproc[(dlna-track-info-year [track dlna-track-info?])
+         (or/c #f exact-positive-integer?)]
+@defproc[(dlna-track-info-track [track dlna-track-info?])
+         (or/c #f exact-positive-integer?)]
+@defproc[(dlna-track-info-duration [track dlna-track-info?])
+         (or/c #f exact-positive-integer?)]
+@defproc[(dlna-track-info-sample-rate [track dlna-track-info?])
+         (or/c #f exact-positive-integer?)]
+@defproc[(dlna-track-info-bit-rate [track dlna-track-info?])
+         (or/c #f exact-positive-integer?)]
+@defproc[(dlna-track-info-channels [track dlna-track-info?])
+         (or/c #f exact-positive-integer?)]
+
+TagLib results are cached by complete file name, size, and modification time.
+Changing the file therefore invalidates its cached metadata.
+
+@section{Closing}
+
+@defproc[(dlna-player-close! [player dlna-player?]) void?]{
+
+Stops playback, removes current and next publications, stops the HTTP server,
+and terminates the polling thread.  Repeated calls have no effect.
+}
+
+@section{Example}
+
+@racketblock[
+(define renderer
+  (get-media-renderer "Denon"))
+
+(define player
+  (make-dlna-player renderer))
+
+(dlna-player-play!
+ player
+ "/muziek/radiohead/in-rainbows.flac")
+
+(dlna-player-set-next-file!
+ player
+ "/muziek/radiohead/bodysnatchers.flac")
+
+(define info
+  (dlna-player-info player))
+
+(printf "~a: ~a / ~a seconds, volume ~a\n"
+        (dlna-info-state info)
+        (dlna-info-position info)
+        (dlna-info-duration info)
+        (dlna-info-volume info))
+]

tests/interface-test.rkt

@@ -0,0 +1,43 @@
+#lang racket/base
+
+(require rackunit
+         "../main.rkt")
+
+(define track
+  (dlna-track-info
+   "/music/test.flac"
+   "Test track"
+   "Test artist"
+   "Test album"
+   "Alternative"
+   2026
+   7
+   639
+   44100
+   900
+   2))
+
+(define info
+  (dlna-info
+   'playing
+   track
+   "http://127.0.0.1:8080/music/track-1.flac"
+   #f
+   #f
+   12
+   639
+   35
+   #f
+   #t))
+
+(check-true (dlna-track-info? track))
+(check-equal? (dlna-track-info-title track) "Test track")
+(check-equal? (dlna-track-info-duration track) 639)
+(check-true (dlna-info? info))
+(check-eq? (dlna-info-state info) 'playing)
+(check-equal? (dlna-info-position info) 12)
+(check-equal? (dlna-info-volume info) 35)
+(check-true (dlna-info-reachable? info))
+
+(check-exn exn:fail:contract?
+           (lambda () (make-dlna-player #f)))