TFC/tfcconnection
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

finally able to save the picture

Browse source
This commit is contained in:
Chris Cochrun 2023-05-30 15:26:57 -05:00
parent 0cad38bb05
commit d857692815
2 changed files with 49 additions and 134 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
layouts/shortcodes/health-form.html
View file

@ -63,12 +63,14 @@
/* data.delete("image"); */ /* data.delete("image"); */
validate(data); validate(data);
let obj = {};
data.forEach((value, key) => obj[key] = value);
/* console.log(JSON.stringify(data)); */ /* console.log(JSON.stringify(data)); */
fetch("http://localhost:4242/health-form", { fetch("http://localhost:4242/health-form", {
method: "POST", method: "POST",
/* headers: { /* headers: {
* "Content-Type": "multipart/form-data", * "Content-Type": "application/json",
* }, */ * }, */
body: data body: data
}).then((res) => { }).then((res) => {

179
src/server/main.lisp
View file

@ -6,24 +6,20 @@
(in-package :tfc-server) (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) (setf hunchentoot:*default-connection-timeout* 240)
;; '(200 nil ("Hello, World!")))
;; (clack.handler:stop *clack-server*)
;; (defparameter *clack-server* (clack:clackup (lambda (env) (defvar *server* (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242)))
;; (funcall 'handler env))))
(hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))
(hunchentoot:define-easy-handler (say-yo :uri "/yo") (name) (hunchentoot:define-easy-handler (say-yo :uri "/yo") (name)
(setf (hunchentoot:content-type*) "text/plain") (setf (hunchentoot:content-type*) "text/plain")
(format nil "Hey~@[ ~A~]!" name)) (format nil "Hey~@[ ~A~]!" name))
(setf hunchentoot:*default-connection-timeout* 160)
(hunchentoot:define-easy-handler (respond :uri "/health-form") () (hunchentoot:define-easy-handler (respond :uri "/health-form") ()
(setf (hunchentoot:content-type*) "application/json") (setf (hunchentoot:content-type*) "application/json")
(let ((request-type (hunchentoot:request-method hunchentoot:*request*))) (let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
@ -34,158 +30,75 @@
(setq *stream* (hunchentoot::content-stream hunchentoot:*request*)) (setq *stream* (hunchentoot::content-stream hunchentoot:*request*))
(let* ((stream (hunchentoot::content-stream hunchentoot:*request*)) (let* ((stream (hunchentoot::content-stream hunchentoot:*request*))
(data (hunchentoot::get-post-data :request *last*)) (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))) (boundary (let ((position (position #\= content-type)))
(when position (when position
(subseq content-type (1+ position))))) (subseq content-type (1+ position)))))
(string-data (flexi-streams:octets-to-string data)) (string-data (flexi-streams:octets-to-string data))
(parts (ppcre:split boundary 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)
;; )))
)
;; (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) (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* (loop :for i :in *last-data*
:do (let* ((content-disposition (nth 1 :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))) (start (if content-disposition (position #\" content-disposition)))
(end (if start (position #\" content-disposition :start (1+ start)) nil)) (end (if start (position #\" content-disposition :start (1+ start)) nil))
(name (if end (if start (subseq content-disposition (1+ start) end) nil) nil)) (name (if end (if start (subseq content-disposition (1+ start) end) nil) nil))
(content (if (string= name "image") (content (if (string= name "image")
(rest (rest (rest (rest
(serapeum:lines i :eol-style :cr :honor-crlf t)))) (rest
(nth 3 (serapeum:lines i :eol-style :cr :honor-crlf t)))) (rest
(image-content-type (if (string= name "image") (nth 2 (serapeum:lines i :eol-style :cr :honor-crlf t)))) (rest
(file-start (if (string= name "image") (position #\" content-disposition :start 44))) (serapeum:lines i :eol-style :crlf
(file-end (if file-start (position #\" content-disposition :start (1+ file-start)) nil)) :honor-crlf t :keep-eols t)))))
(image-file-name (if (string= name "image") (subseq content-disposition (1+ file-start) file-end) nil)) (nth 3 (serapeum:lines i :eol-style :crlf
(image-stream (if (string= name "image") (open image-file-name :honor-crlf t))))
:direction :output (file-start (if (string= name "image")
:if-does-not-exist :create (position #\" content-disposition :start 44)))
:if-exists :overwrite)))) (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 ;; 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))) (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= "image" name)
(if (string= name "image") (progn (format t "~&~A: ~A" name image-file-name)
(with-open-file (image-stream (pathname (truename image-file-name)) (setq form-list (list name image-file-name))
:direction :output (save-string-file
:element-type '(unsigned-byte 8) (apply #'concatenate 'string content) image-file-name)))
: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= name "image") (setq file-path (serapeum:write-stream-into-file (setq *last-list-data* (append *last-list-data* form-list)))))))))
;; *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)
)))))
(defun display-stream (stream) (defun display-stream (stream)
(loop for line = (read-line stream nil) (loop for line = (read-line stream nil)
while line do (format t "~A~%" line))) 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) (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) (defun process-form (form)
"Processes the form and sends it on" "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 "---") (uiop:println "---")
(maphash 'print-hash-entry form) (maphash 'print-hash-entry form)
(uiop:println "---"))) (uiop:println "---"))
(defun render-json (object) (defun render-json (object)
(uiop:println (format nil "Json: ~A" (com.inuoe.jzon:stringify 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))