diff options
| -rw-r--r-- | src/guile/cantius.scm | 18 | ||||
| -rw-r--r-- | tests/guile/cantius-test.scm | 25 |
2 files changed, 18 insertions, 25 deletions
diff --git a/src/guile/cantius.scm b/src/guile/cantius.scm index 648a5a2..247807b 100644 --- a/src/guile/cantius.scm +++ b/src/guile/cantius.scm @@ -24,13 +24,6 @@ -(define %illegal-path-regex - ;; Forbid `.` and `..` segments in paths. - (make-regexp "^(.*/)?[.][.]?(/.*)?$")) - -(define legal-path? - (negate (cut regexp-exec %illegal-path-regex <>))) - (export ¬-found) (export not-found-condition?) (s35:define-condition-type ¬-found s35:&condition @@ -66,9 +59,16 @@ ((_ _ (segment . rest)) (loop parent-walks (cons segment processed) rest))))) +(define %illegal-path-regex + ;; Assume normalized path, forbid parent directory ref. + (make-regexp "^/?[.][.](/.*)?$")) + (export find-resource-file) (define* (find-resource-file file #:optional (root-path (%resource-root-path))) - (unless (legal-path? file) + (define normalized-file + (normalize-path file)) + + (when (regexp-exec %illegal-path-regex normalized-file) (raise (s35:condition (&forbidden) (s35:&message @@ -83,7 +83,7 @@ (message (format #f "Resource not found ~a" file)))))) ((? string?) (loop (list root-path))) - (((= (cut format #f "~a/~a" <> file) file-path) + (((= (cut format #f "~a/~a" <> normalized-file) file-path) . paths-rest) (or (and (stat file-path #f) file-path) (loop paths-rest)))))) diff --git a/tests/guile/cantius-test.scm b/tests/guile/cantius-test.scm index e497bfe..328573c 100644 --- a/tests/guile/cantius-test.scm +++ b/tests/guile/cantius-test.scm @@ -189,22 +189,15 @@ (tu:test-assert (string-prefix? ";;; " (cadr valid-resource-result)))) (tu:test-group "illegal-static-resources" - (for-each (lambda (resource-path) - (define illegal-resource-result - (get resource-path)) - - (tu:test-eqv 403 - (rsp:response-code (car illegal-resource-result))) - - ;; Default handler for illegal resource accesses is expected to - ;; ignore the value of the `%default-headers` parameter. - (tu:test-equal '(text/plain (charset . "utf-8")) - (rsp:response-content-type - (car illegal-resource-result)))) - - '("/static/../../../../../etc/passwd" - "/static/stylesheets/." - "/static/nonfree/../scripts/main.js"))) + (define illegal-resource-result + (get "/static/stylesheets/../../../../../../etc/passwd")) + + (tu:test-eqv 403 (rsp:response-code (car illegal-resource-result))) + + ;; Default handler for illegal resource accesses is expected to ignore the + ;; value of the `%default-headers` parameter. + (tu:test-equal '(text/plain (charset . "utf-8")) + (rsp:response-content-type (car illegal-resource-result)))) (tu:test-group "missing-static-resources" (define missing-resource-result |