11 (define gopher-root "./gopher-root")
12 (define index-file-name "index")
13 (define gopher-server-hostname "localhost")
14 (define gopher-server-port 70)
17 (print "Gopher server listening on port " gopher-server-port " ...")
18 (let ((listener (tcp-listen gopher-server-port)))
20 (let-values (((in-port out-port) (tcp-accept listener)))
21 (let* ((line (read-line in-port))
22 (selector (string-trim-both line)))
23 (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
24 (print "Accepted connection from " remote-ip
25 " on " (seconds->string)))
26 (with-output-to-port out-port
29 (if (= (string-length selector) 0)
33 gopher-server-hostname
35 (print "... retrieved selector '" selector "'. Closing connection."))
36 (close-input-port in-port)
37 (close-output-port out-port))
39 (tcp-close listener)))
41 ;;; Selector retrieval
43 (define (retrieve-selector selector gopher-root server-host server-port)
44 (if (string-suffix? "/" selector)
45 (retrieve-index-file (make-pathname gopher-root (make-pathname selector index-file-name))
49 (retrieve-text-file (make-pathname gopher-root selector)
53 (define (retrieve-index-file index-file-name index-selector server-host server-port)
54 (if (file-exists? index-file-name)
55 (with-input-from-file index-file-name
61 (print "Error: index file not found.")))
64 (define (retrieve-text-file file-name server-host server-port)
65 (if (file-exists? file-name)
66 (with-input-from-file file-name
72 (print "Error: file not found.")))
76 (define entry-type car)
78 (define entry-name cadr)
80 (define (has-selector? entry) (>= (length entry) 3))
82 (define (entry-selector entry) (list-ref entry 2))
84 (define (has-host? entry) (>= (length entry) 4))
86 (define (entry-host entry) (list-ref entry 3))
88 (define (has-port? entry) (>= (length entry) 5))
90 (define (entry-port entry) (list-ref entry 4))
92 (define (normalize-selector selector selector-prefix)
93 (if (string-prefix? "/" selector)
95 (make-pathname selector-prefix selector)))
97 (define (render-entry entry default-selector default-host default-port selector-prefix)
98 (let ((name-string (entry-name entry)))
100 (lambda (name-string-line)
101 (print* (entry-type entry) name-string-line)
102 (print* "\t" (if (has-selector? entry)
103 (normalize-selector (entry-selector entry) selector-prefix)
105 (print* "\t" (if (has-host? entry)
108 (print* "\t" (if (has-port? entry)
112 (string-split name-string "\n" #t))))
114 (define (render-index index selector-prefix this-host this-port)
117 (if (eq? (entry-type entry) 'i)
118 (render-entry entry "fake.selector" "fake.host" 1 selector-prefix)
119 (render-entry entry "" this-host this-port selector-prefix)))