spiffy file upload minimal example added by nic_o on Tue Mar 11 19:42:16 2025
(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 :(