Removing chunked encoding and switching to content-length.

simple.scm

@@ -3,7 +3,7 @@
      add-request-handler-hook! remove-request-handler-hook!
      define-page redirect-to enable-session-cookie session-cookie-setter
      session-cookie-name $session $session-set! $ page-access-denied-message
-     debug-file page-access-control server-start write-chunk $session-destroy!)
+     debug-file page-access-control server-start $session-destroy!)
 
 (import scheme chicken data-structures utils extras ports srfi-69 files srfi-1)
 (use posix srfi-13 tcp ports)
@@ -133,26 +133,7 @@
   (reset-per-request-parameters)
   (let ((handler
          (lambda (path proc)
-           (with-headers
+           (proc))))
-            (or (server-response-headers)
-                `((content-type text/html) (transfer-encoding chunked)))
-            (lambda ()
-              (write-logged-response)
-              (proc)
-              (unless (eq? 'HEAD (request-method (current-request)))
-                (if (%error)
-                    (send-response code: 500
-                                   reason: "Internal server error"
-                                   body: ((sxml->html) ((page-exception-message)
-                                                        (%error)))
-                                   headers: '((content-type text/html)))
-                    (if (%redirect) ;; redirection
-                        (let ((new-uri (if (string? (%redirect))
-                                           (uri-reference (%redirect))
-                                           (%redirect))))
-                          (with-headers `((location ,new-uri))
-                                        (lambda ()
-                                          (send-status 302 "Found"))))))))))))
     (call/cc (lambda (continue)
                (for-each (lambda (hook)
                            ((cdr hook) path
@@ -215,46 +196,6 @@
   (when (and (enable-session) (session-valid? (sid)))
     (session-refresh! (sid))))
 
-(define (make-chunked-port output-port #!key (buffer-size 4094))
-  (let ((buffer (make-string 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)
-      (set! pos 0))
-    (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)
-                      (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")
-  (display contents)
-  (display "\n")
-  (flush-output (response-port (current-response))))
-
 (define (define-page path contents #!key css title doctype headers charset
           (method 'GET) use-session) ;; for define-session-page
   (##sys#check-closure contents 'define-page)
@@ -267,26 +208,14 @@
      (if (use-session? use-session)
          (if ((page-access-control) (car args))
              (begin
+               ;; TODO is this a duplicate of the above?
                (maybe-create/refresh-session! use-session)
-               (let ((chunked-port (make-chunked-port (response-port (current-response)))))
+               (send-response
-                 (with-output-to-port chunked-port
+                body:
-                   (lambda ()
+                (with-output-to-string
-                     (apply contents (cdr args))))
+                  (lambda ()
-                 (close-output-port chunked-port))
+                    (apply contents (cdr args))))))
-               ;; (with-output-to-port (response-port (current-response))
+             ((page-access-denied-message) path))))
-               ;;   (lambda ()
-               ;;     (apply contents (cdr args))
-               ;;     (display "0\r\n\r\n")))
-               (finish-response-body (current-response))
-               ;; (handle-exceptions exn
-               ;;   (render-exception exn)
-               ;;   ;; TODO render-page
-               ;;   )
-               )
-             ((page-access-denied-message) path)))
-     ;; TODO what is this? (redirect-to-login-page
-     ;;                    (or given-path path)
-     )
    method))
 
 (define (server-start)