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

create an abstraction for POST forms

Browse source
This commit is contained in:
Chris Cochrun 2024-01-11 14:57:07 -06:00
parent 31f05fc5be
commit 5cc601e577
1 changed files with 35 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

123
src/main.lisp
View file

@ -319,7 +319,6 @@ with the image attached"
(last-name (serapeum:trim-whitespace (last-name (serapeum:trim-whitespace
(cdr (assoc "lastname" form (cdr (assoc "lastname" form
:test 'string=)))) :test 'string=))))
(attachment (uiop:copy-file attachment (path-join hunchentoot:*tmp-directory* (format nil "~a_~a" "Frodo" "Braggins"))))
(parent-name (concatenate 'string (parent-name (concatenate 'string
(serapeum:trim-whitespace (serapeum:trim-whitespace
(cdr (assoc "parentfirstname" form (cdr (assoc "parentfirstname" form
@ -331,7 +330,7 @@ with the image attached"
(not (cl-smtp:send-email (not (cl-smtp:send-email
"mail.tfcconnection.org" "mail.tfcconnection.org"
"no-reply@mail.tfcconnection.org" "no-reply@mail.tfcconnection.org"
'("chris@tfcconnection.org") '("chris@tfcconnection.org" "chris@cochrun.xyz")
(format nil "~a ~a filled out a Health Form!" first-name last-name) (format nil "~a ~a filled out a Health Form!" first-name last-name)
(format nil "Health Form for ~a ~a" first-name last-name) (format nil "Health Form for ~a ~a" first-name last-name)
:display-name "TFC ADMIN" :display-name "TFC ADMIN"
@ -353,103 +352,49 @@ with the image attached"
(:th (car row)) (:th (car row))
(:td (cdr row)))))))))))) (:td (cdr row))))))))))))
(hunchentoot:define-easy-handler (respond :uri "/mt-form") () (defun define-post-form-handler (uri mail-function)
(setf (hunchentoot:content-type*) "plain/text") "Take a uri and a mailer function and define a handler in hunchentoot
(let* ((request-type (hunchentoot:request-method hunchentoot:*request*)) for forms to POST to."
(req hunchentoot:*request*) (hunchentoot:define-easy-handler (respond :uri uri) ()
(content-type (hunchentoot:header-in "content-type" req))
(boundary (let ((position (position #\= content-type)))
(when position
(subseq content-type (1+ position)))))
(string-data (flexi-streams:octets-to-string
(hunchentoot:raw-post-data :request req)))
(parts (ppcre:split boundary string-data))
(form-list nil)
(attachment nil))
(cond ((eq request-type :get) nil)
((eq request-type :post)
(loop :for i :in parts
:do (let* ((content-disposition
(nth 1
(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")
nil
;; (butlast
;; (rest
;; (rest
;; (rest
;; (rest
;; (serapeum:lines i
;; :eol-style
;; :crlf
;; :honor-crlf t
;; :keep-eols t))))))
(trim-whitespace
(car
(butlast
(rest
(rest
(rest
(serapeum:lines i :eol-style :crlf
:honor-crlf t
:keep-eols 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)))
(if name
(if (string= name "image")
(when (stringp content)
(progn
(if (not (uiop:file-exists-p image-file-name))
(save-string-file
(apply #'concatenate 'string content)
image-file-name))
(setf attachment image-file-name)
(delete-file image-file-name)))
(setq form-list (acons name content form-list))))))
(if (mail-mt-form form-list attachment)
(progn
(uiop:println "Mail sent")
(format nil "thankyou")))))))
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
(setf (hunchentoot:content-type*) "plain/text") (setf (hunchentoot:content-type*) "plain/text")
(let* ((request-type (hunchentoot:request-method hunchentoot:*request*)) (let* ((request-type (hunchentoot:request-method hunchentoot:*request*))
(post-data (hunchentoot:post-parameters* hunchentoot:*request*)) (post-data (hunchentoot:post-parameters* hunchentoot:*request*))
(attachment nil)) (attachment nil)
(first-name nil)
(last-name nil))
(cond ((eq request-type :get) nil) (cond ((eq request-type :get) nil)
((eq request-type :post) ((eq request-type :post)
(loop :for d :in post-data (loop :for d :in post-data
:do (progn :do (progn
(uiop:println d) (uiop:println d)
(if (string= "firstname" (car d))
(progn
(uiop:println (cdr d))
(setf first-name (cdr d))))
(if (string= "lastname" (car d))
(progn
(uiop:println (cdr d))
(setf last-name (cdr d))))
(if (string= "image" (car d)) (if (string= "image" (car d))
(progn (setf attachment (cadr d)) (let ((path (path-join
hunchentoot:*tmp-directory*
(format nil "~a_~a.~a" first-name last-name
(cadr (uiop:split-string
(car (last d 2)) :separator "."))))))
(uiop:copy-file
(cadr d)
(path-join
hunchentoot:*tmp-directory*
(format nil "~a_~a.~a" first-name last-name
(cadr (uiop:split-string
(car (last d 2)) :separator ".")))))
(setf attachment path)
(uiop:println attachment))))) (uiop:println attachment)))))
(if (mail-health-form post-data attachment) (if (funcall mail-function post-data attachment)
(format nil "thankyou")))))) (format nil "thankyou")))))))
(define-post-form-handler "/mt-form" 'mail-mt-form)
(define-post-form-handler "/health-form" 'mail-health-form)
(defun main () (defun main ()
(start-server 4242) (start-server 4242)