Can now serve binary files.

diff --git a/gs.scm b/gs.scm
index 5f6f87f..163eb2c 100644 (file)
--- a/gs.scm
+++ b/gs.scm
@@ -3,13 +3,13 @@
         (chicken io)
         (chicken string)
         (chicken pathname)
         (chicken io)
         (chicken string)
         (chicken pathname)

-        (chicken file)
+        (chicken file posix)

         (chicken time posix)
         (chicken time posix)

-        srfi-1
+        (chicken condition)

         srfi-13)
 
 (define gopher-root "./gopher-root")
         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)
 
 (define gopher-server-hostname "localhost")
 (define gopher-server-port 70)
 


@@ -25,14 +25,14 @@
                    " on " (seconds->string)))
           (with-output-to-port out-port
             (lambda ()
                    " on " (seconds->string)))
           (with-output-to-port out-port
             (lambda ()

-              (retrieve-selector 
+              (serve-selector 

                (if (= (string-length selector) 0)
                (if (= (string-length selector) 0)

-                   "/"
+                   "1/"

                    selector)
                gopher-root
                gopher-server-hostname
                gopher-server-port)))
                    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))
         (close-input-port in-port)
         (close-output-port out-port))
       (loop))


@@ -40,36 +40,49 @@
 
 ;;; Selector retrieval
 
 
 ;;; 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)))
                           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
 
 
 ;;; Index rendering
 


@@ -89,18 +102,16 @@
 
 (define (entry-port entry) (list-ref entry 4))
 
 
 (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)
 (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)
                         default-selector))
        (print* "\t" (if (has-host? entry)
                         (entry-host entry)