Normalize resource path in `find-resource-file`.

`..` and `.` are now legal as long as long as the path does not reference the
resource root directory's parent.

1 files changed, 9 insertions, 9 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 &not-found)
 (export not-found-condition?)
 (s35:define-condition-type &not-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))))))