didl toevoegingen

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
+For local files, `media-file-server-publish!` supplies a byte-range-capable
-local file through Racket's web-server framework and passing the resulting URL
+HTTP URL. `media-file-server-didl-lite` generates matching DIDL-Lite metadata,
-to `media-renderer-play-uri!`.
+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
 

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

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:
 ;;

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

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

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)

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.
+}

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.

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]

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

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 <live>"
+   #: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 <live>")
+(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")

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