;; these two urls show how to transfer a user-selected file from
;; the client browser to the server.
;; 
;; We use two urls (/getfile to put up the form and /getfile-post to
;; handle the post action of the form).   We could have done it all
;; with one url but since there's a lot of code it helps in the
;; presentation to separate the two.
;;
(publish :path "/getfile-old"
	 :content-type "text/html; charset=utf-8"
	 :function #'(lambda (req ent) (getfile-function 
					req ent "/getfile-got-old")))

(publish :path "/getfile"
	 :content-type "text/html; charset=utf-8"
	 :function #'(lambda (req ent) (getfile-function 
					req ent "/getfile-got")))


(defun getfile-function (req ent posturl)
  (with-http-response (req ent)
    (with-http-body (req ent)
      (html (:head "get file")
	    (:body
	     ((:form :enctype "multipart/form-data"
		     :method "post"
		     :action posturl)
	      "Let me know what file to grab"
	      :br
	      ((:input :type "file" 
		       :name "thefile"
		       :value "*.txt"))
	      :br
	      ((:input :type "text" :name "textthing"))
	      "Enter some text"
	      :br
	      ((:input :type "checkbox" :name "checkone"))
	      "check box one"
	      :br
	      ((:input :type "checkbox" :name "checktwo"))
	      "check box two"
	      :br
	      ((:input :type "submit"))))))))

;;
;; this demonstrates the use of the low level multipart access functions.
;; In this code we parse the result of get-multipart-header ourselves
;; and we use get-multipart-sequence.
;; In the example that follows (associate with path "/getfile-got")
;; we show now to use the higher level functions to retrive multipart
;; data
(publish :path "/getfile-got-old"
	 :content-type "text/html; charset=utf-8"
	 :function
	 #'(lambda (req ent)
	     
	     (with-http-response (req ent)
	       (let ((h nil)
		     (files-written)
		     (text-strings)
		     )
		 (loop
		   ; get headers for the next item
		   (if* (null (setq h (get-multipart-header req)))
		      then ; no more items
			   (return))
		   ; we can get the filename from the header if 
		   ; it was an <input type="file"> item.  If there is
		   ; no filename, we just create one.
		   (pprint h)
		   (pprint (multiple-value-list (parse-multipart-header h)))
		   (let ((cd (assoc :content-disposition h :test #'eq))
			 (filename)
			 (sep))
		     (if* (and cd (consp (cadr cd)))
			then (setq filename (cdr (assoc "filename" 
							(cddr (cadr cd))
							:test #'equalp)))
			     (if* filename
				then ;; locate the part of the filename
				     ;; after the last directory separator.
				     ;; the common lisp pathname functions are
				     ;; no help since the filename syntax
				     ;; may be foreign to the OS on which
				     ;; the server is running.
				     (setq sep
				       (max (or (position #\/ filename
							  :from-end t) -1)
					    (or (position #\\ filename
							  :from-end t) -1)))
				     (setq filename
				       (subseq filename (1+ sep) 
					       (length filename)))))
		     (if* (and filename (not (equal filename "")))
			then (push filename files-written)
			     (with-open-file (pp filename :direction :output
					      :if-exists :supersede
					      :element-type '(unsigned-byte 8))
			       (format t "writing file ~s~%" filename)
			       (let ((buffer (make-array 4096
							 :element-type 
							 '(unsigned-byte 8))))
			 
				 (loop (let ((count (get-multipart-sequence 
						     req 
						     buffer)))
					 (if* (null count) then (return))
					 (write-sequence buffer pp :end count)))))
		      elseif (null filename)
			then  ; no filename, just grab as a text
			     ; string
			     (let ((buffer (make-string 1024)))
			       (loop
				 (let ((count (get-multipart-sequence
					       req buffer
					       :external-format :utf8-base)))
				   (if* count
				      then (push (subseq buffer 0 count)
						 text-strings)
				      else (return))))))))
		 
	       
	       
		 ;; now send back a response for the browser
	       
		 (with-http-body (req ent
				      :external-format :utf8-base)
		   (html (:html (:head (:title "form example"))
				(:body "-- processed the form, files written --"
				       (dolist (file (nreverse files-written))
					 (html :br "file: "
					       (:b (:prin1-safe file))))
				       :br
				       "-- Non-file items Returned: -- " :br
				       (dolist (ts (reverse text-strings))
					 (html (:princ-safe ts) :br))))))))))


;;
;; this retrieves data from a multipart form using the high level
;; functions.  You can compare this code to that above to see which
;; method you prefer
;; 
(publish :path "/getfile-got"
	 :content-type "text/html; charset=utf-8"
	 :function
	 #'(lambda (req ent)
	     (with-http-response (req ent)
	       (let ((files-written)
		     (text-strings)
		     (overlimit)
		     )
		 (loop
		   (multiple-value-bind (kind name filename content-type)
		       (parse-multipart-header
			(get-multipart-header req))
		     
		     (case kind
		       (:eof (return)) ; no more to read
		       (:data
			(push (cons name (get-all-multipart-data req))
			      text-strings))
		       (:file
			(let ((contents (get-all-multipart-data 
					 req 
					 :type :binary
					 :limit 1000000 ; abitrary limit
					 )))
			  ; find the tail of the filename, can't use
			  ; lisp pathname code since the filename syntax
			  ; may not correspond to this lisp's native os
			  (let ((sep (max (or (position #\/ filename
							:from-end t) -1)
					  (or (position #\\ filename
							:from-end t) -1))))
			    (if* sep
			       then (setq filename 
				      (subseq filename (1+ sep)))))
			  (if* (eq contents :limit)
			     then ; tried to give us too much
				  (setq overlimit t)
			   elseif (equal filename "") ; no file given
			     thenret ; ignore
			     else
				  (with-open-file (p filename 
						   :direction :output
						   :if-exists :supersede
						   :element-type '(unsigned-byte 8))
				    (format 
				     t "writing file ~s, content-type ~s~%"
				     filename content-type)
				    (push filename files-written)
				    (write-sequence contents p)))))
		       (t ; all else ignore but read to next header
			(get-all-multipart-data req :limit 1000)))))
			  

	       
	       
		 ;; now send back a response for the browser
	       
		 (with-http-body (req ent
				      :external-format :utf8-base)
		   (html (:html (:head (:title "form example"))
				(:body "-- processed the form, files written --"
				       (dolist (file (nreverse files-written))
					 (html :br "file: "
					       (:b (:prin1-safe file))))
				       (if* overlimit
					  then (html :br
						     "File given was over our "
						     "limit in the size we "
						     "will accept"))
				       :br
				       "-- Non-file items Returned: -- " :br
				       (dolist (ts (reverse text-strings))
					 (html 
					  "item name: " (:princ-safe (car ts))
					  ", item value: " 
					  (:princ-safe (cdr ts)) 
					  :br))))))))))