Support for html file upload

clog.asd

@@ -11,7 +11,8 @@
   :pathname "source/"
   :depends-on (#:clack #:websocket-driver #:alexandria #:hunchentoot #:cl-ppcre
 	       #:bordeaux-threads #:trivial-open-browser #:parse-float #:quri
-	       #:sqlite #:lack-middleware-static #:mgl-pax #:cl-template)
+	       #:sqlite #:lack-middleware-static #:lack-request
+	       #:mgl-pax #:cl-template)
   :components ((:file "clog-connection")
 	       (:file "clog")
 	       (:file "clog-utilities")

source/clog-connection.lisp

@@ -40,6 +40,7 @@ script."
   (set-on-connect         function)
   (set-clog-path          function)
   (get-connection-data    function)
+  (delete-connection-data function)
 
   "CLOG system utilities"
   
@@ -114,6 +115,15 @@ script."
 hash test: #'equal."
   (gethash connection-id *connection-data*))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; delete-connection-data ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun delete-connection-data (connection-id)
+  "Delete CONNECTION-ID's data. (private)"
+  (bordeaux-threads:with-lock-held (*connection-lock*)
+    (remhash connection-id *connection-data*)))
+
 ;;;;;;;;;;;;;;;;
 ;; prep-query ;;
 ;;;;;;;;;;;;;;;;
@@ -311,7 +321,14 @@ instead of the compiled version."
 			  (let ((page-data (make-string (file-length stream)))
 				(post-data))
 			    (read-sequence page-data stream)
-			    ;; Check if post method response
+			    (when (search "multipart/form-data;"
+					  (getf env :content-type))
+			      (let ((id  (get-universal-time))
+				    (req (lack.request:make-request env)))
+				(bordeaux-threads:with-lock-held (*connection-lock*)
+				  (setf (gethash id *connection-data*)
+					(lack.request:request-body-parameters req)))
+				(setf post-data id)))
 			    (when (equal (getf env :content-type)
 					 "application/x-www-form-urlencoded")
 			      (setf post-data (make-string (getf env :content-length)))

source/clog-form.lisp

@@ -15,16 +15,33 @@
 (defgeneric form-get-data (clog-obj)
   (:documentation "Get the form data as an a-list sent by the get method"))
 
-(defmethod form-get-data (clog-obj)
+(defmethod form-get-data ((obj clog-obj))
   (quri:uri-query-params
-   (quri:uri (clog-connection:query (connection-id clog-obj) "location.href"))))
+   (quri:uri (clog-connection:query (connection-id obj) "location.href"))))
 
 (defgeneric form-post-data (clog-obj)
   (:documentation "Get the form data as an a-list sent by post method"))
 
-(defmethod form-post-data (clog-obj)
+(defmethod form-post-data ((obj clog-obj))
   (quri:url-decode-params
-   (clog-connection:query (connection-id clog-obj) "clog['post-data']")))
+   (clog-connection:query (connection-id obj) "clog['post-data']")))
+
+(defgeneric form-multipart-data (clog-obj)
+  (:documentation "Get the form data as an a-list sent with the multipart
+method used in file uploads. DELETE-MULTIPART-DATA must be called or will
+never be GC'd. File upload items will be a four part list
+(name stream file-name content-type)."))
+
+(defmethod form-multipart-data ((obj clog-obj))
+  (clog-connection:get-connection-data
+   (parse-integer (caar (form-post-data obj)) :junk-allowed t)))
+
+(defgeneric delete-multipart-data (clog-obj)
+  (:documentation "Delete the multipart data upload"))
+
+(defmethod delete-multipart-data ((obj clog-obj))
+  (let* ((id  (parse-integer (caar (form-post-data obj))))
+	(clog-connection:delete-connection-data id))))
 
 (defun form-data-item (form-data item)
   "Return value for ITEM from FROM-DATA a-list"

source/clog.lisp

@@ -517,6 +517,8 @@ embedded in a native template application.)"
   "CLOG-Form-Data"
   (form-get-data         generic-function)
   (form-post-data        generic-function)
+  (form-multipart-data   generic-function)
+  (delete-multipart-data generic-function)
   (form-data-item        function)
 
   "CLOG-Form - Class for organizing Form Elements in to a From"