From 9daf7e7e3d240169f0309c6b61fac44e16187f87 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Fri, 31 Jul 2026 10:23:23 +0200 Subject: [PATCH] ja --- didl-lite.rkt | 24 +++++++++++ info.rkt | 6 +-- media-file-server.rkt | 10 +++++ scribblings/didl-lite.scrbl | 7 +++ scribblings/media-file-server.scrbl | 5 +++ tests/didl-lite-test.rkt | 10 +++++ tests/media-file-server-test.rkt | 67 +++++++++++++++++++++++++++++ 7 files changed, 126 insertions(+), 3 deletions(-) create mode 100644 tests/media-file-server-test.rkt diff --git a/didl-lite.rkt b/didl-lite.rkt index d598f73..23afec1 100644 --- a/didl-lite.rkt +++ b/didl-lite.rkt @@ -29,6 +29,11 @@ (define (didl-lite-audio-item uri #:protocol-info protocol-info #:title [title "Media"] + #:artist [artist #f] + #:album [album #f] + #:genre [genre #f] + #:year [year #f] + #:track [track #f] #:duration [duration #f] #:size [size #f] #:id [id "0"] @@ -38,6 +43,18 @@ (check-string 'didl-lite-audio-item title) (check-string 'didl-lite-audio-item id) (check-string 'didl-lite-audio-item parent-id) + (for ([value (in-list (list artist album genre))]) + (unless (or (not value) (string? value)) + (raise-argument-error + 'didl-lite-audio-item + "(or/c #f string?)" + value))) + (for ([value (in-list (list year track))]) + (unless (or (not value) (exact-nonnegative-integer? value)) + (raise-argument-error + 'didl-lite-audio-item + "(or/c #f exact-nonnegative-integer?)" + value))) (unless (or (not size) (exact-nonnegative-integer? size)) (raise-argument-error @@ -55,6 +72,13 @@ (restricted "1")) (dc:title () ,title) (upnp:class () "object.item.audioItem.musicTrack") + ,@(if artist `((upnp:artist () ,artist)) '()) + ,@(if album `((upnp:album () ,album)) '()) + ,@(if genre `((upnp:genre () ,genre)) '()) + ,@(if year `((dc:date () ,(number->string year))) '()) + ,@(if track + `((upnp:originalTrackNumber () ,(number->string track))) + '()) (res ((protocolInfo ,protocol-info) ,@(if duration diff --git a/info.rkt b/info.rkt index 798df0c..d12fe9e 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 'MIT) (define collection "racket-upnp") (define pkg-desc "racket-upnp - UpnP and DLNA for racket") @@ -10,9 +10,9 @@ '("base" "net-lib" "racket-mimetypes" - "web-server-lib")) + ("web-server-lib" #:version "1.10"))) -(define build-deps '("racket-doc" "scribble-lib" "rackunit-lib")) +(define build-deps '("racket-doc" "scribble-lib")) (define scribblings '(("scribblings/racket-upnp.scrbl" (multi-page) (library)))) diff --git a/media-file-server.rkt b/media-file-server.rkt index ea5c82b..ad99cc3 100644 --- a/media-file-server.rkt +++ b/media-file-server.rkt @@ -269,6 +269,11 @@ (define (media-file-server-didl-lite server url #:title [title #f] + #:artist [artist #f] + #:album [album #f] + #:genre [genre #f] + #:year [year #f] + #:track [track #f] #:duration [duration #f] #:id [id "0"] #:parent-id [parent-id "0"]) @@ -312,6 +317,11 @@ #:title (or title (path->string (file-name-from-path path))) + #:artist artist + #:album album + #:genre genre + #:year year + #:track track #:duration duration #:size (file-size path) #:id id diff --git a/scribblings/didl-lite.scrbl b/scribblings/didl-lite.scrbl index ced88ad..df8bf5b 100644 --- a/scribblings/didl-lite.scrbl +++ b/scribblings/didl-lite.scrbl @@ -17,6 +17,11 @@ type, duration, and byte-range capability. [uri string?] [#:protocol-info protocol-info string?] [#:title title string? "Media"] + [#:artist artist (or/c #f string?) #f] + [#:album album (or/c #f string?) #f] + [#:genre genre (or/c #f string?) #f] + [#:year year (or/c #f exact-nonnegative-integer?) #f] + [#:track track (or/c #f exact-nonnegative-integer?) #f] [#:duration duration (or/c #f nonnegative-real?) #f] [#:size size (or/c #f exact-nonnegative-integer?) #f] [#:id id string? "0"] @@ -35,6 +40,8 @@ For example: #:protocol-info "http-get:*:audio/flac:DLNA.ORG_OP=01;DLNA.ORG_CI=0" #:title "Test track" + #:artist "Test artist" + #:album "Test album" #:duration 639 #:size 50357462) ] diff --git a/scribblings/media-file-server.scrbl b/scribblings/media-file-server.scrbl index 3270dc0..cdddd92 100644 --- a/scribblings/media-file-server.scrbl +++ b/scribblings/media-file-server.scrbl @@ -82,6 +82,11 @@ finish. [server media-file-server?] [url string?] [#:title title (or/c #f string?) #f] + [#:artist artist (or/c #f string?) #f] + [#:album album (or/c #f string?) #f] + [#:genre genre (or/c #f string?) #f] + [#:year year (or/c #f exact-nonnegative-integer?) #f] + [#:track track (or/c #f exact-nonnegative-integer?) #f] [#:duration duration (or/c #f nonnegative-real?) #f] [#:id id string? "0"] [#:parent-id parent-id string? "0"]) diff --git a/tests/didl-lite-test.rkt b/tests/didl-lite-test.rkt index 4de281a..bcc8685 100644 --- a/tests/didl-lite-test.rkt +++ b/tests/didl-lite-test.rkt @@ -12,6 +12,11 @@ #:protocol-info "http-get:*:audio/flac:DLNA.ORG_OP=01;DLNA.ORG_CI=0" #:title "Rock & Roll " + #:artist "Test Artist" + #:album "Test Album" + #:genre "Alternative" + #:year 2026 + #:track 7 #:duration 639.9 #:size 50357462)) @@ -31,6 +36,11 @@ "Rock & Roll ") (check-equal? (xexpr-child-text item "class") "object.item.audioItem.musicTrack") +(check-equal? (xexpr-child-text item "artist") "Test Artist") +(check-equal? (xexpr-child-text item "album") "Test Album") +(check-equal? (xexpr-child-text item "genre") "Alternative") +(check-equal? (xexpr-child-text item "date") "2026") +(check-equal? (xexpr-child-text item "originalTrackNumber") "7") (check-equal? (xexpr-text resource) "http://example.test/audio?a=1&b=2") (check-equal? (xexpr-attribute resource 'protocolInfo) diff --git a/tests/media-file-server-test.rkt b/tests/media-file-server-test.rkt new file mode 100644 index 0000000..da917b6 --- /dev/null +++ b/tests/media-file-server-test.rkt @@ -0,0 +1,67 @@ +#lang racket/base + +(require rackunit + racket/file + racket/port + racket/tcp + "../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 (http-request port method #:range [range #f]) + (let-values ([(in out) (tcp-connect "127.0.0.1" port)]) + (fprintf out "~a /media/track.flac HTTP/1.1\r\n" method) + (fprintf out "Host: 127.0.0.1:~a\r\n" port) + (when range + (fprintf out "Range: ~a\r\n" range)) + (fprintf out "Connection: close\r\n\r\n") + (flush-output out) + (close-output-port out) + (let ([response (port->bytes in)]) + (close-input-port in) + response))) + +(define (response-body response) + (let ([match (regexp-match-positions #rx#"\r\n\r\n" response)]) + (if match + (subbytes response (cdar match)) + #""))) + +(define port (available-port)) +(define file (make-temporary-file "racket-upnp-range-~a.flac")) +(define server #f) + +(dynamic-wind + (lambda () + (call-with-output-file + file + #:exists 'truncate + (lambda (out) + (write-bytes #"0123456789" out))) + (set! server + (start-media-file-server + (format "http://127.0.0.1:~a/media/" port) + #:listen-ip "127.0.0.1")) + (media-file-server-publish! server file "track.flac")) + (lambda () + (let ([head (http-request port "HEAD")] + [range (http-request port "GET" #:range "bytes=2-5")]) + (check-regexp-match #rx#"HTTP/1[.]1 200" head) + (check-regexp-match #rx#"(?i:Accept-Ranges): bytes" head) + (check-regexp-match + #rx#"(?i:contentFeatures[.]dlna[.]org): DLNA[.]ORG_OP=01;DLNA[.]ORG_CI=0" + head) + (check-equal? (response-body head) #"") + (check-regexp-match #rx#"HTTP/1[.]1 206" range) + (check-regexp-match #rx#"(?i:Content-Range): bytes 2-5/10" range) + (check-equal? (response-body range) #"2345"))) + (lambda () + (when server + (media-file-server-stop! server)) + (when (file-exists? file) + (delete-file file))))