diff --git a/dlna-player.rkt b/dlna-player.rkt index 8493fda..a8b04c2 100644 --- a/dlna-player.rkt +++ b/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)) diff --git a/info.rkt b/info.rkt index 693280a..d4d57cd 100644 --- a/info.rkt +++ b/info.rkt @@ -1,7 +1,7 @@ #lang info (define pkg-authors '(hnmdijkema)) -(define version "0.1.2") +(define version "0.1.3") (define license 'GPL-2.0-or-later) (define collection "racket-audio-dlna") (define pkg-desc @@ -24,4 +24,3 @@ (define test-omit-paths 'all) - diff --git a/scribblings/racket-audio-dlna.scrbl b/scribblings/racket-audio-dlna.scrbl index ecefd1f..9856e49 100644 --- a/scribblings/racket-audio-dlna.scrbl +++ b/scribblings/racket-audio-dlna.scrbl @@ -5,6 +5,7 @@ racket/base racket/contract racket-audio-dlna + racket-upnp/media-file-server racket-upnp/media-renderer)) @title{racket-audio-dlna} @@ -21,6 +22,8 @@ control. @defproc[(make-dlna-player [renderer media-renderer?] + [#:media-file-server file-server + (or/c #f media-file-server?) #f] [#:listen-ip listen-ip (or/c #f string?) #f] [#:port port exact-integer? 8080] [#:path path string? "/racket-audio-dlna/"] @@ -29,9 +32,15 @@ control. 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. +Creates a player for @racket[renderer]. When @racket[file-server] is +@racket[#f], the player starts and owns a local HTTP media server. When a +@racket[media-file-server?] is supplied, the player publishes through that +shared server in an automatically generated private path. Closing the player +removes its publications but does not stop the shared server. + +The @racket[listen-ip], @racket[port], and @racket[path] arguments configure +only a media server created by the player. 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]. @@ -194,8 +203,10 @@ Changing the file therefore invalidates its cached metadata. @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. +Stops playback, removes current and next publications, and terminates the +polling thread. A media server created by the player is also stopped. A shared +server supplied to @racket[make-dlna-player] remains running. Repeated calls +have no effect. } @section{Example} diff --git a/tests/interface-test.rkt b/tests/interface-test.rkt index 38fbb5a..4ea96f7 100644 --- a/tests/interface-test.rkt +++ b/tests/interface-test.rkt @@ -41,5 +41,9 @@ (check-true (procedure? dlna-player-play-uri!)) (check-true (procedure? dlna-player-set-next-uri!)) +(define-values (_required-keywords accepted-keywords) + (procedure-keywords make-dlna-player)) +(check-not-false (member '#:media-file-server accepted-keywords)) + (check-exn exn:fail:contract? (lambda () (make-dlna-player #f))) diff --git a/tests/shared-media-server-test.rkt b/tests/shared-media-server-test.rkt new file mode 100644 index 0000000..3c80d7d --- /dev/null +++ b/tests/shared-media-server-test.rkt @@ -0,0 +1,84 @@ +#lang racket/base + +(require rackunit + racket/file + racket/tcp + racket-upnp + racket-upnp/private/model + "../main.rkt") + +(define (available-port) + (let ((listener (tcp-listen 0 4 #t "127.0.0.1"))) + (let-values (((_local-host port _remote-host _remote-port) + (tcp-addresses listener #t))) + (tcp-close listener) + port))) + +(define (test-renderer id) + (upnp-device + id + "urn:schemas-upnp-org:device:MediaRenderer:1" + "Test renderer" + "Test" + "Test" + "1" + #f + "http://127.0.0.1/device.xml" + "127.0.0.1" + #f + '() + '() + (hash))) + +(define port (available-port)) +(define file (make-temporary-file "racket-audio-dlna-shared-~a.flac")) +(define server #f) +(define first-player #f) +(define second-player #f) + +(dynamic-wind + (λ () + (call-with-output-file + file + #:exists 'truncate + (λ (output) + (write-bytes #"test audio" output))) + (set! server + (start-media-file-server + (format "http://127.0.0.1:~a/media/" port) + #:listen-ip "127.0.0.1")) + (set! first-player + (make-dlna-player + (test-renderer "uuid:first") + #:media-file-server server + #:listen-ip "127.0.0.1" + #:poll-seconds 60)) + (set! second-player + (make-dlna-player + (test-renderer "uuid:second") + #:media-file-server server + #:listen-ip "127.0.0.1" + #:poll-seconds 60))) + (λ () + (dlna-player-close! first-player) + (set! first-player #f) + (define first-uri + (media-file-server-publish! server file "after-first.flac")) + (check-true (string? first-uri)) + (media-file-server-unpublish! server first-uri) + + (dlna-player-close! second-player) + (set! second-player #f) + (define second-uri + (media-file-server-publish! server file "after-second.flac")) + (check-true (string? second-uri)) + (media-file-server-unpublish! server second-uri)) + (λ () + (when first-player + (dlna-player-close! first-player)) + (when second-player + (dlna-player-close! second-player)) + (when server + (media-file-server-stop! server)) + (when (file-exists? file) + (delete-file file))))