scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

thttpd - web daemon software - fixes 4

This commit is contained in:
erana 2012-01-23 13:47:08 +09:00
parent d1d229859d
commit 445f12c48b
1 changed files with 26 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
scsh/thttpd/thttpdaemon.scm
View File

@ -50,7 +50,7 @@
(set! *socket (open-socket *port)) (set! *socket (open-socket *port))
(define (get-response lst) (define (get-response-f lst)
(define (get return) (define (get return)
(for-each (for-each
(lambda (element) (lambda (element)
@ -65,6 +65,9 @@
(call-with-current-continuation get)) (call-with-current-continuation get))
gen) gen)
(define (get-response l)
(get-response-f l))
(for-each display '("Opening listening socket on host : " (for-each display '("Opening listening socket on host : "
*hostname *hostname
" port : " " port : "
@ -75,23 +78,28 @@
(lambda () (lambda ()
(socket-accept *socket)) (socket-accept *socket))
(lambda (in out) (lambda (in out)
(let ((a (read in));;race cond. client requests (let* ((a (read in));;race cond. client requests
(b (read in)) (b (read in))
(c (read in))) (c (read in))
(abcl '(a b c)))
;;(let ((in (make-string-input-port in))) ;;(let ((in (make-string-input-port in)))
(for-each display '(servermsg (symbol->string a))) (for-each display '(servermsg (symbol->string a)))
(if (symbol? a) (if (symbol? a)
(get-response '(a b c)) (let ((response-word (get-response abcl)))
(cond ((eq? a 'GET) (cond ((eq? a 'GET)
(write "Hello World") ;; fall through with continuations
;;(display "200 OK" out) (let ((response-word-2nd (get-response abcl)))
(display aspect-content out) (if (symbol? response-word-2nd)
(display (string #\return #\newline) out) ;; CRLF (begin
(display "\"Hello World\"" out) (write "Hello World")
;;(close-input-port in) ;;(display "200 OK" out)
;;(close-socket *socket) (display aspect-content out)
;;(close-output-port out) (display (string #\return #\newline) out) ;; CRLF
) (display "\"Hello World\"" out)
(else ;; + keep-alive ))))
(write errormsg out)) ;;(close-input-port in)
))))))))) ;;(close-socket *socket)
;;(close-output-port out)
(else ;; + keep-alive
(write errormsg out))
))))))))))