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 (servermsg) (string "::thttpd-msg::"))
(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
(make-record-type 'thttpd-daemon-record
'(hostname port sock)))
@ -60,21 +60,20 @@
(lambda ()
(socket-accept *socket))
(lambda (in out)
;;(let ((in (make-string-input-port in)))
(let ((answer (read in)))
;;(let ((answer2 (read in)))
;;(let ((answer3 (read in)))
(for-each display '((servermsg) (symbol->string answer)))
(if (symbol? answer)
(cond ((eq? 'GET answer)
(write aspect-content out)
(write (string #\newline))
(write "Hello World" out)
;;(close-input-port in)
;;(close-socket *socket)
;;(close-output-port out)
)
(else ;; + keep-alive
(write (errormsg) out))
)))))))));;);;)
(let ((a (read in)))
;;(let ((in (make-string-input-port in)))
(for-each display '((servermsg) (symbol->string a)))
(if (symbol? a)
(cond ((eq? a 'GET)
(write "Hello World")
(write aspect-content out)
(write (string #\newline) out)
(write "Hello World" out)
;;(close-input-port in)
;;(close-socket *socket)
;;(close-output-port out)
)
(else ;; + keep-alive
(write (errormsg) out))
)))))))))