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

thttpd - web daemon software - fixes 1

This commit is contained in:
erana 2012-01-23 03:10:30 +09:00
parent 060156b78f
commit 6005f64915
1 changed files with 17 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
scsh/thttpd/thttpdaemon.scm
View File

@ -29,7 +29,7 @@
(define (eoln) (string #\newline)) (define (eoln) (string #\newline))
(define (servermsg) (string "::thttpd-msg::")) (define (servermsg) (string "::thttpd-msg::"))
(define (errormsg) (string "::thttpd-error::")) (define (errormsg) (string "::thttpd-error::"))
(define aspect-content "Content-Type: text/plain;charset=utf-8");; (string #\newline))) (define aspect-content (string-append "Content-Type: text/plain;charset=utf-8" (string #\newline)))
(define :thttpd-daemon-record (define :thttpd-daemon-record
(make-record-type 'thttpd-daemon-record (make-record-type 'thttpd-daemon-record
'(hostname port sock))) '(hostname port sock)))
@ -60,21 +60,20 @@
(lambda () (lambda ()
(socket-accept *socket)) (socket-accept *socket))
(lambda (in out) (lambda (in out)
;;(let ((in (make-string-input-port in))) (let ((a (read in)))
(let ((answer (read in))) ;;(let ((in (make-string-input-port in)))
;;(let ((answer2 (read in))) (for-each display '((servermsg) (symbol->string a)))
;;(let ((answer3 (read in))) (if (symbol? a)
(for-each display '((servermsg) (symbol->string answer))) (cond ((eq? a 'GET)
(if (symbol? answer) (write "Hello World")
(cond ((eq? 'GET answer) (write aspect-content out)
(write aspect-content out) (write (string #\newline) out)
(write (string #\newline)) (write "Hello World" out)
(write "Hello World" out) ;;(close-input-port in)
;;(close-input-port in) ;;(close-socket *socket)
;;(close-socket *socket) ;;(close-output-port out)
;;(close-output-port out) )
) (else ;; + keep-alive
(else ;; + keep-alive (write (errormsg) out))
(write (errormsg) out)) )))))))))
)))))))));;);;)