source: project/release/4/spiffy/trunk/tests/run.scm @ 13082

Last change on this file since 13082 was 13082, checked in by sjamaan, 11 years ago

Add checks for traversal attacks

File size: 5.6 KB
Line 
1(require-extension test)
2
3(load "../spiffy.scm")
4
5(import spiffy regex)
6
7(load "testlib")
8
9(define noway "No way, Jose!")
10
11(define counter 0)
12
13(parameterize
14    ((default-mime-type 'application/unknown)
15     (handle-directory (lambda (p) (send-string/code 403 "Forbidden" "forbidden")))
16     (access-file "spiffy-access")
17     (vhost-map
18      `(("foohost" . , (lambda (continue)
19                         (continue)))
20        (,(regexp "testhost.*") . ,(lambda (continue)
21                                     (continue)))
22        ("redirect-host" . ,(lambda (continue)
23                              (with-headers `((location ,(uri-reference "/move-along")))
24                                (lambda ()
25                                  (send-status 303 "Moved")))))
26        ("error-host" . ,(lambda (continue)
27                           (error "This should give a 500 error")))
28        ("subdir-host" . ,(lambda (continue)
29                            (parameterize ((root-path "./testweb/subdir"))
30                              (continue)))))))
31  (start-spiffy))
32
33(define hello.txt (with-input-from-file "testweb/hello.txt" read-string))
34
35(test-begin "vhost support")
36(test "String match" `(200 ,hello.txt) (fetch-file "hello.txt" "foohost"))
37(test "String case insensitivity" `(200 ,hello.txt) (fetch-file "hello.txt" "FOOHOST"))
38(test "Regexp match" `(200 ,hello.txt) (fetch-file "hello.txt" "testhost"))
39(test "Regexp case sensitivity" `(404 ,NOT-FOUND) (fetch-file "hello.txt" "TESTHOST"))
40(test "Nonexistent host name" `(404 ,NOT-FOUND) (fetch-file "hello.txt" "call-with-previous-continuation.org"))
41(test-end "vhost support")
42
43(define chicken-logo.png (with-input-from-file "testweb/pics/chicken-logo.png" read-string))
44(define lambda-chicken.gif (with-input-from-file "testweb/pics/lambda-chicken.gif" read-string))
45(define index.html (with-input-from-file "testweb/index.html" read-string))
46(define index-subdir (with-input-from-file "testweb/subdir/index.html" read-string))
47(define index-subsubdir (with-input-from-file "testweb/subdir/subsubdir/index.html" read-string))
48
49(test-begin "static file serving")
50(test "Nonexistant file" `(404 ,NOT-FOUND) (fetch-file "bogus" "testhost"))
51(test "Nonexistant file mimetype" 'text/html (header-value 'content-type (get-headers "bogus" "testhost")))
52(test "Nonexistant file with extension" `(404 ,NOT-FOUND) (fetch-file "bogus.gif" "testhost"))
53(test "Nonexistant file with extension mimetype" 'text/html (header-value 'content-type (get-headers "bogus.gif" "testhost")))
54(test "text/plain mimetype" 'text/plain (header-value 'content-type (get-headers "hello.txt" "testhost")))
55(test "image/gif mimetype" 'image/gif (header-value 'content-type (get-headers "pics/lambda-chicken.gif" "testhost")))
56(test "image/gif contents" `(200 ,lambda-chicken.gif) (fetch-file "pics/lambda-chicken.gif" "testhost"))
57(test "image/png mimetype" 'image/png (header-value 'content-type (get-headers "pics/chicken-logo.png" "testhost")))
58(test "image/png contents" `(200 ,chicken-logo.png)  (fetch-file "pics/chicken-logo.png" "testhost"))
59(test "unknown mimetype" 'application/unknown (header-value 'content-type (get-headers "data" "testhost")))
60(test "directory listing denied" `(403 ,"forbidden") (fetch-file "pics/" "testhost"))
61(test-end "static file serving")
62
63(test-begin "path normalization")
64(test "index page redir" '(/ "subdir" "") (uri-path (header-value 'location (get-headers "/subdir" "testhost"))))
65(test "index page redir preserves GET args" '((foo . "bar")) (uri-query (header-value 'location (get-headers "/subdir?foo=bar" "testhost"))))
66(test "index page redir status" 301 (car (fetch-file "/subdir" "testhost")))
67(test "index page" `(200 ,index-subdir) (fetch-file "/subdir/" "testhost"))
68(test "break out of webroot fails" `(200 ,index-subdir) (fetch-file "/subdir/../../subdir/" "testhost"))
69(test "index page in subdir vhost" `(200 ,index-subdir) (fetch-file "/" "subdir-host"))
70(test "index page redir for subdir vhost" '(/ "subsubdir" "") (uri-path (header-value 'location (get-headers "/subsubdir" "subdir-host"))))
71(test "index page redir status for subdir vhost" `301 (car (fetch-file "/subsubdir" "subdir-host")))
72(test "index page in subdir for subdir vhost" `(200 ,index-subsubdir) (fetch-file "/subsubdir/" "subdir-host"))
73(test "break out of vhost webroot gives index of root" `(200 ,index-subsubdir) (fetch-file "/subsubdir/../../subsubdir/" "subdir-host"))
74(test "break out of vhost webroot fails" `(404 ,NOT-FOUND) (fetch-file "../hello.txt" "subdir-host"))
75(test "encoded break out of vhost webroot fails" `(404 ,NOT-FOUND) (fetch-file "%2e%2e%2fhello.txt" "subdir-host"))
76(test-end "path normalization")
77
78(test-begin "access files")
79(set! counter 0)
80(test "Two slashes" `(200 ,index-subdir) (fetch-file "subdir//" "testhost"))
81(test "After two slashes, counter is 1" 1 counter)
82(test "Dir request" `(200 ,noway) (fetch-file "secrets" "testhost")) ;; Access file applies on dir and all below
83(test "File request in dir" `(200 ,noway) (fetch-file "secrets/password.txt" "testhost"))
84(test "Subdir request" `(200 ,noway) (fetch-file "secrets/bank" "testhost"))
85(test "File request in subdir" `(200 ,noway) (fetch-file "secrets/bank/pin-code.txt" "testhost"))
86(test-end "access files")
87
88(test-begin "miscellaneous")
89(test "redirect" 303 (car (fetch-file "blah" "redirect-host")))
90(test "redirect location" (uri-reference "/move-along") (header-value 'location (get-headers "blah" "redirect-host")))
91(test "internal error" `(500 ,EXN) (fetch-file "cause-error" "error-host"))
92(set! counter 0)
93(test "load-once" `(200 "") (fetch-file "load-once-resource" "localhost"))
94(test "After load-once, counter is 1" 1 counter)
95(test-end "miscellaneous")
Note: See TracBrowser for help on using the repository browser.