From: Tim Vaughan <tgvaughan@gmail.com>
Date: Mon, 6 May 2019 08:06:07 +0000 (+0200)
Subject: Plugged gaping security hole.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=8b7b8b99877605d47975fc550047493d25c0f392;p=scratchy.git

Plugged gaping security hole.
---

diff --git a/burrower.scm b/burrower.scm
index 4d00253..8829de4 100644
--- 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