68 lines
2.1 KiB
Racket
68 lines
2.1 KiB
Racket
#lang racket/base
|
|
|
|
(require rackunit
|
|
racket/file
|
|
racket/port
|
|
racket/tcp
|
|
"../main.rkt")
|
|
|
|
(define (available-port)
|
|
(let ([listener (tcp-listen 0 4 #t "127.0.0.1")])
|
|
(let-values ([(_local-host port _remote-host _remote-port)
|
|
(tcp-addresses listener #t)])
|
|
(tcp-close listener)
|
|
port)))
|
|
|
|
(define (http-request port method #:range [range #f])
|
|
(let-values ([(in out) (tcp-connect "127.0.0.1" port)])
|
|
(fprintf out "~a /media/track.flac HTTP/1.1\r\n" method)
|
|
(fprintf out "Host: 127.0.0.1:~a\r\n" port)
|
|
(when range
|
|
(fprintf out "Range: ~a\r\n" range))
|
|
(fprintf out "Connection: close\r\n\r\n")
|
|
(flush-output out)
|
|
(close-output-port out)
|
|
(let ([response (port->bytes in)])
|
|
(close-input-port in)
|
|
response)))
|
|
|
|
(define (response-body response)
|
|
(let ([match (regexp-match-positions #rx#"\r\n\r\n" response)])
|
|
(if match
|
|
(subbytes response (cdar match))
|
|
#"")))
|
|
|
|
(define port (available-port))
|
|
(define file (make-temporary-file "racket-upnp-range-~a.flac"))
|
|
(define server #f)
|
|
|
|
(dynamic-wind
|
|
(lambda ()
|
|
(call-with-output-file
|
|
file
|
|
#:exists 'truncate
|
|
(lambda (out)
|
|
(write-bytes #"0123456789" out)))
|
|
(set! server
|
|
(start-media-file-server
|
|
(format "http://127.0.0.1:~a/media/" port)
|
|
#:listen-ip "127.0.0.1"))
|
|
(media-file-server-publish! server file "track.flac"))
|
|
(lambda ()
|
|
(let ([head (http-request port "HEAD")]
|
|
[range (http-request port "GET" #:range "bytes=2-5")])
|
|
(check-regexp-match #rx#"HTTP/1[.]1 200" head)
|
|
(check-regexp-match #rx#"(?i:Accept-Ranges): bytes" head)
|
|
(check-regexp-match
|
|
#rx#"(?i:contentFeatures[.]dlna[.]org): DLNA[.]ORG_OP=01;DLNA[.]ORG_CI=0"
|
|
head)
|
|
(check-equal? (response-body head) #"")
|
|
(check-regexp-match #rx#"HTTP/1[.]1 206" range)
|
|
(check-regexp-match #rx#"(?i:Content-Range): bytes 2-5/10" range)
|
|
(check-equal? (response-body range) #"2345")))
|
|
(lambda ()
|
|
(when server
|
|
(media-file-server-stop! server))
|
|
(when (file-exists? file)
|
|
(delete-file file))))
|