Initial import

2026-07-15 18:00:11 +02:00
parent 02d961e53d
commit c6954f5109
29 changed files with 3062 additions and 2 deletions
@@ -0,0 +1,148 @@
+#lang racket/base
+
+(require rackunit
+         racket/port
+         racket/tcp
+         xml
+         upnp/media-server
+         upnp/private/model)
+
+(define listener (tcp-listen 0 4 #t "127.0.0.1"))
+(define-values (_local-host port _remote-host _remote-port)
+  (tcp-addresses listener #t))
+
+(define didl
+  (string-append
+   "<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/\">"
+   "<container id=\"21\" parentID=\"0\" restricted=\"1\" childCount=\"2\" searchable=\"1\">"
+   "<dc:title>Muziek</dc:title>"
+   "<upnp:class>object.container.storageFolder</upnp:class>"
+   "</container>"
+   "<item id=\"100\" parentID=\"21\" restricted=\"1\">"
+   "<dc:title>Allegro</dc:title>"
+   "<dc:creator>Composer</dc:creator>"
+   "<upnp:artist role=\"Performer\">Quartet</upnp:artist>"
+   "<upnp:album>String Quartet</upnp:album>"
+   "<upnp:genre>Classical</upnp:genre>"
+   "<dc:date>2026-07-15</dc:date>"
+   "<upnp:albumArtURI>/cover/100.jpg</upnp:albumArtURI>"
+   "<upnp:class>object.item.audioItem.musicTrack</upnp:class>"
+   "<res protocolInfo=\"http-get:*:audio/flac:DLNA.ORG_PN=FLAC\" "
+   "size=\"123456\" duration=\"00:03:30.500\" bitrate=\"900000\" "
+   "sampleFrequency=\"48000\" bitsPerSample=\"24\" nrAudioChannels=\"2\">"
+   "/stream/100.flac</res>"
+   "<res protocolInfo=\"http-get:*:audio/mpeg:*\">"
+   "http://media.example/100.mp3</res>"
+   "</item>"
+   "</DIDL-Lite>"))
+
+(define response
+  (string-append
+   "<?xml version=\"1.0\"?>"
+   (xexpr->string
+    `(s:Envelope
+      ((xmlns:s "http://schemas.xmlsoap.org/soap/envelope/"))
+      (s:Body
+       ()
+       (u:BrowseResponse
+        ((xmlns:u "urn:schemas-upnp-org:service:ContentDirectory:1"))
+        (Result () ,didl)
+        (NumberReturned () "2")
+        (TotalMatches () "2")
+        (UpdateID () "143")))))))
+
+(define server-thread
+  (thread
+   (lambda ()
+     (for ([request-number (in-range 2)])
+       (let-values ([(in out) (tcp-accept listener)])
+         (let loop ()
+         (let ([line (read-line in 'any)])
+           (unless (or (eof-object? line) (string=? line ""))
+             (loop))))
+       (let ([response-bytes (string->bytes/utf-8 response)])
+         (fprintf out
+                  "HTTP/1.1 200 OK\r\nContent-Type: text/xml\r\nContent-Length: ~a\r\nConnection: close\r\n\r\n"
+                  (bytes-length response-bytes))
+         (write-bytes response-bytes out)
+         (flush-output out))
+         (close-input-port in)
+         (close-output-port out))))))
+
+(define directory
+  (upnp-service
+   "urn:schemas-upnp-org:service:ContentDirectory:1"
+   "urn:upnp-org:serviceId:ContentDirectory"
+   #f
+   (format "http://127.0.0.1:~a/control" port)
+   #f))
+
+(define media-server
+  (upnp-device
+   "uuid:test-server"
+   "urn:schemas-upnp-org:device:MediaServer:1"
+   "Test Media Server"
+   "Test"
+   "Server"
+   #f
+   #f
+   (format "http://127.0.0.1:~a/device.xml" port)
+   "127.0.0.1"
+   #f
+   (list directory)
+   '()
+   (hash)))
+
+(check-true (media-server? media-server))
+
+(define entries (media-server-root media-server))
+(check-equal? (length entries) 2)
+
+(define music (car entries))
+(check-true (media-container? music))
+(check-equal? (media-entry-id music) "21")
+(check-equal? (media-entry-parent-id music) "0")
+(check-equal? (media-entry-title music) "Muziek")
+(check-equal? (media-entry-class music) "object.container.storageFolder")
+(check-true (media-entry-restricted? music))
+(check-equal? (media-container-child-count music) 2)
+(check-true (media-container-searchable? music))
+
+(define track (cadr entries))
+(check-true (media-item? track))
+(check-equal? (media-entry-title track) "Allegro")
+(check-equal? (media-item-creator track) "Composer")
+(check-equal? (media-item-artists track) '("Quartet"))
+(check-equal? (media-item-album track) "String Quartet")
+(check-equal? (media-item-genres track) '("Classical"))
+(check-equal? (media-item-date track) "2026-07-15")
+(check-equal? (media-item-album-art-uri track)
+              (format "http://127.0.0.1:~a/cover/100.jpg" port))
+
+(define resources (media-item-resources track))
+(check-equal? (length resources) 2)
+
+(define flac (car resources))
+(check-equal? (media-resource-uri flac)
+              (format "http://127.0.0.1:~a/stream/100.flac" port))
+(check-equal? (media-resource-content-type flac) "audio/flac")
+(check-equal? (media-resource-size flac) 123456)
+(check-= (media-resource-duration flac) 210.5 0.0001)
+(check-equal? (media-resource-bitrate flac) 900000)
+(check-equal? (media-resource-sample-frequency flac) 48000)
+(check-equal? (media-resource-bits-per-sample flac) 24)
+(check-equal? (media-resource-channels flac) 2)
+
+(define children (media-container-children media-server music))
+(check-equal? (length children) 2)
+
+(define mp3 (cadr resources))
+(check-equal? (media-resource-uri mp3) "http://media.example/100.mp3")
+(check-equal? (media-resource-content-type mp3) "audio/mpeg")
+
+(thread-wait server-thread)
+(tcp-close listener)
+
+(displayln "Media-server browser tests passed")