(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 "."))