9 (chicken process-context)
12 (define gopher-index-file-name "index")
15 ;; We don't actually use worker threads here to handle requests,
16 ;; the server just blocks until the first request is finished.
18 (define (run-server gopher-root gopher-server-hostname gopher-server-port)
19 (print "Gopher server listening on port " gopher-server-port " ...")
20 (let ((listener (tcp-listen gopher-server-port)))
22 (let-values (((in-port out-port) (tcp-accept listener)))
23 (let* ((line (read-line in-port))
24 (selector (string-trim-both line)))
25 (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
26 (print "Accepted connection from " remote-ip
27 " on " (seconds->string)))
30 (with-output-to-port out-port
33 (if (= (string-length selector) 0)
37 gopher-server-hostname
39 (print "... served selector '" selector "'. Closing connection."))
41 (print-error-message o out-port)
42 (print-error-message o)
43 (print "Error while attempting to serve selector " selector "."))))
44 (close-input-port in-port)
45 (close-output-port out-port))
47 (tcp-close listener)))
52 (define (serve-file selector gopher-root server-host server-port)
53 (let ((type (with-input-from-string (substring selector 0 1) read))
54 (path (substring selector 1)))
56 ((1) (serve-index-file path gopher-root server-host server-port))
57 ((0) (serve-text-file path gopher-root))
58 ((9 g I) (serve-binary-file path gopher-root))
59 (else (error "Unhandled file type:" type)))))
61 (define (serve-index-file path gopher-root server-host server-port)
62 (let ((file-name (make-pathname (list gopher-root path) gopher-index-file-name)))
63 (if (regular-file? file-name)
64 (with-input-from-file file-name
70 (error "Index file not found."))))
72 (define (serve-text-file path gopher-root)
73 (let ((file-name (make-pathname gopher-root path)))
74 (if (regular-file? file-name)
75 (with-input-from-file file-name
81 (error "File not found." file-name))))
83 (define (serve-binary-file path gopher-root)
84 (let ((file-name (make-pathname gopher-root path)))
85 (if (regular-file? file-name)
86 (with-input-from-file file-name
88 (let loop ((b (read-byte)))
93 (loop (read-byte)))))))
94 (error "File not found." file-name))))
99 (define entry-type car)
101 (define entry-name cadr)
103 (define (has-selector? entry) (>= (length entry) 3))
105 (define (entry-selector entry) (list-ref entry 2))
107 (define (has-host? entry) (>= (length entry) 4))
109 (define (entry-host entry) (list-ref entry 3))
111 (define (has-port? entry) (>= (length entry) 5))
113 (define (entry-port entry) (list-ref entry 4))
115 (define (render-entry entry default-selector default-host default-port selector-prefix)
116 (let ((name-string (entry-name entry)))
118 (lambda (name-string-line)
119 (print* (entry-type entry) name-string-line)
120 (print* "\t" (if (has-selector? entry)
121 (if (has-host? entry)
122 (entry-selector entry)
123 (conc (entry-type entry)
124 (make-pathname selector-prefix (entry-selector entry))))
126 (print* "\t" (if (has-host? entry)
129 (print* "\t" (if (has-port? entry)
133 (string-split name-string "\n" #t))))
135 (define (render-index index selector-prefix this-host this-port)
138 (if (eq? (entry-type entry) 'i)
139 (render-entry entry "fake.selector" "fake.host" 1 selector-prefix)
140 (render-entry entry "" this-host this-port selector-prefix)))
148 (let ((progname (car (argv)))
150 (if (or (< (length args) 2)
151 (equal? (car args) "-h")
152 (equal? (car args) "--help"))
154 progname " -h/--help\n"
155 progname " gopher-root-dir server-hostname server-port")
156 (let ((root (car args))
157 (hostname (cadr args))
158 (port (if (= (length args) 3) (string->number (caddr args)) 70)))
160 (run-server root hostname port)
161 (error "Invalid port argument." port))))))
166 ;; (run-server "gopher-root" "localhost" 70))