The Lambda Lab
/
projects
/
scratchy.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Simplified server server-loop
[scratchy.git]
/
scratchy.scm
diff --git
a/scratchy.scm
b/scratchy.scm
index
bdbdee4
..
0b81523
100644
(file)
--- a/
scratchy.scm
+++ b/
scratchy.scm
@@
-1,11
+1,11
@@
;;; Scratchy gopher server
;;
;;; Scratchy gopher server
;;
-;; Requires Chicken 5
.0.0.
+;; Requires Chicken 5
;;
;;; Imports
;;
;;; Imports
-(import
(chicken tcp)
+(import
tcp6
(chicken port)
(chicken io)
(chicken string)
(chicken port)
(chicken io)
(chicken string)
@@
-20,7
+20,7
@@
;;; Global constants
;;; Global constants
-(define scratchy-version "1.
0
.1")
+(define scratchy-version "1.
2
.1")
(define scratchy-footer
(conc "\n"
(define scratchy-footer
(conc "\n"
@@
-42,7
+42,7
@@
(define (run-server config)
(set-buffering-mode! (current-output-port) #:line)
(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))
(print "Gopher server listening on port " (config-port config) " ...")
(drop-privs config)
(server-loop listener config))
@@
-63,15
+63,15
@@
" on " (seconds->string)))
(condition-case
(let* ((line (read-line in-port))
" on " (seconds->string)))
(condition-case
(let* ((line (read-line in-port))
- (selector (string-trim-both line)))
+ (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 ()
(condition-case
(begin
(with-output-to-port out-port
(lambda ()
- (serve-selector (if (= (string-length selector) 0)
- "/"
- selector)
- config)))
+ (serve-selector selector config)))
(print "... served selector '" selector "'. Closing connection."))
(o (exn)
(print-error-message o out-port)
(print "... served selector '" selector "'. Closing connection."))
(o (exn)
(print-error-message o out-port)
@@
-121,11
+121,11
@@
(selector (car selector-list))
(arguments (cdr selector-list)))
(if (string-contains selector "|")
(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))
(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))
(serve-script (car l) arguments config)))
((0) (serve-text-file selector config))
((h) (serve-url selector config))