Plugged gaping security hole.

[scratchy.git] / burrower.scm

diff --git a/burrower.scm b/burrower.scm
index 4d00253..8829de4 100644 (file)
--- a/burrower.scm
+++ b/burrower.scm
@@ -18,7 +18,7 @@
 
 ;;; Global constants
 
-(define gopher-index-file-name "index")
+(define gopher-index-filename "index")
 
 (define burrower-version "1.0.0")
 
@@ -109,12 +109,17 @@
       ((h) (serve-url selector config))
       (else (serve-binary-file selector config)))))
 
+(define (legal-filename? filename config)
+  (and (string-prefix? (config-root-dir config)
+                       (normalize-pathname filename))
+       (regular-file? filename)))
+
 (define (serve-directory selector config)
-  (let ((file-name (make-pathname (list (config-root-dir config) selector)
-                                  gopher-index-file-name)))
-    (if (regular-file? file-name)
+  (let ((filename (make-pathname (list (config-root-dir config) selector
+                                  gopher-index-filename))))
+    (if (legal-filename? filename config)
         (begin
-          (with-input-from-file file-name
+          (with-input-from-file filename
             (lambda ()
               (let loop ((c (peek-char)))
                 (if (eof-object? c)
@@ -132,20 +137,20 @@
         (error "Index file not found."))))
   
 (define (serve-text-file selector config)
-  (let ((file-name (make-pathname (config-root-dir config) selector)))
-    (if (regular-file? file-name)
-        (with-input-from-file file-name
+  (let ((filename (make-pathname (config-root-dir config) selector)))
+    (if (legal-filename? filename config)
+        (with-input-from-file filename
           (lambda ()
             (for-each
              (lambda (line)
                (print line "\r"))
              (read-lines))))
-        (error "File not found." file-name))))
+        (error "File not found." filename))))
 
 (define (serve-binary-file selector config)
-  (let ((file-name (make-pathname (config-root-dir config) selector)))
-    (if (regular-file? file-name)
-        (with-input-from-file file-name
+  (let ((filename (make-pathname (config-root-dir config) selector)))
+    (if (legal-filename? filename config)
+        (with-input-from-file filename
           (lambda ()
             (let loop ((b (read-byte)))
               (if (eof-object? b)
@@ -153,13 +158,13 @@
                   (begin
                     (write-byte b)
                     (loop (read-byte)))))))
-        (error "File not found." file-name))))
+        (error "File not found." filename))))
 
 (define (serve-query selector arguments config)
-  (let ((file-name (make-pathname (config-root-dir config) selector)))
-    (if (and (regular-file? file-name)
+  (let ((filename (make-pathname (config-root-dir config) selector)))
+    (if (and (legal-filename? filename config)
              (= (length arguments) 1))
-        (with-input-from-file file-name
+        (with-input-from-file filename
           (lambda ()
             (serve-info-records
              (with-selector-dir