Plugged gaping security hole.

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
 
 
 ;;; Global constants
 

-(define gopher-index-file-name "index")
+(define gopher-index-filename "index")

 
 (define burrower-version "1.0.0")
 
 
 (define burrower-version "1.0.0")
 


@@ -109,12 +109,17 @@
       ((h) (serve-url selector config))
       (else (serve-binary-file selector config)))))
 
       ((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)
 (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
         (begin

-          (with-input-from-file file-name
+          (with-input-from-file filename

             (lambda ()
               (let loop ((c (peek-char)))
                 (if (eof-object? c)
             (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)
         (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))))
           (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)
 
 (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)
           (lambda ()
             (let loop ((b (read-byte)))
               (if (eof-object? b)


@@ -153,13 +158,13 @@
                   (begin
                     (write-byte b)
                     (loop (read-byte)))))))
                   (begin
                     (write-byte b)
                     (loop (read-byte)))))))

-        (error "File not found." file-name))))
+        (error "File not found." filename))))

 
 (define (serve-query selector arguments config)
 
 (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))
              (= (length arguments) 1))

-        (with-input-from-file file-name
+        (with-input-from-file filename

           (lambda ()
             (serve-info-records
              (with-selector-dir
           (lambda ()
             (serve-info-records
              (with-selector-dir