From fe1ccf11bcd8dfaab0dde02e7f16378f509447c8 Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Mon, 15 Apr 2019 00:27:52 +0200
Subject: [PATCH] Renamed programme.

---
 gs.scm => gopher-server.scm | 88 +++++++++++++++++++++++++------------
 1 file changed, 61 insertions(+), 27 deletions(-)
 rename gs.scm => gopher-server.scm (61%)

diff --git a/gs.scm b/gopher-server.scm
similarity index 61%
rename from gs.scm
rename to gopher-server.scm
index 163eb2c..f047bdc 100644
--- a/gs.scm
+++ b/gopher-server.scm
@@ -6,50 +6,59 @@
         (chicken file posix)
         (chicken time posix)
         (chicken condition)
+        (chicken process-context)
         srfi-13)
 
-(define gopher-root "./gopher-root")
 (define gopher-index-file-name "index")
-(define gopher-server-hostname "localhost")
-(define gopher-server-port 70)
 
-(define (run-server)
+;;; Server loop
+;; 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)))
-    (let loop ()
+    (let server-loop ()
       (let-values (((in-port out-port) (tcp-accept listener)))
         (let* ((line (read-line in-port))
                (selector (string-trim-both line)))
           (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
             (print "Accepted connection from " remote-ip
                    " on " (seconds->string)))
-          (with-output-to-port out-port
-            (lambda ()
-              (serve-selector 
-               (if (= (string-length selector) 0)
-                   "1/"
-                   selector)
-               gopher-root
-               gopher-server-hostname
-               gopher-server-port)))
-          (print "... served selector '" selector "'. Closing connection."))
+          (condition-case
+              (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)))
+                (print "... served selector '" selector "'. Closing connection."))
+            (o (exn)
+               (print-error-message o out-port)
+               (print-error-message o)
+               (print "Error while attempting to serve selector " selector "."))))
         (close-input-port in-port)
         (close-output-port out-port))
-      (loop))
+      (server-loop))
     (tcp-close listener)))
 
-;;; Selector retrieval
 
-(define (serve-selector selector gopher-root server-host server-port)
+;;; Item 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
-      ((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))
+      ((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 (serve-index-file path server-host server-port)
+(define (serve-index-file path gopher-root 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
@@ -60,7 +69,7 @@
                           server-port)))
         (error "Index file not found."))))
   
-(define (serve-text-file path server-host server-port)
+(define (serve-text-file path gopher-root)
   (let ((file-name (make-pathname gopher-root path)))
     (if (regular-file? file-name)
         (with-input-from-file file-name
@@ -69,9 +78,9 @@
              (lambda (line)
                (print line "\r"))
              (read-lines))))
-        (error "File not found."))))
+        (error "File not found." file-name))))
 
-(define (serve-binary-file path server-host server-port)
+(define (serve-binary-file path gopher-root)
   (let ((file-name (make-pathname gopher-root path)))
     (if (regular-file? file-name)
         (with-input-from-file file-name
@@ -81,8 +90,9 @@
                   'done
                   (begin
                     (write-byte b)
-                    (loop (read-byte)))))))))
-  (print "File not found."))
+                    (loop (read-byte)))))))
+        (error "File not found." file-name))))
+
 
 ;;; Index rendering
 
@@ -130,3 +140,27 @@
          (render-entry entry "" this-host this-port selector-prefix)))
    index)
   (print "."))
+
+
+;;; main
+
+(define (main)
+  (let ((progname (car (argv)))
+        (args (cdr (argv))))
+    (if (or (< (length args) 2)
+            (equal? (car args) "-h")
+            (equal? (car args) "--help"))
+        (print "Usage:\n"
+               progname " -h/--help\n"
+               progname " gopher-root-dir server-hostname server-port")
+        (let ((root (car args))
+              (hostname (cadr args))
+              (port (if (= (length args) 3) (string->number (caddr args)) 70)))
+          (if port
+              (run-server root hostname port)
+              (error "Invalid port argument." port))))))
+
+(main)
+
+;; (define (test)
+  ;; (run-server "gopher-root" "localhost" 70))
-- 
2.20.1