From: Tim Vaughan Date: Sun, 14 Apr 2019 16:35:16 +0000 (+0200) Subject: Server is (barely) functional. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=257eddaab0f1a149151d1e33618234b55c7041dc;p=scratchy.git Server is (barely) functional. --- diff --git a/gs.scm b/gs.scm index c655e41..5f6f87f 100644 --- a/gs.scm +++ b/gs.scm @@ -3,64 +3,73 @@ (chicken io) (chicken string) (chicken pathname) + (chicken file) (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-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))) - (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)) + (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 () + (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)) + (loop)) + (tcp-close listener))) ;;; 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)) + selector 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-index-file index-file-name index-selector server-host server-port) + (if (file-exists? index-file-name) + (with-input-from-file index-file-name + (lambda () + (render-index (read) + index-selector + server-host + server-port))) + (print "Error: index file not found."))) + (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))))) + (if (file-exists? file-name) + (with-input-from-file file-name + (lambda () + (for-each + (lambda (line) + (print line "\r")) + (read-lines)))) + (print "Error: file not found."))) ;;; Index rendering @@ -80,13 +89,18 @@ (define (entry-port entry) (list-ref entry 4)) -(define (render-entry entry default-selector default-host default-port) +(define (normalize-selector selector selector-prefix) + (if (string-prefix? "/" selector) + selector + (make-pathname selector-prefix selector))) + +(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) - (entry-selector entry) + (normalize-selector (entry-selector entry) selector-prefix) default-selector)) (print* "\t" (if (has-host? entry) (entry-host entry) @@ -97,11 +111,11 @@ (print* "\r\n")) (string-split name-string "\n" #t)))) -(define (render-index index this-host this-port) +(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) - (render-entry entry "" this-host this-port))) + (render-entry entry "fake.selector" "fake.host" 1 selector-prefix) + (render-entry entry "" this-host this-port selector-prefix))) index) (print "."))