;;; Scratchy gopher server
;;
-;; Requires Chicken 5.0.0.
+;; Requires Chicken 5
;;
;;; Imports
-(import (chicken tcp)
+(import tcp6
(chicken port)
(chicken io)
(chicken string)
;;; Global constants
-(define scratchy-version "1.0.0")
+(define scratchy-version "1.2.1")
(define scratchy-footer
(conc "\n"
(define (run-server config)
(set-buffering-mode! (current-output-port) #:line)
- (let ((listener (tcp-listen (config-port config))))
+ (let ((listener (tcp-listen (config-port config) 10 "::")))
(print "Gopher server listening on port " (config-port config) " ...")
(drop-privs config)
(server-loop listener config))
(define (server-loop listener config)
(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))
- (condition-case
- (begin
- (with-output-to-port out-port
- (lambda ()
- (serve-selector (if (= (string-length selector) 0)
- "/"
- selector)
- config)))
- (print "... served selector '" selector "'. Closing connection."))
- (o (exn)
- (print-error-message o out-port)
- (print-error-message o)
- (print "Error while attempting to serve selector " selector ".")))))
+ (let-values (((local-ip remote-ip) (tcp-addresses in-port)))
+ (print "Accepted connection from " remote-ip
+ " on " (seconds->string)))
+ (condition-case
+ (let* ((line (read-line in-port))
+ (selector-raw (string-trim-both line))
+ (selector (if (= (string-length selector-raw) 0)
+ "/"
+ selector-raw)))
+ (condition-case
+ (begin
+ (with-output-to-port out-port
+ (lambda ()
+ (serve-selector selector config)))
+ (print "... served selector '" selector "'. Closing connection."))
+ (o (exn)
+ (print-error-message o out-port)
+ (print-error-message o)
+ (print "Error while attempting to serve selector " selector "."))))
+ (o (exn)
+ (print-error-message o)))
(close-input-port in-port)
(close-output-port out-port))
(server-loop listener config))
(selector (car selector-list))
(arguments (cdr selector-list)))
(if (string-contains selector "|")
- (let ((l (string-split selector "|")))
+ (let ((l (string-split selector "|" #t)))
(serve-script (car l) (cdr l) config))
(case (infer-selector-type selector)
((1) (serve-directory-file selector config))
- ((7) (let ((l (string-split selector "?")))
+ ((7) (let ((l (string-split selector "?" #t)))
(serve-script (car l) arguments config)))
((0) (serve-text-file selector config))
((h) (serve-url selector config))