(module instaweb-test mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2)))
(require (lib "etc.ss")
(lib "url.ss" "net")
(planet "port.ss" ("schematics" "port.plt" 1))
"instaweb.ss")
(provide instaweb-tests)
(define (make-dummy)
(with-output-to-file "dummy.ss"
(lambda ()
(write
'(module dummy mzscheme
(require (lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(make-response/full
200
"OK"
(current-seconds)
#"text/plain"
'()
'("foo\r\n"))))))
'replace))
(define (spawn-instaweb . args)
(sleep 1)
(let ([server
(thread
(lambda () (apply instaweb args)))])
(sleep 1)
server))
(define (read-content url)
(get-pure-port (string->url url)))
(define here (this-expression-source-directory))
(define instaweb-tests
(test-suite
"All tests for instaweb"
(test-case
"Server listens on specified port and IP"
(before
(make-dummy)
(let ([server (spawn-instaweb #:port 4567 #:servlet-path "dummy.ss")]
[content (read-content "http://127.0.0.1:4567/servlets/dummy.ss")])
(check string=? (port->string content) "foo\r\n")
(check-exn
exn:fail:network?
(lambda ()
(read-content "http://127.0.0.1:8123/servlets/dummy.ss")))
(kill-thread server))))
(test-case
"Instaweb stops reading if input port returns eof"
(before
(make-dummy)
(let* ([op (open-output-string)]
[server
(thread
(lambda ()
(parameterize
((current-input-port (open-input-string ""))
(current-output-port op))
(instaweb #:port 4567
#:listen-ip "127.0.0.1"
#:servlet-path "dummy.ss"))))])
(kill-thread server)
(let ((content (get-output-string op)))
(display content)
(check <=
(string-length content)
218)))))
(test-case
"instaweb-here forms parameterize current-directory correctly"
(parameterize
((current-directory "/"))
(check-true
(let/ec ec
(instaweb-here
(begin (check equal? (current-directory) here)
(ec #t)))))))
(test-case
"Instaweb reads default htdocs-path"
(around
(begin (make-directory "htdocs")
(with-output-to-file "htdocs/dummy.txt"
(lambda () (display "boo-yah!"))))
(let ([server (spawn-instaweb #:servlet-path "dummy.ss")])
(check-equal?
(port->string (read-content "http://127.0.0.1:8765/dummy.txt"))
"boo-yah!")
(kill-thread server))
(begin (delete-file "htdocs/dummy.txt")
(delete-directory "htdocs"))))
(test-case
"Instaweb reads specified htdocs-path"
(around
(begin (make-directory "public-htdocs")
(with-output-to-file "public-htdocs/dummy.txt"
(lambda () (display "boo-yah!"))))
(let ([server (spawn-instaweb #:port 4320
#:servlet-path "dummy.ss"
#:htdocs-path '("public-htdocs"))])
(check-equal?
(port->string (read-content "http://127.0.0.1:4320/"))
"foo\r\n")
(check-equal?
(port->string (read-content "http://127.0.0.1:4320/dummy.txt"))
"boo-yah!")
(kill-thread server))
(begin (delete-file "public-htdocs/dummy.txt")
(delete-directory "public-htdocs"))))
))
)