gzip
Thomas Hintz 10 years ago
parent e87ffff5dd
commit 1b2c971d47

@ -6,7 +6,7 @@
debug-file page-access-control server-start write-chunk) debug-file page-access-control server-start write-chunk)
(import scheme chicken data-structures utils extras ports srfi-69 files srfi-1) (import scheme chicken data-structures utils extras ports srfi-69 files srfi-1)
(use posix srfi-13 tcp) (use posix srfi-13 tcp ports)
(use intarweb spiffy spiffy-request-vars uri-common (use intarweb spiffy spiffy-request-vars uri-common
http-session spiffy-cookies sxml-transforms) http-session spiffy-cookies sxml-transforms)
@ -211,6 +211,57 @@
(when (and (enable-session) (session-valid? (sid))) (when (and (enable-session) (session-valid? (sid)))
(session-refresh! (sid)))) (session-refresh! (sid))))
(use z3)
(define z (z3:encode-init))
(define b "")
(z3:encode z (lambda (s) (display s)) (with-input-from-file "news.scm"
(lambda () (substring (read-string) 640))))
(z3:encode z (lambda (s) (set! b s)) "hi, how are you?")
(z3:encode-buffer "hi, how are you?")
(get-output-string dest)
(z3:decode-buffer "ËÈÔQÈÈ/WH,JU¨Ì/µ\a\x00")
(z3:decode-buffer (z3:encode-buffer "hi, how are you?"))
(define (make-chunked-port output-port #!key (buffer-size 4094))
(let ((buffer (make-string buffer-size))
(output (make-string buffer-size))
(z3-handle (z3:init buffer: buffer buffer-size: buffer-size))
(pos 0))
(define (flush)
(fprintf output-port "~X" pos)
(display "\n" output-port)
(if (fx= pos buffer-size)
(display buffer output-port)
(display (substring buffer 0 pos) output-port))
(display "\n" output-port)
(flush-output output-port))
(make-output-port
(lambda (s)
(let ((len (##core#inline "C_block_size" s)))
(let loop ((s-pos 0))
(if (fx>= (fx+ len pos) buffer-size)
(begin (##core#inline "C_substring_copy" s buffer s-pos
(fx+ (fx- buffer-size pos) s-pos) pos)
(let ((len-written (z3:encode z3-handle
(lambda (s)
(set! output
(string-append output s))) s)))
)
(set! len (fx- len (fx- buffer-size pos)))
(set! s-pos (fx+ s-pos (fx- buffer-size pos)))
(set! pos buffer-size)
(flush)
(set! pos 0)
(loop s-pos))
(begin (##core#inline "C_substring_copy" s buffer s-pos (fx+ len s-pos) pos)
(set! pos (fx+ pos len)))))))
(lambda ()
(flush)
(display "0\r\n\r\n" output-port)
(flush-output output-port))
flush)))
(define (write-chunk contents) (define (write-chunk contents)
(printf "~X" (string-length contents)) (printf "~X" (string-length contents))
(display "\n") (display "\n")
@ -231,10 +282,15 @@
(if ((page-access-control) (car args)) (if ((page-access-control) (car args))
(begin (begin
(maybe-create/refresh-session! use-session) (maybe-create/refresh-session! use-session)
(with-output-to-port (response-port (current-response)) (let ((chunked-port (make-chunked-port (response-port (current-response)))))
(lambda () (with-output-to-port chunked-port
(apply contents (cdr args)) (lambda ()
(display "0\r\n\r\n"))) (apply contents (cdr args))))
(close-output-port chunked-port))
;; (with-output-to-port (response-port (current-response))
;; (lambda ()
;; (apply contents (cdr args))
;; (display "0\r\n\r\n")))
(finish-response-body (current-response)) (finish-response-body (current-response))
;; (handle-exceptions exn ;; (handle-exceptions exn
;; (render-exception exn) ;; (render-exception exn)

Loading…
Cancel
Save