suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixing regression re path restriction patch

Browse Source
This commit is contained in:
Jay McCarthy 2012-12-11 10:47:48 -07:00
parent 5d57f6e497
commit 9a0e948a58
2 changed files with 18 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/tests/web-server/dispatchers/filesystem-map-test.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require rackunit
net/url
racket/list
web-server/private/util
racket/runtime-path
web-server/dispatchers/filesystem-map)
@ -18,23 +19,23 @@
(define test-filter-map (filter-url->path #rx"\\.(ss|scm|rkt)$" test-map))
(define test-filter-valid-map (filter-url->path #rx"\\.(ss|scm|rkt)$" test-valid-map))
(define (test-url->path
(define (test-url->path
url->path file
#:url-string
#:url-string
[url-string
(format "http://test.com/~a" (path->string file))]
#:expected
[expected file])
(define vs
(call-with-values
(lambda () (url->path (string->url url-string)))
(lambda vs vs)))
(lambda () (url->path (string->url url-string)))
(lambda vs vs)))
(check-equal? vs (list (build-path base-dir expected) (explode-path* expected))))
(define filesystem-map-tests
(test-suite
"Filesystem Map"
(test-suite
"url->path"
(test-case "Simple case"
@ -44,9 +45,12 @@
#:url-string "http://test.com/dispatchers/filesystem-map.rkt;foo"))
(test-case "Strips out bad '..'s"
(check-exn exn:fail? (λ () (test-map (string->url "http://test.com/../../dispatchers/filesystem-map.rkt")))))
(test-case "Handles // okay"
(check-equal? (second (call-with-values (λ () (test-map (string->url "http://test.com//dispatchers/filesystem-map.rkt"))) list))
(list 'same (build-path "dispatchers") (build-path "filesystem-map.rkt"))))
(test-case "Leaves in good '..'s"
(test-url->path test-map (build-path "dispatchers/../dispatchers/filesystem-map.rkt"))))
(test-suite
"url->valid-path"
(test-suite
@ -57,14 +61,14 @@
(test-url->path test-valid-map (build-path "dispatchers/filesystem-map.rkt")
#:url-string "http://test.com/dispatchers/filesystem-map.rkt;foo"))
(test-case "Strips out bad '..'s"
(check-exn exn:fail? (λ () (test-valid-map (string->url "http://test.com/../../dispatchers/filesystem-map.rkt")))))
(check-exn exn:fail? (λ () (test-valid-map (string->url "http://test.com/../../dispatchers/filesystem-map.rkt")))))
(test-case "Leaves in good '..'s"
(test-url->path test-valid-map (build-path "dispatchers/../dispatchers/filesystem-map.rkt"))))
(test-case "Finds valid path underneath"
(test-url->path test-valid-map (build-path "dispatchers/filesystem-map.rkt/not-a-file")
#:expected (build-path "dispatchers/filesystem-map.rkt"))))
(test-suite
"filter-url->path"
(test-case "Allows right suffix"
@ -84,4 +88,3 @@
(test-case "Allows content after w/ valid"
(test-url->path test-filter-valid-map (build-path "dispatchers/filesystem-map.rkt/extra/info")
#:expected (build-path "dispatchers/filesystem-map.rkt"))))))

7
collects/web-server/dispatchers/filesystem-map.rkt
View File

@ -71,8 +71,11 @@
(define ((make-url->path base) u)
(define nbase (path->complete-path base))
(define path-from-url
(map path/param-path
(url-path u)))
(for/list ([p/p (in-list (url-path u))])
(match (path/param-path p/p)
["" 'same]
[".." 'up]
[x x])))
(unless (restrict path-from-url)
(error 'url->path "Illegal path: ~e outside base: ~e"
path-from-url