multipart-form-data example pasted by klm` on Wed Dec 21 01:16:58 2016

;; hi guys
;; I looked at the multipart-form-data egg
;; and had a couple of hickups getting started,
;; so I though I'd put together a slightly more 
;; sophisticated example:

(use spiffy intarweb uri-common multipart-form-data)

(create-directory "./uploads" #t)
(change-directory "./uploads")

(define (app c)

  ;; saves any MULTIPART files in form-data to disk. returns list of
  ;; filenames.
  (define (save-files form-data)
    (filter-map
     (lambda (pair)
       (let ((value (cdr pair))) ;; car is form-data key, can be ignored
         (and (multipart-file? value)
              (with-output-to-file (multipart-file-filename value)
                (lambda () (display (read-string #f (multipart-file-port value)))))
              (multipart-file-filename value))))
     form-data))

  (define form-data
    (and (eq? 'POST (request-method (current-request)))
         (read-multipart-form-data (current-request))))
  
  (define filenames (if form-data (save-files form-data) '()))

  (send-response body:
                 (conc "<html>
  <body>
    <form action=\"upload\"
          method=\"post\"
          enctype=\"multipart/form-data\">
Uploads go here: " (current-directory) "/upload <br />
You uploaded: <ul>
" (string-join (map (lambda (fn) (conc "<li>" fn "</li>\n")) filenames) "") " </ul>
      <input type=\"file\" name=\"images[]\" multiple=\"true\" />
      <input type=\"submit\" value=\"Send files\" />
    </form>
  </body>
</html>")))

(define thread
  (thread-start!
   (lambda ()
     (vhost-map `((".*" . ,(lambda (c) (app c)))))
     (root-path "./")
     (start-server))))

a slightly improved version added by klm` on Wed Dec 21 02:11:33 2016

;; upload.scm
;; run with csi -s upload.scm
;; and point your browser to http://localhost:8080
(use spiffy intarweb uri-common multipart-form-data)

(create-directory "./uploads" #t)
(change-directory "./uploads")

(define (app c)

  ;; saves any MULTIPART files in form-data to disk. returns list of
  ;; filenames.
  (define (save-files form-data)
    (filter-map
     (lambda (pair) ;; <-- pair is form-key . form-value
       (let ((value (cdr pair)))
         (and (multipart-file? value)
              (with-output-to-file (multipart-file-filename value)
                (lambda () (display (read-string #f (multipart-file-port value)))))
              (multipart-file-filename value))))
     form-data))

  (define form-data
    (and (eq? 'POST (request-method (current-request)))
         (read-multipart-form-data (current-request))))
  
  (define filenames (if form-data (save-files form-data) '()))

  (send-response body:
                 (conc "<html>
  <body>
    <form action=\"upload\"
          method=\"post\"
          enctype=\"multipart/form-data\">
Uploads go here: " (current-directory) "/upload <br />
      <input type=\"file\" name=\"images[]\" webkitdirectory directory multiple />
      <input type=\"submit\" value=\"Send files\" />

<p>You uploaded: <ul>
" (string-join (map (lambda (fn) (conc "<li>" fn "</li>\n")) filenames) "") " </ul></p>
    </form>
  </body>
</html>")))

(vhost-map `((".*" . ,(lambda (c) (app c)))))
(start-server)