ja

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

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))))

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

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)
 ]

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"])

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 <live>"
+   #:artist "Test Artist"
+   #:album "Test Album"
+   #:genre "Alternative"
+   #:year 2026
+   #:track 7
    #:duration 639.9
    #:size 50357462))
 
@@ -31,6 +36,11 @@
               "Rock & Roll <live>")
 (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)

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))))