summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorThomas Hintz <t@thintz.com>2015-04-07 08:32:40 -0700
committerThomas Hintz <t@thintz.com>2015-04-07 08:32:40 -0700
commit1b2c971d479dc409abf3774f1165943a85ffa2bf (patch)
treeba96870fb0289cfb72616748f48d97ce3c273c56
parente87ffff5dd5a409c6a53195c269aa9ffe7ad71a4 (diff)
downloadsimple-1b2c971d479dc409abf3774f1165943a85ffa2bf.tar.gz
stage 1
-rw-r--r--simple.scm66
1 files changed, 61 insertions, 5 deletions
diff --git a/simple.scm b/simple.scm
index 704f07a..0627e98 100644
--- a/simple.scm
+++ b/simple.scm
@@ -6,7 +6,7 @@
debug-file page-access-control server-start write-chunk)
(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
http-session spiffy-cookies sxml-transforms)
@@ -211,6 +211,57 @@
(when (and (enable-session) (session-valid? (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)
(printf "~X" (string-length contents))
(display "\n")
@@ -231,10 +282,15 @@
(if ((page-access-control) (car args))
(begin
(maybe-create/refresh-session! use-session)
- (with-output-to-port (response-port (current-response))
- (lambda ()
- (apply contents (cdr args))
- (display "0\r\n\r\n")))
+ (let ((chunked-port (make-chunked-port (response-port (current-response)))))
+ (with-output-to-port chunked-port
+ (lambda ()
+ (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))
;; (handle-exceptions exn
;; (render-exception exn)