Reimagining implementation.

diff --git a/gopher-server.scm b/gopher-server.scm
index f047bdc..26814d8 100644 (file)
--- a/gopher-server.scm
+++ b/gopher-server.scm
@@ -6,6 +6,7 @@
         (chicken file posix)
         (chicken time posix)
         (chicken condition)
+        (chicken process)
         (chicken process-context)
         srfi-13)
 
@@ -15,9 +16,16 @@
 ;; We don't actually use worker threads here to handle requests,
 ;; the server just blocks until the first request is finished.
 
-(define (run-server gopher-root gopher-server-hostname gopher-server-port)
-  (print "Gopher server listening on port " gopher-server-port " ...")
-  (let ((listener (tcp-listen gopher-server-port)))
+(define (make-server-config root-dir host port)
+  (list root-dir host port))
+
+(define (server-root-dir config) (list-ref config 0))
+(define (server-host config) (list-ref config 1))
+(define (server-port config) (list-ref config 2))
+
+(define (run-server config)
+  (print "Gopher server listening on port " (server-port config) " ...")
+  (let ((listener (tcp-listen (server-port config))))
     (let server-loop ()
       (let-values (((in-port out-port) (tcp-accept listener)))
         (let* ((line (read-line in-port))
@@ -29,13 +37,10 @@
               (begin
                 (with-output-to-port out-port
                   (lambda ()
-                    (serve-file 
-                     (if (= (string-length selector) 0)
-                         "1/"
-                         selector)
-                     gopher-root
-                     gopher-server-hostname
-                     gopher-server-port)))
+                    (serve-selector (if (= (string-length selector) 0)
+                                        "/"
+                                        selector)
+                                    config)))
                 (print "... served selector '" selector "'. Closing connection."))
             (o (exn)
                (print-error-message o out-port)
@@ -47,30 +52,43 @@
     (tcp-close listener)))
 
 
-;;; Item retrieval
+;;; Selector retrieval
 
-(define (serve-file selector gopher-root server-host server-port)
-  (let ((type (with-input-from-string (substring selector 0 1) read))
-        (path (substring selector 1)))
-    (case type
-      ((1) (serve-index-file path gopher-root server-host server-port))
-      ((0) (serve-text-file path gopher-root))
-      ((9 g I) (serve-binary-file path gopher-root))
-      (else (error "Unhandled file type:" type)))))
+(define (directory-selector? selector)
+  (string-suffix? "/" selector))
 
-(define (serve-index-file path gopher-root server-host server-port)
-  (let ((file-name (make-pathname (list gopher-root path) gopher-index-file-name)))
+(define (text-selector? selector)
+  (apply or (map (lambda (ext) (string-suffix? ext selector))
+                 '(".txt" ".org" ".md"))))
+  
+(define (serve-selector selector config)
+  ((cond
+    ((directory-selector? selector) serve-directory)
+    ((text-selector? seletor) serve-text-file)
+    (else serve-binary-file))
+   selector config))
+
+(define (serve-directory path config)
+  (let ((file-name (make-pathname (list (server-root-dir config) 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)))
+            (let loop ((c (peek-char)))
+              (if (eof-object? c)
+                  'done
+                  (begin
+                    (if (eq? c #\,)
+                        (begin
+                          (read-char)
+                          (serve-record (read) path config)
+                          (read-line))
+                        (serve-info-record (read-line)))
+                    (loop (peek-char)))))))
         (error "Index file not found."))))
   
-(define (serve-text-file path gopher-root)
-  (let ((file-name (make-pathname gopher-root path)))
+(define (serve-text-file path config)
+  (let ((file-name (make-pathname (server-root-dir config) path)))
     (if (regular-file? file-name)
         (with-input-from-file file-name
           (lambda ()
@@ -80,8 +98,8 @@
              (read-lines))))
         (error "File not found." file-name))))
 
-(define (serve-binary-file path gopher-root)
-  (let ((file-name (make-pathname gopher-root path)))
+(define (serve-binary-file path config)
+  (let ((file-name (make-pathname (server-root-dir config) path)))
     (if (regular-file? file-name)
         (with-input-from-file file-name
           (lambda ()
@@ -96,51 +114,8 @@
 
 ;;; Index rendering
 
-(define entry-type car)
-
-(define entry-name cadr)
-
-(define (has-selector? entry) (>= (length entry) 3))
-
-(define (entry-selector entry) (list-ref entry 2))
-
-(define (has-host? entry) (>= (length entry) 4))
-
-(define (entry-host entry) (list-ref entry 3))
-
-(define (has-port? entry) (>= (length entry) 5))
-
-(define (entry-port entry) (list-ref entry 4))
-
-(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)
-                        (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)
-                        default-host))
-       (print* "\t" (if (has-port? entry)
-                        (entry-port entry)
-                        default-port))
-       (print* "\r\n"))
-     (string-split name-string "\n" #t))))
-
-(define (render-index index selector-prefix this-host this-port)
-  (for-each
-   (lambda (entry)
-     (if (eq? (entry-type entry) 'i)
-         (render-entry entry "fake.selector" "fake.host" 1 selector-prefix)
-         (render-entry entry "" this-host this-port selector-prefix)))
-   index)
-  (print "."))
-
+(define (serve-info-record info-string)
+  (print "i" info-string "\tfake\tfake\t1\r"))
 
 ;;; main
 
@@ -157,10 +132,12 @@
               (hostname (cadr args))
               (port (if (= (length args) 3) (string->number (caddr args)) 70)))
           (if port
-              (run-server root hostname port)
+              (run-server (make-server-config root hostname port))
               (error "Invalid port argument." port))))))
 
 (main)
 
 ;; (define (test)
-  ;; (run-server "gopher-root" "localhost" 70))
+  ;; (run-server (make-server-config "gopher-root" "localhost" 70)))
+
+;; (test)