hans/racket-audio-dlna
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

shared media servers

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-28 15:56:19 +02:00
parent 2452e6fba3
commit 059a1e2668
5 changed files with 152 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dlna-player.rkt
+47 -7
View File
@@ -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))
info.rkt
+1 -2
View File
@@ -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)
scribblings/racket-audio-dlna.scrbl
+16 -5
View File
@@ -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}
tests/interface-test.rkt
+4
View File
@@ -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)))
tests/shared-media-server-test.rkt
+84
View File
@@ -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))))