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

thttpd - web daemon software - fixes 6

This commit is contained in:
erana 2012-01-23 14:30:31 +09:00
parent e158b49c4e
commit 2937f43b3f
1 changed files with 24 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
scsh/thttpd/thttpdaemon.scm
View File

@ -26,10 +26,13 @@
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;,open ascii records sockets continuations
(define eoln (string #\newline)) (define eoln (string #\newline))
(define servermsg (string "::thttpd-msg::")) (define cr (string (ascii->char 13)))
(define errormsg (string "::thttpd-error::")) (define servermsg "::thttpd-msg::")
(define aspect-content (string-append "Content-Type: text/plain;charset=utf-8" (string #\return#\newline))) (define errormsg "::thttpd-error::")
(define aspect-content (string-append "Content-Type: text/plain;charset=utf-8" cr eoln))
(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)))
@ -41,6 +44,23 @@
(define thttpd-port (record-accessor :thttpd-daemon-record 'port)) (define thttpd-port (record-accessor :thttpd-daemon-record 'port))
(define thttpd-sock (record-accessor :thttpd-daemon-record 'sock)) (define thttpd-sock (record-accessor :thttpd-daemon-record 'sock))
(define (get-response-f lst)
(define (get return)
(for-each
(lambda (element)
(set! return (call-with-current-continutation
(lambda (r)
(set! get r)
(return element)))))
lst)
(return 'end-generate))
(define (gen)
(call-with-current-continuation get))
gen)
(define (get-response l)
(get-response-f l))
(define (run-daemon-child-http rec) (define (run-daemon-child-http rec)
(let ((*hostname (thttpd-hostname rec)) (let ((*hostname (thttpd-hostname rec))
@ -50,24 +70,6 @@
(set! *socket (open-socket *port)) (set! *socket (open-socket *port))
(define (get-response-f lst)
(define (get return)
(for-each
(lambda (element)
(set! return (call-with-current-continutation
(lambda (r)
(set! get r)
(return element)))))
lst)
(return 'end-generate))
(define (gen)
(call-with-current-continuation get))
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 : "
@ -94,7 +96,7 @@
;;(display "200 OK" out) ;;(display "200 OK" out)
(display aspect-content out) (display aspect-content out)
;; FIXME #\return (make-char X) ;; FIXME #\return (make-char X)
(display (string #\return #\newline) out) ;; CRLF (display (string-append cr eoln) out) ;; CRLF
(display "\"Hello World\"" out) (display "\"Hello World\"" out)
)))) ))))
;;(close-input-port in) ;;(close-input-port in)