#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(only-in mzlib/file
file-name-from-path
make-temporary-file)
net/url
mzlib/list
(lib "xml.ss" "xml")
(lib "request-structs.ss" "web-server" "private")
(lib "util.ss" "web-server" "private")
(lib "dispatch.ss" "web-server" "dispatchers")
(prefix-in files: (lib "dispatch-files.ss" "web-server" "dispatchers"))
"../util.ss")
(provide dispatch-files-tests)
(define tmp-file (make-temporary-file))
(with-output-to-file tmp-file
(lambda ()
(display
(xexpr->string
`(html (head (title "A title"))
(body "Here's some content!")))))
#:exists 'truncate/replace)
(define a-dir (directory-part tmp-file))
(define not-there (build-path "I/probably/do/not/exist"))
(define (dispatch i? . paths)
(define b (box 0))
(files:make #:url->path
(lambda (url)
(begin0 (values (list-ref paths (min (unbox b) (sub1 (length paths)))) empty)
(set-box! b (add1 (unbox b)))))
#:indices (list (if i? (file-name-from-path tmp-file) not-there))))
(define file-url (string->url "http://test.com/foo"))
(define dir-url (string->url "http://test.com/foo/"))
(define (req d? meth heads)
(make-request meth (if d? dir-url file-url) heads empty #"" "host" 80 "client"))
(define dispatch-files-tests
(test-suite
"Files"
(test-case
"read-range-header: missing and badly formed headers"
(check-false (files:read-range-header (list (make-header #"Ranges" #"bytes=1-10"))) "check 1")
(check-false (files:read-range-header (list (make-header #"Range" #"completely wrong"))) "check 2")
(check-false (files:read-range-header (list (make-header #"Range" #"byte=1-10"))) "check 3")
(check-false (files:read-range-header (list (make-header #"Range" #"bytes=a-10"))) "check 4")
(check-false (files:read-range-header (list (make-header #"Range" #"bytes=1-1.0"))) "check 5"))
(test-case
"read-range-header: single range"
(check-equal? (files:read-range-header (list (make-header #"Range" #"bytes=1-10"))) (list (cons 1 10)) "check 1")
(check-equal? (files:read-range-header (list (make-header #"Range" #"bytes=1-"))) (list (cons 1 #f)) "check 2")
(check-equal? (files:read-range-header (list (make-header #"Range" #"bytes=-10"))) (list (cons #f 10)) "check 3"))
(test-equal?
"read-range-header: multiple ranges"
(files:read-range-header (list (make-header #"Range" #"bytes=1-10,20-,-30")))
(list (cons 1 10) (cons 20 #f) (cons #f 30)))
(test-equal? "file, exists, whole, no Range, get"
(collect (dispatch #t tmp-file) (req #f 'get empty))
#"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\nA titleHere's some content!")
(test-equal? "file, exists, whole, no Range, head"
(collect (dispatch #t tmp-file) (req #f 'head empty))
#"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n")
(test-equal? "file, exists, whole, Range, get"
(collect (dispatch #t tmp-file) (req #f 'get (list (make-header #"Range" #"bytes=0-80"))))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\nA titleHere's some content!")
(test-equal? "file, exists, whole, Range, head"
(collect (dispatch #t tmp-file) (req #f 'head (list (make-header #"Range" #"bytes=0-80"))))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n")
(test-equal? "file, exists, part, get"
(collect (dispatch #t tmp-file) (req #f 'get (list (make-header #"Range" #"bytes=5-9"))))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 5\r\nContent-Range: bytes 5-9/81\r\n\r\n>A titleHere's some content!