From: Tim Vaughan <tgvaughan@gmail.com>
Date: Sun, 14 Apr 2019 20:53:39 +0000 (+0200)
Subject: Can now serve binary files.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=0ee2c323a8d80343a8110928007c596c66c8084b;p=scratchy.git

Can now serve binary files.
---

diff --git a/gs.scm b/gs.scm
index 5f6f87f..163eb2c 100644
--- a/gs.scm
+++ b/gs.scm
@@ -3,13 +3,13 @@
         (chicken io)
         (chicken string)
         (chicken pathname)
-        (chicken file)
+        (chicken file posix)
         (chicken time posix)
-        srfi-1
+        (chicken condition)
         srfi-13)
 
 (define gopher-root "./gopher-root")
-(define index-file-name "index")
+(define gopher-index-file-name "index")
 (define gopher-server-hostname "localhost")
 (define gopher-server-port 70)
 
@@ -25,14 +25,14 @@
                    " on " (seconds->string)))
           (with-output-to-port out-port
             (lambda ()
-              (retrieve-selector 
+              (serve-selector 
                (if (= (string-length selector) 0)
-                   "/"
+                   "1/"
                    selector)
                gopher-root
                gopher-server-hostname
                gopher-server-port)))
-          (print "... retrieved selector '" selector "'. Closing connection."))
+          (print "... served selector '" selector "'. Closing connection."))
         (close-input-port in-port)
         (close-output-port out-port))
       (loop))
@@ -40,36 +40,49 @@
 
 ;;; Selector retrieval
 
-(define (retrieve-selector selector gopher-root server-host server-port)
-  (if (string-suffix? "/" selector)
-      (retrieve-index-file (make-pathname gopher-root (make-pathname selector index-file-name))
-                           selector
-                           server-host
-                           server-port)
-      (retrieve-text-file (make-pathname gopher-root selector)
+(define (serve-selector selector gopher-root server-host server-port)
+  (let ((type (with-input-from-string (substring selector 0 1) read))
+        (path (substring selector 1)))
+    (case type
+      ((0) (serve-text-file path server-host server-port))
+      ((1) (serve-index-file path server-host server-port))
+      ((9 g I) (serve-binary-file path server-host server-port))
+      (else (error "Unhandled file type:" type)))))
+
+(define (serve-index-file path server-host server-port)
+  (let ((file-name (make-pathname (list gopher-root path) gopher-index-file-name)))
+    (if (regular-file? file-name)
+        (with-input-from-file file-name
+          (lambda ()
+            (render-index (read)
+                          path
                           server-host
                           server-port)))
-
-(define (retrieve-index-file index-file-name index-selector server-host server-port)
-  (if (file-exists? index-file-name)
-      (with-input-from-file index-file-name
-        (lambda ()
-          (render-index (read)
-                        index-selector
-                        server-host
-                        server-port)))
-      (print "Error: index file not found.")))
+        (error "Index file not found."))))
   
-
-(define (retrieve-text-file file-name server-host server-port)
-  (if (file-exists? file-name)
-      (with-input-from-file file-name
-        (lambda ()
-          (for-each
-           (lambda (line)
-             (print line "\r"))
-           (read-lines))))
-      (print "Error: file not found.")))
+(define (serve-text-file path server-host server-port)
+  (let ((file-name (make-pathname gopher-root path)))
+    (if (regular-file? file-name)
+        (with-input-from-file file-name
+          (lambda ()
+            (for-each
+             (lambda (line)
+               (print line "\r"))
+             (read-lines))))
+        (error "File not found."))))
+
+(define (serve-binary-file path server-host server-port)
+  (let ((file-name (make-pathname gopher-root path)))
+    (if (regular-file? file-name)
+        (with-input-from-file file-name
+          (lambda ()
+            (let loop ((b (read-byte)))
+              (if (eof-object? b)
+                  'done
+                  (begin
+                    (write-byte b)
+                    (loop (read-byte)))))))))
+  (print "File not found."))
 
 ;;; Index rendering
 
@@ -89,18 +102,16 @@
 
 (define (entry-port entry) (list-ref entry 4))
 
-(define (normalize-selector selector selector-prefix)
-  (if (string-prefix? "/" selector)
-      selector
-      (make-pathname selector-prefix selector)))
-
 (define (render-entry entry default-selector default-host default-port selector-prefix)
   (let ((name-string (entry-name entry)))
     (for-each
      (lambda (name-string-line)
        (print* (entry-type entry) name-string-line)
        (print* "\t" (if (has-selector? entry)
-                        (normalize-selector (entry-selector entry) selector-prefix)
+                        (if (has-host? entry)
+                            (entry-selector entry)
+                            (conc (entry-type entry)
+                                  (make-pathname selector-prefix (entry-selector entry))))
                         default-selector))
        (print* "\t" (if (has-host? entry)
                         (entry-host entry)