Initial commit.

diff --git a/gs.scm b/gs.scm
new file mode 100644 (file)
index 0000000..c655e41
--- /dev/null
+++ b/gs.scm
@@ -0,0 +1,107 @@
+(import (chicken tcp)
+        (chicken port)
+        (chicken io)
+        (chicken string)
+        (chicken pathname)
+        (chicken time posix)
+        srfi-1
+        srfi-13)
+
+(define gopher-root "./gopher-root")
+(define index-file-name "index")
+(define gopher-server-hostname "egan.icytree.org")
+(define gopher-server-port 70)
+
+(define (run-server)
+  (let ((listener (tcp-listen gopher-server-port)))
+    (print "Gopher server listening on port " gopher-server-port " ...")
+    (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 ()
+            (retrieve-selector 
+             (if (= (string-length selector) 0)
+                 "/"
+                 selector)
+             gopher-root
+             gopher-server-hostname
+             gopher-server-port)))
+        (print "... retrieved selector '" selector "'. Closing connection."))
+      (close-input-port in-port)
+      (close-output-port out-port))
+    (tcp-close listener))
+  (run-server))
+
+;;; 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))
+                           server-host
+                           server-port)
+      (retrieve-text-file (make-pathname gopher-root selector)
+                          server-host
+                          server-port)))
+
+(define (retrieve-index-file index-file-name server-host server-port)
+  (with-input-from-file index-file-name
+    (lambda ()
+      (render-index (read)
+                    server-host
+                    server-port))))
+
+(define (retrieve-text-file file-name server-host server-port)
+  (with-input-from-file file-name
+    (lambda ()
+      (for-each
+       (lambda (line)
+         (print line "\r"))
+       (read-lines)))))
+
+;;; 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)
+  (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)
+                        (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 this-host this-port)
+  (for-each
+   (lambda (entry)
+     (if (eq? (entry-type entry) 'i)
+         (render-entry entry "fake.selector" "fake.host" 1)
+         (render-entry entry "" this-host this-port)))
+   index)
+  (print "."))