shared media servers

dlna-player.rkt

@@ -47,6 +47,8 @@
 (struct dlna-player
   (renderer
    server
+   owns-server?
+   publication-prefix
    poll-seconds
    volume-poll-seconds
    transport-lock
@@ -186,7 +188,10 @@
    (lambda ()
      (let ([number (add1 (dlna-player-counter player))])
        (set-dlna-player-counter! player number)
-       (format "track-~a~a" number (file-extension path))))))
+       (format "~atrack-~a~a"
+               (dlna-player-publication-prefix player)
+               number
+               (file-extension path))))))
 
 (define (publish-track! player track)
   (dbg-dlna-player "Publishing track file=~a title=~a" (dlna-track-info-file track) (dlna-track-info-title track))
@@ -438,7 +443,18 @@
               (string-append with-leading "/"))])
     (format "http://~a:~a~a" listen-ip port normalized)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a stateful audio player for one DLNA media renderer.
+; pre    : Renderer is a media renderer, media-file-server is #f or a running
+;          media file server, and the polling values are positive rationals.
+; post   : A private media server is started only when no shared server was
+;          supplied; transport polling starts immediately.
+; result : A running DLNA player. A shared server remains owned by its caller.
+; internals: Players using a shared server receive distinct publication paths
+;            so their independently numbered track URLs cannot collide.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (make-dlna-player renderer
+                          #:media-file-server [file-server #f]
                           #:listen-ip [listen-ip #f]
                           #:port [port 8080]
                           #:path [path "/racket-audio-dlna/"]
@@ -447,6 +463,10 @@
                           [volume-poll-seconds 5.0])
   (unless (media-renderer? renderer)
     (raise-argument-error 'make-dlna-player "media-renderer?" renderer))
+  (unless (or (not file-server) (media-file-server? file-server))
+    (raise-argument-error 'make-dlna-player
+                          "(or/c #f media-file-server?)"
+                          file-server))
   (unless (or (not listen-ip) (string? listen-ip))
     (raise-argument-error 'make-dlna-player
                           "(or/c #f string?)"
@@ -461,16 +481,27 @@
                           "positive-real?"
                           volume-poll-seconds))
   (let* ([local-address
-          (or listen-ip (renderer-local-address renderer))]
-         [_ (info-dlna-player "Creating DLNA player renderer=~a address=~a listen-ip=~a port=~a path=~a" (media-renderer-name renderer) (media-renderer-address renderer) local-address port path)]
+          (and (not file-server)
+               (or listen-ip (renderer-local-address renderer)))]
          [server
-          (start-media-file-server
-           (server-base-url local-address port path)
-           #:listen-ip local-address)]
+          (or file-server
+              (start-media-file-server
+               (server-base-url local-address port path)
+               #:listen-ip local-address))]
+         [_ (info-dlna-player
+             "Creating DLNA player renderer=~a address=~a media-url=~a shared-server=~a"
+             (media-renderer-name renderer)
+             (media-renderer-address renderer)
+             (media-file-server-url server)
+             (and file-server #t))]
          [player
           (make-dlna-player-state
            renderer
            server
+           (not file-server)
+           (if file-server
+               (format "~a/" (gensym 'player))
+               "")
            poll-seconds
            volume-poll-seconds
            (make-semaphore 1)
@@ -835,6 +866,14 @@
     (refresh-player! player #:force-volume? #t))
   (estimated-info player))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Stop playback and release all resources owned by a DLNA player.
+; pre    : Player is a dlna-player.
+; post   : Polling and renderer playback are stopped, owned publications are
+;          removed, and a privately created media server is stopped. A shared
+;          media server remains running.
+; result : Void; closing an already closed player has no effect.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (dlna-player-close! player)
   (unless (dlna-player? player)
     (raise-argument-error 'dlna-player-close! "dlna-player?" player))
@@ -856,5 +895,6 @@
       (safe-unpublish! player next)
       (set-dlna-player-current! player #f)
       (set-dlna-player-next! player #f))
-    (media-file-server-stop! (dlna-player-server player)))
+    (when (dlna-player-owns-server? player)
+      (media-file-server-stop! (dlna-player-server player))))
   (void))