151 lines
5.0 KiB
Racket
151 lines
5.0 KiB
Racket
#lang racket/base
|
|
|
|
(require rackunit
|
|
racket/port
|
|
racket/tcp
|
|
xml
|
|
"../main.rkt"
|
|
"../media-server.rkt"
|
|
"../service.rkt"
|
|
"../private/model.rkt")
|
|
|
|
(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")
|