spiffy file upload minimal example

(import
  utf8
  srfi-1
  srfi-13
  srfi-130
  scheme
  (chicken format)
  (chicken base)
  (chicken file)
  (chicken file posix)
  (chicken time)
  (chicken process)
  (chicken io)
  (chicken port)
  srfi-4
  srfi-18
  srfi-41
  srfi-158
  spiffy
  intarweb
  multipart-form-data
  sxml-serializer
)

(define (route c root)
  (cond
   (
    ;; check if it's a POST request
    (equal? 'POST (request-method (current-request)))
    (display "-----------------------\n")
    (print (format "STARTING AT ~A" (current-seconds)))
    ;; if so, read the multipart form -> this takes forever
    (let ((i (read-multipart-form-data (current-request))))
      (let ((a (assoc '|files[]| i))
            )
        (display "NEW FILE")
        (newline)
        (display a)
        (newline)
        (if (and (equal? '|files[]| (car a)) (not (equal? '#!eof (cdr a))))
            (let* ((path-root root)
                   (fi (multipart-file-filename (cdr a)))
                   (p (multipart-file-port (cdr a)))
                   (path (string-append path-root fi))
                   (filename (irregex-replace "^.*/" fi ""))
                   )
              (print (format "BEGIN WRITING ~A" (current-seconds)))
              ;; open file descriptor
              (let ((p (multipart-file-port (cdr a)))
                    (f (file-open path (+ open/wronly open/creat open/binary))))
                (print (format "NOW WRITING ~A" (current-seconds)))
                ;; write file -> before I had the whole byteaccumulator in a while loop with read-byte, but this seems to work very much very fine, so read-buffered it is
                (file-write f (read-buffered p))
                (print (format "READ AND WROTE BUFFERED ~A" (current-seconds)))
                )))))
    (with-headers `((location "/"))
                  (lambda () (send-status 'found))))
   (else
    (send-response
     body:
     (string-append
      "<!DOCTYPE html>"
      (serialize-sxml
       `(html
         (body
          (form (@
                 (action "/")
                 (method "post")
                 (enctype "multipart/form-data"))
                (input (@ (type "file")
                          (name "files[]")
                          (id "files")
                          ))
                (input (@ (type "Submit")
                          (value "Upload file")
                          (name "upload")))
                )))
       allow-prefix-redeclarations: #f
       method: 'html
       ))))))

(define (start-server-thread root port)
  (thread-start!
   (lambda ()
     (vhost-map `((".*" . ,(lambda (c) (route c root)))))
     (root-path root)
     (start-server port: port)
     )))


(define sthread (start-server-thread "." 8082))

;; => stil takes ~60 seconds to upload a 134mb file on my laptop :(