From 2acd9ac87f250430d46e2ea5f82ec37ce8b52ddd Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Thu, 30 Jul 2026 22:32:12 +0200 Subject: [PATCH] didl toevoegingen --- README.md | 29 +++++++-- didl-lite.rkt | 67 +++++++++++++++++++++ examples/media-file-server-example.rkt | 18 +++++- info.rkt | 2 +- main.rkt | 2 + media-file-server.rkt | 82 ++++++++++++++++++-------- scribblings/didl-lite.scrbl | 45 ++++++++++++++ scribblings/media-file-server.scrbl | 39 +++++++++++- scribblings/media-renderer.scrbl | 11 +++- scribblings/racket-upnp.scrbl | 1 + tests/didl-lite-test.rkt | 41 +++++++++++++ tests/upnp-test.rkt | 18 +++++- 12 files changed, 320 insertions(+), 35 deletions(-) create mode 100644 didl-lite.rkt create mode 100644 scribblings/didl-lite.scrbl create mode 100644 tests/didl-lite-test.rkt diff --git a/README.md b/README.md index 63a4d06..5eef516 100644 --- a/README.md +++ b/README.md @@ -8,6 +8,7 @@ the generic service escape hatch is used. ```text upnp/main.rkt generic public interface +upnp/didl-lite.rkt DIDL-Lite metadata generation upnp/media-renderer.rkt high-level renderer operations upnp/media-server.rkt high-level MediaServer browser upnp/services/av-transport.rkt playback transport @@ -135,6 +136,17 @@ Normal playback code need not mention AVTransport or SOAP: (require upnp upnp/media-renderer) +(define files + (start-media-file-server + "http://10.7.3.118:8080/media/" + #:listen-ip "10.7.3.118")) + +(define uri + (media-file-server-publish! + files + "C:/muziek/test.flac" + "test.flac")) + (define denon (car (query-media-renderers #:interface "10.7.3.118" @@ -142,7 +154,13 @@ Normal playback code need not mention AVTransport or SOAP: (media-renderer-play-uri! denon - "http://10.7.3.118:8080/media/test.flac") + uri + #:metadata + (media-file-server-didl-lite + files + uri + #:title "Test track" + #:duration 639)) (media-renderer-seek! denon 120) (media-renderer-set-volume! denon 30) @@ -151,9 +169,12 @@ Normal playback code need not mention AVTransport or SOAP: `query-media-renderers` returns all UPnP MediaRenderers by default. Add `#:dlna-only? #t` to retain only devices advertising `X_DLNADOC`. -A later HTTP media-serving module can implement `play-file!` by publishing a -local file through Racket's web-server framework and passing the resulting URL -to `media-renderer-play-uri!`. +For local files, `media-file-server-publish!` supplies a byte-range-capable +HTTP URL. `media-file-server-didl-lite` generates matching DIDL-Lite metadata, +including MIME type, file size, duration, and `DLNA.ORG_OP=01`. Some renderers, +including certain Denon models, only advertise `Seek` after receiving this +metadata. Generate and pass matching metadata for both the current URI and a +preloaded next URI. ## Documentation and tests diff --git a/didl-lite.rkt b/didl-lite.rkt new file mode 100644 index 0000000..d598f73 --- /dev/null +++ b/didl-lite.rkt @@ -0,0 +1,67 @@ +#lang racket/base + +;; Generate the DIDL-Lite description passed to AVTransport actions. + +(require racket/format + xml) + +(provide didl-lite-audio-item) + +(define (check-string who value) + (unless (string? value) + (raise-argument-error who "string?" value))) + +(define (duration->string who duration) + (unless (and (rational? duration) + (not (negative? duration))) + (raise-argument-error who "nonnegative-real?" duration)) + (let* ([seconds (inexact->exact (floor duration))] + [hours (quotient seconds 3600)] + [remaining (remainder seconds 3600)] + [minutes (quotient remaining 60)]) + (format "~a:~a:~a" + hours + (~r minutes #:min-width 2 #:pad-string "0") + (~r (remainder remaining 60) + #:min-width 2 + #:pad-string "0")))) + +(define (didl-lite-audio-item uri + #:protocol-info protocol-info + #:title [title "Media"] + #:duration [duration #f] + #:size [size #f] + #:id [id "0"] + #:parent-id [parent-id "0"]) + (check-string 'didl-lite-audio-item uri) + (check-string 'didl-lite-audio-item protocol-info) + (check-string 'didl-lite-audio-item title) + (check-string 'didl-lite-audio-item id) + (check-string 'didl-lite-audio-item parent-id) + (unless (or (not size) + (exact-nonnegative-integer? size)) + (raise-argument-error + 'didl-lite-audio-item + "(or/c #f exact-nonnegative-integer?)" + size)) + (xexpr->string + `(DIDL-Lite + ((xmlns "urn:schemas-upnp-org:metadata-1-0/DIDL-Lite/") + (xmlns:dc "http://purl.org/dc/elements/1.1/") + (xmlns:upnp "urn:schemas-upnp-org:metadata-1-0/upnp/")) + (item + ((id ,id) + (parentID ,parent-id) + (restricted "1")) + (dc:title () ,title) + (upnp:class () "object.item.audioItem.musicTrack") + (res + ((protocolInfo ,protocol-info) + ,@(if duration + `((duration + ,(duration->string 'didl-lite-audio-item duration))) + '()) + ,@(if size + `((size ,(number->string size))) + '())) + ,uri))))) diff --git a/examples/media-file-server-example.rkt b/examples/media-file-server-example.rkt index fe7f8ea..f5af29c 100644 --- a/examples/media-file-server-example.rkt +++ b/examples/media-file-server-example.rkt @@ -19,6 +19,20 @@ "C:/muziek/next.flac" "next.flac")) +(define current-metadata + (media-file-server-didl-lite + files + current-uri + #:title "Current track" + #:duration 639)) + +(define next-metadata + (media-file-server-didl-lite + files + next-uri + #:title "Next track" + #:duration 242)) + (define renderer (get-media-renderer "Denon")) @@ -26,7 +40,9 @@ (media-renderer-play-uri! renderer current-uri - #:next-uri next-uri)) + #:metadata current-metadata + #:next-uri next-uri + #:next-metadata next-metadata)) ;; Call this after playback no longer needs the URLs: ;; diff --git a/info.rkt b/info.rkt index 802c934..6357a91 100644 --- a/info.rkt +++ b/info.rkt @@ -1,7 +1,7 @@ #lang info (define pkg-authors '(hnmdijkema)) -(define version "0.1.1") +(define version "0.1.2") (define license 'MIT) (define collection "racket-upnp") (define pkg-desc "racket-upnp - UpnP and DLNA for racket") diff --git a/main.rkt b/main.rkt index 72ff83b..77f0b32 100644 --- a/main.rkt +++ b/main.rkt @@ -4,6 +4,7 @@ (require "query.rkt" "service.rkt" + "didl-lite.rkt" "media-renderer.rkt" "media-server.rkt" "media-file-server.rkt") @@ -12,6 +13,7 @@ (all-from-out "query.rkt" "service.rkt" + "didl-lite.rkt" "media-renderer.rkt" "media-server.rkt" "media-file-server.rkt")) diff --git a/media-file-server.rkt b/media-file-server.rkt index 5e2f0c8..ea5c82b 100644 --- a/media-file-server.rkt +++ b/media-file-server.rkt @@ -16,15 +16,20 @@ web-server/http web-server/servlet-dispatch web-server/web-server - racket-mimetypes) + racket-mimetypes + "didl-lite.rkt") (provide start-media-file-server media-file-server? media-file-server-url media-file-server-publish! + media-file-server-didl-lite media-file-server-unpublish! media-file-server-stop!) +(define dlna-byte-range-features + "DLNA.ORG_OP=01;DLNA.ORG_CI=0") + (struct media-file-server (base-url base-path @@ -93,28 +98,6 @@ (define (guess-mime-type path) (string->bytes/utf-8 (mimetype-for-ext path #:default "application/octet-stream"))) -; (let ([name (string-downcase (path->string path))]) -; (cond -; [(regexp-match? #rx"[.]flac$" name) #"audio/flac"] -; [(regexp-match? #rx"[.]opus$" name) #"audio/ogg"] -; [(regexp-match? #rx"[.]ogg$" name) #"audio/ogg"] -; [(regexp-match? #rx"[.]oga$" name) #"audio/ogg"] -; [(regexp-match? #rx"[.]mp3$" name) #"audio/mpeg"] -; [(regexp-match? #rx"[.]m4a$" name) #"audio/mp4"] -; [(regexp-match? #rx"[.]mp4$" name) #"video/mp4"] -; [(regexp-match? #rx"[.]aac$" name) #"audio/aac"] -; [(regexp-match? #rx"[.]wav$" name) #"audio/wav"] -; [(regexp-match? #rx"[.]wave$" name) #"audio/wav"] -; [(regexp-match? #rx"[.]aif$" name) #"audio/aiff"] -; [(regexp-match? #rx"[.]aiff$" name) #"audio/aiff"] -; [(regexp-match? #rx"[.]ape$" name) #"audio/x-ape"] -; [(regexp-match? #rx"[.]wv$" name) #"audio/wavpack"] -; [(regexp-match? #rx"[.]mkv$" name) #"video/x-matroska"] -; [(regexp-match? #rx"[.]webm$" name) #"video/webm"] -; [(regexp-match? #rx"[.]jpg$" name) #"image/jpeg"] -; [(regexp-match? #rx"[.]jpeg$" name) #"image/jpeg"] -; [(regexp-match? #rx"[.]png$" name) #"image/png"] -; [else #"application/octet-stream"]))) (define (normalize-mime-type who value path) (cond @@ -242,9 +225,8 @@ (define (dlna-response-headers _path) (list (header #"Accept-Ranges" #"bytes") - ;(header #"transferMode.dlna.org" #"Streaming") (header #"contentFeatures.dlna.org" - #"DLNA.ORG_OP=01;DLNA.ORG_CI=0"))) + (string->bytes/utf-8 dlna-byte-range-features)))) (define (media-file-server-publish! server file url @@ -285,6 +267,56 @@ path)))) (url->string publication-url)))) +(define (media-file-server-didl-lite server url + #:title [title #f] + #:duration [duration #f] + #:id [id "0"] + #:parent-id [parent-id "0"]) + (check-media-file-server 'media-file-server-didl-lite server) + (unless (or (not title) (string? title)) + (raise-argument-error + 'media-file-server-didl-lite + "(or/c #f string?)" + title)) + (let-values ([(publication-url publication-path) + (resolve-publication-url + 'media-file-server-didl-lite + server + url)]) + (let-values ([(path mime-type) + (call-with-semaphore + (media-file-server-lock server) + (lambda () + (let ([path + (hash-ref + (media-file-server-publications server) + publication-path + #f)]) + (unless path + (raise-arguments-error + 'media-file-server-didl-lite + "URL is not published by this media file server" + "url" url)) + (values + path + (hash-ref + (media-file-server-mime-types server) + path + (lambda () (guess-mime-type path)))))))]) + (didl-lite-audio-item + (url->string publication-url) + #:protocol-info + (format "http-get:*:~a:~a" + (bytes->string/utf-8 mime-type) + dlna-byte-range-features) + #:title + (or title + (path->string (file-name-from-path path))) + #:duration duration + #:size (file-size path) + #:id id + #:parent-id parent-id)))) + (define (media-file-server-unpublish! server url) (check-media-file-server 'media-file-server-unpublish! server) (let-values ([(_publication-url publication-path) diff --git a/scribblings/didl-lite.scrbl b/scribblings/didl-lite.scrbl new file mode 100644 index 0000000..ced88ad --- /dev/null +++ b/scribblings/didl-lite.scrbl @@ -0,0 +1,45 @@ +#lang scribble/manual + +@(require + (for-label + racket/base + (file "../didl-lite.rkt"))) + +@title{DIDL-Lite Metadata} + +@defmodule[(file "../didl-lite.rkt")] + +DIDL-Lite describes the resource passed to a renderer. Some renderers only +advertise seeking after the current URI has metadata containing its media +type, duration, and byte-range capability. + +@defproc[(didl-lite-audio-item + [uri string?] + [#:protocol-info protocol-info string?] + [#:title title string? "Media"] + [#:duration duration (or/c #f nonnegative-real?) #f] + [#:size size (or/c #f exact-nonnegative-integer?) #f] + [#:id id string? "0"] + [#:parent-id parent-id string? "0"]) + string?]{ + +Returns an XML DIDL-Lite audio-item description. Text and attribute values +are XML-escaped automatically. + +The @racket[protocol-info] value must describe the HTTP resource accurately. +For example: + +@racketblock[ +(didl-lite-audio-item + "http://10.7.3.118:8080/media/test.flac" + #:protocol-info + "http-get:*:audio/flac:DLNA.ORG_OP=01;DLNA.ORG_CI=0" + #:title "Test track" + #:duration 639 + #:size 50357462) +] + +Use @racket[media-file-server-didl-lite] when the URI was published with this +package; it fills in the protocol information and file size from the actual +publication. +} diff --git a/scribblings/media-file-server.scrbl b/scribblings/media-file-server.scrbl index b37b490..3270dc0 100644 --- a/scribblings/media-file-server.scrbl +++ b/scribblings/media-file-server.scrbl @@ -3,6 +3,7 @@ @(require (for-label racket/base + (file "../didl-lite.rkt") (file "../media-file-server.rkt"))) @title{Publishing Media Files} @@ -77,6 +78,26 @@ Removes the URL mapping. Requests that are already in progress may still finish. } +@defproc[(media-file-server-didl-lite + [server media-file-server?] + [url string?] + [#:title title (or/c #f string?) #f] + [#:duration duration (or/c #f nonnegative-real?) #f] + [#:id id string? "0"] + [#:parent-id parent-id string? "0"]) + string?]{ + +Returns DIDL-Lite metadata for a URL previously installed with +@racket[media-file-server-publish!]. The MIME type, file size, and +@tt{DLNA.ORG_OP=01} byte-range capability are taken from the actual +publication. The file name is used as the title when @racket[title] is +@racket[#f]. + +Pass the result as @racket[#:metadata] or @racket[#:next-metadata] to the +media-renderer functions. Supplying the duration is recommended because some +renderers use it when deciding whether time seeking is available. +} + @defproc[(media-file-server-stop! [server media-file-server?]) void?]{ @@ -104,10 +125,26 @@ Stops the web server. Repeated calls have no effect. "C:/muziek/second.flac" "second.flac")) +(define first-metadata + (media-file-server-didl-lite + files + first-uri + #:title "First track" + #:duration 639)) + +(define second-metadata + (media-file-server-didl-lite + files + second-uri + #:title "Second track" + #:duration 242)) + (media-renderer-play-uri! renderer first-uri - #:next-uri second-uri) + #:metadata first-metadata + #:next-uri second-uri + #:next-metadata second-metadata) ] Keep the URLs published until the renderer has finished reading them. diff --git a/scribblings/media-renderer.scrbl b/scribblings/media-renderer.scrbl index 488f3da..d16635f 100644 --- a/scribblings/media-renderer.scrbl +++ b/scribblings/media-renderer.scrbl @@ -3,6 +3,7 @@ @(require (for-label racket/base + (file "../media-file-server.rkt") (file "../media-renderer.rkt"))) @title{Media Renderers} @@ -80,10 +81,15 @@ included in the UPnP device description. Sets @racket[uri] as the current resource and starts playback. +Supply DIDL-Lite in @racket[metadata]. Although AVTransport permits an empty +string, some renderers do not enable seeking without resource metadata. Use +@racket[media-file-server-didl-lite] for resources published by this package. + When @racket[next-uri] is supplied, it is installed with @tt{SetNextAVTransportURI} before playback starts. A supporting renderer can open and buffer the next resource while the current resource is playing, -allowing a gapless or near-gapless transition. +allowing a gapless or near-gapless transition. Supply matching DIDL-Lite in +@racket[next-metadata]. } @defproc[(media-renderer-play! [renderer media-renderer?]) any]{ @@ -107,7 +113,8 @@ Reports whether the renderer advertises the optional Sets the resource that follows the currently playing resource. The action describes one next resource, not a complete queue. After playback advances to -that resource, call this function again to preload the following track. +that resource, call this function again to preload the following track. Use +metadata that describes @racket[uri], not the current resource. } @defproc[(media-renderer-pause! [renderer media-renderer?]) any] diff --git a/scribblings/racket-upnp.scrbl b/scribblings/racket-upnp.scrbl index c738ac4..74c153e 100644 --- a/scribblings/racket-upnp.scrbl +++ b/scribblings/racket-upnp.scrbl @@ -5,6 +5,7 @@ @include-section["intro.scrbl"] @include-section["main.scrbl"] +@include-section["didl-lite.scrbl"] @include-section["media-renderer.scrbl"] @include-section["media-server.scrbl"] @include-section["media-file-server.scrbl"] diff --git a/tests/didl-lite-test.rkt b/tests/didl-lite-test.rkt new file mode 100644 index 0000000..4de281a --- /dev/null +++ b/tests/didl-lite-test.rkt @@ -0,0 +1,41 @@ +#lang racket/base + +(require rackunit + racket/port + xml + "../didl-lite.rkt" + "../private/xml.rkt") + +(define metadata + (didl-lite-audio-item + "http://example.test/audio?a=1&b=2" + #:protocol-info + "http-get:*:audio/flac:DLNA.ORG_OP=01;DLNA.ORG_CI=0" + #:title "Rock & Roll " + #:duration 639.9 + #:size 50357462)) + +(define document + (call-with-input-string metadata read-xml)) + +(define root + (xml->xexpr (document-element document))) + +(define item + (car (xexpr-child-elements root "item"))) + +(define resource + (car (xexpr-child-elements item "res"))) + +(check-equal? (xexpr-child-text item "title") + "Rock & Roll ") +(check-equal? (xexpr-child-text item "class") + "object.item.audioItem.musicTrack") +(check-equal? (xexpr-text resource) + "http://example.test/audio?a=1&b=2") +(check-equal? (xexpr-attribute resource 'protocolInfo) + "http-get:*:audio/flac:DLNA.ORG_OP=01;DLNA.ORG_CI=0") +(check-equal? (xexpr-attribute resource 'duration) + "0:10:39") +(check-equal? (xexpr-attribute resource 'size) + "50357462") diff --git a/tests/upnp-test.rkt b/tests/upnp-test.rkt index 43792c9..1797f39 100644 --- a/tests/upnp-test.rkt +++ b/tests/upnp-test.rkt @@ -186,7 +186,17 @@ (check-equal? (transport-position-seconds position) 151/2) (check-equal? (transport-position-duration position) 210) (check-equal? (transport-position-uri position) "http://example/test.flac")) -(av-transport-set-uri! av "http://127.0.0.1/test?a=1&b=2") +(av-transport-set-uri! + av + "http://127.0.0.1/test?a=1&b=2" + #:metadata + (didl-lite-audio-item + "http://127.0.0.1/test?a=1&b=2" + #:protocol-info + "http-get:*:audio/flac:DLNA.ORG_OP=01;DLNA.ORG_CI=0" + #:title "Test & metadata" + #:duration 210 + #:size 123456)) (check-equal? (rendering-control-volume rendering) 37) (rendering-control-set-volume! rendering 300) (let-values ([(source sink) (connection-manager-protocols connection)]) @@ -212,5 +222,11 @@ (ormap (lambda (body) (regexp-match? #rx"http://127.0.0.1/test\\?a=1&b=2" body)) (unbox recorded-bodies))) +(check-true + (ormap (lambda (body) + (and (regexp-match? #rx"CurrentURIMetaData" body) + (regexp-match? #rx"DIDL-Lite" body) + (regexp-match? #rx"DLNA[.]ORG_OP=01" body))) + (unbox recorded-bodies))) (displayln "UPnP tests passed")