From: Tim Vaughan <timv@ughan.xyz>
Date: Wed, 13 May 2020 16:16:38 +0000 (+0200)
Subject: Remove requirement of trailing slash on directory selectors.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=03b5e62d691ad9bcd89fb76e5b164a36cce9f17c;p=scratchy.git

Remove requirement of trailing slash on directory selectors.
---

diff --git a/scratchy.scm b/scratchy.scm
index 04a4d6e..cd4fa8e 100644
--- a/scratchy.scm
+++ b/scratchy.scm
@@ -68,10 +68,7 @@
                                    (config-blacklist config)
                                  read))))
               (let* ((line (read-line in-port))
-                     (selector-raw (string-trim-both line))
-                     (selector (if (= (string-length selector-raw) 0)
-                                   "/"
-                                   selector-raw)))
+                     (selector (string-trim-both line)))
                 (condition-case
                     (begin
                       (with-output-to-port out-port
@@ -133,19 +130,23 @@
 ;;; Selector retrieval
 
 (define (serve-selector raw-selector config)
-  (let* ((selector-list (string-split raw-selector "\t"))
+  (let* ((selector-list (string-split raw-selector "\t" #t))
          (selector (car selector-list))
          (arguments (cdr selector-list)))
-    (if (string-contains selector "|")
-        (let ((l (string-split selector "|" #t)))
-          (serve-script (car l) (cdr l) config))
-        (case (infer-selector-type selector)
-          ((1) (serve-directory-file selector config))
-          ((7) (let ((l (string-split selector "?" #t)))
-                 (serve-script (car l) arguments config)))
-          ((0) (serve-text-file selector config))
-          ((h) (serve-url selector config))
-          (else (serve-binary-file selector config))))))
+    (cond
+     ((string-contains selector "|")
+      (let ((l (string-split selector "|" #t)))
+        (serve-script (car l) (cdr l) config)))
+     ((legal-filename? (directory-index-filename selector config) config)
+      (serve-directory-file selector config))
+     (else
+      (case (infer-selector-type selector)
+        ((1) (error "Invalid directory selector."))
+        ((7) (let ((l (string-split selector "?" #t)))
+               (serve-script (car l) arguments config)))
+        ((0) (serve-text-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)
@@ -159,9 +160,13 @@
        (string-suffix? ".scm" filename)
        (file-executable? filename)))
 
+(define (directory-index-filename selector config)
+  (make-pathname (list (config-root-dir config)
+                       selector)
+                 gopher-index-filename))
+
 (define (serve-directory-file selector config)
-  (let ((filename (make-pathname (list (config-root-dir config) selector)
-                                 gopher-index-filename)))
+  (let ((filename (directory-index-filename selector config)))
     (if (legal-filename? filename config)
         (begin
           (with-input-from-file filename
@@ -322,8 +327,8 @@
 
 (define (with-selector-dir selector config thunk)
   (with-current-working-directory
-   (make-pathname (config-root-dir config)
-                  (pathname-directory selector)) thunk))
+   (make-pathname (config-root-dir config) selector)
+   thunk))
 
 
 ;;; Main