From: Tim Vaughan Date: Tue, 30 Apr 2019 07:17:13 +0000 (+0200) Subject: Reimagining implementation. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scratchy.git;a=commitdiff_plain;h=b1a876b00024684c6b6634e7d3af6e3e0b121c86 Reimagining implementation. --- diff --git a/gopher-server.scm b/gopher-server.scm index f047bdc..26814d8 100644 --- a/gopher-server.scm +++ b/gopher-server.scm @@ -6,6 +6,7 @@ (chicken file posix) (chicken time posix) (chicken condition) + (chicken process) (chicken process-context) srfi-13) @@ -15,9 +16,16 @@ ;; We don't actually use worker threads here to handle requests, ;; the server just blocks until the first request is finished. -(define (run-server gopher-root gopher-server-hostname gopher-server-port) - (print "Gopher server listening on port " gopher-server-port " ...") - (let ((listener (tcp-listen gopher-server-port))) +(define (make-server-config root-dir host port) + (list root-dir host port)) + +(define (server-root-dir config) (list-ref config 0)) +(define (server-host config) (list-ref config 1)) +(define (server-port config) (list-ref config 2)) + +(define (run-server config) + (print "Gopher server listening on port " (server-port config) " ...") + (let ((listener (tcp-listen (server-port config)))) (let server-loop () (let-values (((in-port out-port) (tcp-accept listener))) (let* ((line (read-line in-port)) @@ -29,13 +37,10 @@ (begin (with-output-to-port out-port (lambda () - (serve-file - (if (= (string-length selector) 0) - "1/" - selector) - gopher-root - gopher-server-hostname - gopher-server-port))) + (serve-selector (if (= (string-length selector) 0) + "/" + selector) + config))) (print "... served selector '" selector "'. Closing connection.")) (o (exn) (print-error-message o out-port) @@ -47,30 +52,43 @@ (tcp-close listener))) -;;; Item retrieval +;;; Selector retrieval -(define (serve-file selector gopher-root server-host server-port) - (let ((type (with-input-from-string (substring selector 0 1) read)) - (path (substring selector 1))) - (case type - ((1) (serve-index-file path gopher-root server-host server-port)) - ((0) (serve-text-file path gopher-root)) - ((9 g I) (serve-binary-file path gopher-root)) - (else (error "Unhandled file type:" type))))) +(define (directory-selector? selector) + (string-suffix? "/" selector)) -(define (serve-index-file path gopher-root server-host server-port) - (let ((file-name (make-pathname (list gopher-root path) gopher-index-file-name))) +(define (text-selector? selector) + (apply or (map (lambda (ext) (string-suffix? ext selector)) + '(".txt" ".org" ".md")))) + +(define (serve-selector selector config) + ((cond + ((directory-selector? selector) serve-directory) + ((text-selector? seletor) serve-text-file) + (else serve-binary-file)) + selector config)) + +(define (serve-directory path config) + (let ((file-name (make-pathname (list (server-root-dir config) 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))) + (let loop ((c (peek-char))) + (if (eof-object? c) + 'done + (begin + (if (eq? c #\,) + (begin + (read-char) + (serve-record (read) path config) + (read-line)) + (serve-info-record (read-line))) + (loop (peek-char))))))) (error "Index file not found.")))) -(define (serve-text-file path gopher-root) - (let ((file-name (make-pathname gopher-root path))) +(define (serve-text-file path config) + (let ((file-name (make-pathname (server-root-dir config) path))) (if (regular-file? file-name) (with-input-from-file file-name (lambda () @@ -80,8 +98,8 @@ (read-lines)))) (error "File not found." file-name)))) -(define (serve-binary-file path gopher-root) - (let ((file-name (make-pathname gopher-root path))) +(define (serve-binary-file path config) + (let ((file-name (make-pathname (server-root-dir config) path))) (if (regular-file? file-name) (with-input-from-file file-name (lambda () @@ -96,51 +114,8 @@ ;;; 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 ".")) - +(define (serve-info-record info-string) + (print "i" info-string "\tfake\tfake\t1\r")) ;;; main @@ -157,10 +132,12 @@ (hostname (cadr args)) (port (if (= (length args) 3) (string->number (caddr args)) 70))) (if port - (run-server root hostname port) + (run-server (make-server-config root hostname port)) (error "Invalid port argument." port)))))) (main) ;; (define (test) - ;; (run-server "gopher-root" "localhost" 70)) + ;; (run-server (make-server-config "gopher-root" "localhost" 70))) + +;; (test)