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

dlna seeking enabling

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-30 21:18:23 +02:00
parent d1125f3778
commit 399614f9fe
1 changed files with 37 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files
media-file-server.rkt
+37 -24
View File
@@ -15,7 +15,8 @@
(prefix-in sequence: web-server/dispatchers/dispatch-sequencer)
web-server/http
web-server/servlet-dispatch
web-server/web-server)
web-server/web-server
racket-mimetypes)
(provide start-media-file-server
media-file-server?
@@ -90,28 +91,30 @@
(url-effective-port second))))
(define (guess-mime-type path)
(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"])))
(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
@@ -199,7 +202,8 @@
[file-dispatcher
(files:make
#:url->path url->path
#:path->mime-type path->mime-type)]
#:path->mime-type path->mime-type
#:path-headers dlna-response-headers)]
[not-found-dispatcher
(dispatch/servlet
(lambda (_request)
@@ -234,6 +238,15 @@
stop
#f))))
(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")))
(define (media-file-server-publish! server file url
#:mime-type [mime-type #f])
(check-media-file-server 'media-file-server-publish! server)