From: Tim Vaughan 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