ja

2026-07-31 10:23:23 +02:00
parent ad0d676853
commit 9daf7e7e3d
7 changed files with 126 additions and 3 deletions
@@ -0,0 +1,67 @@
+#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))))