X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scratchy.git;a=blobdiff_plain;f=gs.scm;fp=gs.scm;h=0000000000000000000000000000000000000000;hp=163eb2cc81b5e1be6ec25fa601d96b5af8babb5b;hb=fe1ccf11bcd8dfaab0dde02e7f16378f509447c8;hpb=0ee2c323a8d80343a8110928007c596c66c8084b diff --git a/gs.scm b/gs.scm deleted file mode 100644 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 "."))