Renamed programme.
[scratchy.git] / gs.scm
diff --git a/gs.scm b/gs.scm
deleted file mode 100644 (file)
index 163eb2c..0000000
--- a/gs.scm
+++ /dev/null
@@ -1,132 +0,0 @@
-(import (chicken tcp)
-        (chicken port)
-        (chicken io)
-        (chicken string)
-        (chicken pathname)
-        (chicken file posix)
-        (chicken time posix)
-        (chicken condition)
-        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)
-  (print "Gopher server listening on port " gopher-server-port " ...")
-  (let ((listener (tcp-listen gopher-server-port)))
-    (let 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."))
-        (close-input-port in-port)
-        (close-output-port out-port))
-      (loop))
-    (tcp-close listener)))
-
-;;; Selector retrieval
-
-(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)))
-        (error "Index 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
-
-(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 "."))