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) (prefix-in sequence: web-server/dispatchers/dispatch-sequencer)
web-server/http web-server/http
web-server/servlet-dispatch web-server/servlet-dispatch
web-server/web-server) web-server/web-server
racket-mimetypes)
(provide start-media-file-server (provide start-media-file-server
media-file-server? media-file-server?
@@ -90,28 +91,30 @@
(url-effective-port second)))) (url-effective-port second))))
(define (guess-mime-type path) (define (guess-mime-type path)
(let ([name (string-downcase (path->string path))]) (string->bytes/utf-8
(cond (mimetype-for-ext path #:default "application/octet-stream")))
[(regexp-match? #rx"[.]flac$" name) #"audio/flac"] ; (let ([name (string-downcase (path->string path))])
[(regexp-match? #rx"[.]opus$" name) #"audio/ogg"] ; (cond
[(regexp-match? #rx"[.]ogg$" name) #"audio/ogg"] ; [(regexp-match? #rx"[.]flac$" name) #"audio/flac"]
[(regexp-match? #rx"[.]oga$" name) #"audio/ogg"] ; [(regexp-match? #rx"[.]opus$" name) #"audio/ogg"]
[(regexp-match? #rx"[.]mp3$" name) #"audio/mpeg"] ; [(regexp-match? #rx"[.]ogg$" name) #"audio/ogg"]
[(regexp-match? #rx"[.]m4a$" name) #"audio/mp4"] ; [(regexp-match? #rx"[.]oga$" name) #"audio/ogg"]
[(regexp-match? #rx"[.]mp4$" name) #"video/mp4"] ; [(regexp-match? #rx"[.]mp3$" name) #"audio/mpeg"]
[(regexp-match? #rx"[.]aac$" name) #"audio/aac"] ; [(regexp-match? #rx"[.]m4a$" name) #"audio/mp4"]
[(regexp-match? #rx"[.]wav$" name) #"audio/wav"] ; [(regexp-match? #rx"[.]mp4$" name) #"video/mp4"]
[(regexp-match? #rx"[.]wave$" name) #"audio/wav"] ; [(regexp-match? #rx"[.]aac$" name) #"audio/aac"]
[(regexp-match? #rx"[.]aif$" name) #"audio/aiff"] ; [(regexp-match? #rx"[.]wav$" name) #"audio/wav"]
[(regexp-match? #rx"[.]aiff$" name) #"audio/aiff"] ; [(regexp-match? #rx"[.]wave$" name) #"audio/wav"]
[(regexp-match? #rx"[.]ape$" name) #"audio/x-ape"] ; [(regexp-match? #rx"[.]aif$" name) #"audio/aiff"]
[(regexp-match? #rx"[.]wv$" name) #"audio/wavpack"] ; [(regexp-match? #rx"[.]aiff$" name) #"audio/aiff"]
[(regexp-match? #rx"[.]mkv$" name) #"video/x-matroska"] ; [(regexp-match? #rx"[.]ape$" name) #"audio/x-ape"]
[(regexp-match? #rx"[.]webm$" name) #"video/webm"] ; [(regexp-match? #rx"[.]wv$" name) #"audio/wavpack"]
[(regexp-match? #rx"[.]jpg$" name) #"image/jpeg"] ; [(regexp-match? #rx"[.]mkv$" name) #"video/x-matroska"]
[(regexp-match? #rx"[.]jpeg$" name) #"image/jpeg"] ; [(regexp-match? #rx"[.]webm$" name) #"video/webm"]
[(regexp-match? #rx"[.]png$" name) #"image/png"] ; [(regexp-match? #rx"[.]jpg$" name) #"image/jpeg"]
[else #"application/octet-stream"]))) ; [(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) (define (normalize-mime-type who value path)
(cond (cond
@@ -199,7 +202,8 @@
[file-dispatcher [file-dispatcher
(files:make (files:make
#:url->path url->path #:url->path url->path
#:path->mime-type path->mime-type)] #:path->mime-type path->mime-type
#:path-headers dlna-response-headers)]
[not-found-dispatcher [not-found-dispatcher
(dispatch/servlet (dispatch/servlet
(lambda (_request) (lambda (_request)
@@ -234,6 +238,15 @@
stop stop
#f)))) #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 (define (media-file-server-publish! server file url
#:mime-type [mime-type #f]) #:mime-type [mime-type #f])
(check-media-file-server 'media-file-server-publish! server) (check-media-file-server 'media-file-server-publish! server)