(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
(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)
(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 "."))