From d85769281549211cdd34539dcf0eb5ed02f86389 Mon Sep 17 00:00:00 2001
From: Chris Cochrun <chris@cochrun.xyz>
Date: Tue, 30 May 2023 15:26:57 -0500
Subject: [PATCH] finally able to save the picture
---
layouts/shortcodes/health-form.html | 4 +-
src/server/main.lisp | 179 +++++++---------------------
2 files changed, 49 insertions(+), 134 deletions(-)
diff --git a/layouts/shortcodes/health-form.html b/layouts/shortcodes/health-form.html
index 3758937..3799986 100644
--- a/layouts/shortcodes/health-form.html
+++ b/layouts/shortcodes/health-form.html
@@ -63,12 +63,14 @@
/* data.delete("image"); */
validate(data);
+ let obj = {};
+ data.forEach((value, key) => obj[key] = value);
/* console.log(JSON.stringify(data)); */
fetch("http://localhost:4242/health-form", {
method: "POST",
/* headers: {
- * "Content-Type": "multipart/form-data",
+ * "Content-Type": "application/json",
* }, */
body: data
}).then((res) => {
diff --git a/src/server/main.lisp b/src/server/main.lisp
index 9cd04c6..a115efd 100644
--- a/src/server/main.lisp
+++ b/src/server/main.lisp
@@ -6,24 +6,20 @@
(in-package :tfc-server)
-;; (defun handler (env) '(200 nil ("Hello World, bleh!")))
+(defvar *last*)
+(defvar *last-data*)
+(defvar *last-list-data*)
+(defvar *stream*)
+(defvar *token* "boFFRM68vvXbO-DO7S9YDg86lHX027-hd07mn0dh")
-;; (clack:stop (clack:clackup (lambda (env)
-;; '(200 nil ("Hello, World!")))
-;; (clack.handler:stop *clack-server*)
+(setf hunchentoot:*default-connection-timeout* 240)
-;; (defparameter *clack-server* (clack:clackup (lambda (env)
-;; (funcall 'handler env))))
-
-
-(hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))
+(defvar *server* (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242)))
(hunchentoot:define-easy-handler (say-yo :uri "/yo") (name)
(setf (hunchentoot:content-type*) "text/plain")
(format nil "Hey~@[ ~A~]!" name))
-(setf hunchentoot:*default-connection-timeout* 160)
-
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
(setf (hunchentoot:content-type*) "application/json")
(let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
@@ -34,158 +30,75 @@
(setq *stream* (hunchentoot::content-stream hunchentoot:*request*))
(let* ((stream (hunchentoot::content-stream hunchentoot:*request*))
(data (hunchentoot::get-post-data :request *last*))
- (content-type (hunchentoot:header-in "content-type" *last*))
+ (content-type (hunchentoot:header-in "content-type" hunchentoot:*request*))
(boundary (let ((position (position #\= content-type)))
(when position
(subseq content-type (1+ position)))))
(string-data (flexi-streams:octets-to-string data))
- (parts (ppcre:split boundary string-data))
- ;; (multipart-parser (fast-http:make-multipart-parser content-type
- ;; (lambda (field-name field-headers field-metadata field-body-bytes)
- ;; (uiop:println field-name)
- ;; (uiop:println field-headers)
- ;; (uiop:println field-metadata)
- ;; (uiop:println field-body-bytes)
- ;; )))
- )
+ (parts (ppcre:split boundary string-data)))
- ;; (uiop:println (fast-http:http-multipart-parse multipart-parser (lambda (field-name field-headers field-metadata field-body-bytes)
- ;; (uiop:println field-name)
- ;; (uiop:println field-headers)
- ;; (uiop:println field-metadata)
- ;; (uiop:println field-body-bytes)
- ;; ) string-data))
- ;; (println multipart-parser)
- (println content-type)
- (println boundary)
- ;; (println string-data)
(setq *last-data* parts)
- (uiop:println (hunchentoot::parse-multipart-form-data *last* *utf-8-external-format*))
-
+ (setq *last-list-data* nil)
(loop :for i :in *last-data*
:do (let* ((content-disposition (nth 1
- (serapeum:lines i :eol-style :cr :honor-crlf t)))
+ (serapeum:lines i :eol-style :crlf :honor-crlf t)))
(start (if content-disposition (position #\" content-disposition)))
(end (if start (position #\" content-disposition :start (1+ start)) nil))
(name (if end (if start (subseq content-disposition (1+ start) end) nil) nil))
(content (if (string= name "image")
- (rest (rest (rest
- (serapeum:lines i :eol-style :cr :honor-crlf t))))
- (nth 3 (serapeum:lines i :eol-style :cr :honor-crlf t))))
- (image-content-type (if (string= name "image") (nth 2 (serapeum:lines i :eol-style :cr :honor-crlf t))))
- (file-start (if (string= name "image") (position #\" content-disposition :start 44)))
- (file-end (if file-start (position #\" content-disposition :start (1+ file-start)) nil))
- (image-file-name (if (string= name "image") (subseq content-disposition (1+ file-start) file-end) nil))
- (image-stream (if (string= name "image") (open image-file-name
- :direction :output
- :if-does-not-exist :create
- :if-exists :overwrite))))
+ (rest
+ (rest
+ (rest
+ (rest
+ (serapeum:lines i :eol-style :crlf
+ :honor-crlf t :keep-eols t)))))
+ (nth 3 (serapeum:lines i :eol-style :crlf
+ :honor-crlf t))))
+ (file-start (if (string= name "image")
+ (position #\" content-disposition :start 44)))
+ (file-end (if file-start
+ (position #\" content-disposition :start (1+ file-start)) nil))
+ (image-file-name (if (string= name "image")
+ (subseq content-disposition
+ (1+ file-start) file-end) nil))
+ (form-list '()))
+
;; This gets rid of beginning and ending NIL values
- ;; (if name (if (string/= name "image") (format t "~&~A: ~A" name content)) nil)
-
+ (if name (if (string/= name "image") (progn
+ (format t "~&~A: ~A" name content)
+ (setq form-list (destructuring-bind (name) (list content) (list :name content))))) nil)
(if (string= name "image") (setq content (butlast content)))
- ;; (uiop:println image-content-type)
- ;; (uiop:println content)
- ;; (uiop:println (string= "" image-file-name))
- (if (string/= "" image-file-name)
- (if (string= name "image")
- (with-open-file (image-stream (pathname (truename image-file-name))
- :direction :output
- :element-type '(unsigned-byte 8)
- :if-exists :overwrite
- :if-does-not-exist :create)
- (write-sequence (flex:string-to-octets (write-to-string content)) image-stream))))
- ;; (if (string= name "image") (format t "~A" (pathname (truename image-file-name))))
+ (if (string= "image" name)
+ (progn (format t "~&~A: ~A" name image-file-name)
+ (setq form-list (list name image-file-name))
+ (save-string-file
+ (apply #'concatenate 'string content) image-file-name)))
- ;; (if (string= name "image") (setq file-path (serapeum:write-stream-into-file
- ;; *image-stream*
- ;; (pathname (truename image-file-name))
- ;; :if-exists :overwrite
- ;; :if-does-not-exist :create)))
- ;; (if (string= name "image") (format t "~&~A:~A" name content))
- ))
-
-
-
- ;; This actually worked, but the ending is wrong
- ;; (loop :for i :in *last-data*
- ;; :do (let* ((content (nth 1
- ;; (serapeum:lines i :eol-style :cr :honor-crlf t)))
- ;; (start (position #\" content))
- ;; (end (position #\" content :from-end t))
- ;; (name (if start (subseq content (1+ start) end) nil)))
- ;; (uiop:println name)))
-
-
-
-
-
-
- ;; (uiop:println "OTHER")
- ;; (uiop:println (hunchentoot::get-request-data stream))
- ;; (uiop:println (rfc2388:parse-mime data boundary))
- ;; (let* ((data (hunchentoot:raw-post-data :force-text t))
- ;; (json-obj (com.inuoe.jzon:parse data))
- ;; )
- ;; ;; (print (format nil "Json: ~A" (com.inuoe.jzon:stringify json-obj)))
- ;; (uiop:println "Received Health Form")
- ;; (render-json json-obj)
- ;; (setq last json-obj)
- ;; (process-form json-obj)
- ;; data)
- )))))
+ (setq *last-list-data* (append *last-list-data* form-list)))))))))
(defun display-stream (stream)
(loop for line = (read-line stream nil)
while line do (format t "~A~%" line)))
-(defvar *last*)
-(defvar *last-data*)
-(defvar *stream*)
-(defvar *token* "boFFRM68vvXbO-DO7S9YDg86lHX027-hd07mn0dh")
-
(defun print-hash-entry (key value)
- (format t "~S: ~S~%" key value))
+ (format t "~S: ~S~%" key (if (hash-table-p value) (maphash 'print-hash-entry value) value)))
(defun process-form (form)
"Processes the form and sends it on"
- (let ((firstname (gethash "firstname" form))
- (lastname (gethash "lastname" form))
- (parentfirstname (gethash "parentfirstname" form))
- (parentlastname (gethash "parentlastname" form))
- (street (gethash "street" form))
- (city (gethash "city" form))
- (state (gethash "state" form))
- (zip (gethash "zip" form))
- (cellphone (gethash "cellphone" form))
- (homephone (gethash "homephone" form))
- (add-emergency-contact (gethash "add-emergency-contact" form))
- (add-emergency-contact-phone (gethash "add-emergency-contact-phone" form))
- (doctorname (gethash "doctorname" form))
- (doctorcity (gethash "doctorcity" form))
- (doctorphone (gethash "doctorphone" form))
- (medical-coverage (gethash "medical-coverage" form))
- (insurance-name (gethash "insurance-name" form))
- (policy-number (gethash "policy-number" form))
- (image (gethash "image" form))
- (agreement (gethash "agreement" form))
- (allergies (gethash "allergies" form))
- (allergies-other (gethash "allergies-other" form))
- (specific-allergies (gethash "specific-allergies" form))
- (allergic-treatment (gethash "allergic-treatment" form))
- (conditions (gethash "conditions" form))
- (tetanus-shot (gethash "tetanus-shot" form))
- (swimming-ability (gethash "swimming-ability" form))
- (medication-schedule (gethash "medication-schedule" form))
- (other-notes (gethash "other-notes" form))
- (age (gethash "age" form)))
(uiop:println "---")
(maphash 'print-hash-entry form)
- (uiop:println "---")))
+ (uiop:println "---"))
(defun render-json (object)
(uiop:println (format nil "Json: ~A" (com.inuoe.jzon:stringify object))))
+(defun save-string-file (string file-path)
+ "save a file that is represented as a string to disk that came from a multipart/form-data"
+ (serapeum/bundle:write-string-into-file string file-path
+ :if-exists :overwrite
+ :if-does-not-exist :create
+ :external-format :latin-1))
+