hans/racket-upnp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

didl toevoegingen

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-30 22:32:12 +02:00
parent 83b939b60d
commit 2acd9ac87f
12 changed files with 320 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
media-file-server.rkt
+57 -25
View File
@@ -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)