trying to switch to using lisp but need to build it first

This commit is contained in:
Chris Cochrun 2024-03-26 14:30:37 -05:00
parent 09b9e8fb5b
commit ae37869c9f
8 changed files with 248 additions and 102 deletions

View file

@ -261,7 +261,7 @@ pub async fn camp_form(MultipartForm(form): MultipartForm<CampForm>) -> HttpResp
.unwrap(),
)
.to("Chris Cochrun <chris@tfcconnection.org>".parse().unwrap())
.to("Ethan Rose <ethan@tfcconnection.org>".parse().unwrap())
// .to("Ethan Rose <ethan@tfcconnection.org>".parse().unwrap())
.subject(email_subject)
.multipart(multi)
{

View file

@ -7,6 +7,7 @@
(require "spinneret")
(require "lass")
(require "cl-smtp")
(require "log4cl")
(defpackage tfcserver
(:use :cl :com.inuoe.jzon :spinneret :serapeum))
@ -297,6 +298,48 @@ with the image attached to us"
(:td (trim-whitespace
(cdr row)))))))))))))
(defun mail-camp-form (form attachment)
"Takes the form as an alist and sends a table formatted email
with the image attached"
(let* ((first-name (trim-whitespace
(cdr (assoc "firstname" form
:test 'string=))))
(last-name (trim-whitespace
(cdr (assoc "lastname" form
:test 'string=))))
(parent-name (concatenate 'string
(trim-whitespace
(cdr (assoc "parentfirstname" form
:test 'string=)))
" "
(trim-whitespace
(cdr (assoc "parentlastname" form
:test 'string=))))))
(not (cl-smtp:send-email
"mail.tfcconnection.org"
"no-reply@mail.tfcconnection.org"
'("chris@tfcconnection.org" "chris@cochrun.xyz")
(format nil "~a ~a filled out a Camp Form!" first-name last-name)
(format nil "Camp Form for ~a ~a" first-name last-name)
:display-name "TFC ADMIN"
:ssl :tls
:authentication '(:login "no-reply@mail.tfcconnection.org" "r9f36mNZFtiW4f")
:attachments attachment
:html-message
(with-html-string
(:doctype)
(:html
(:head (:title "TFC Health Form")
(:style (apply #'lass:compile-and-write *mail-css*)))
(:body
(:h1 (format nil "Camp Form for ~a ~a" first-name last-name))
(:hr)
(:table
(loop for row in form
do (:tr
(:th (car row))
(:td (cdr row))))))))))))
(defun mail-health-form (form attachment)
"Takes the form as an alist and sends a table formatted email
with the image attached"
@ -342,46 +385,47 @@ with the image attached"
(defun define-post-form-handler (uri mail-function)
"Take a uri and a mailer function and define a handler in hunchentoot
for forms to POST to."
(hunchentoot:define-easy-handler (respond :uri uri) ()
(setf (hunchentoot:content-type*) "plain/text")
(let* ((request-type (hunchentoot:request-method hunchentoot:*request*))
(post-data (hunchentoot:post-parameters* hunchentoot:*request*))
(attachment nil)
(first-name nil)
(last-name nil))
(cond ((eq request-type :get) nil)
((eq request-type :post)
(loop :for d :in post-data
:do (progn
(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))
(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)))))
(if (funcall mail-function post-data attachment)
(format nil "thankyou")))))))
(hunchentoot:define-easy-handler (respond :uri uri) ()
(setf (hunchentoot:content-type*) "plain/text")
(let* ((request-type (hunchentoot:request-method hunchentoot:*request*))
(post-data (hunchentoot:post-parameters* hunchentoot:*request*))
(attachment nil)
(first-name nil)
(last-name nil))
(cond ((eq request-type :get) nil)
((eq request-type :post)
(loop :for d :in post-data
:do (progn
(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))
(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)))))
(if (funcall mail-function post-data attachment)
(format nil "thankyou")))))))
(define-post-form-handler "/mt-form" 'mail-mt-form)
(define-post-form-handler "/health-form" 'mail-health-form)
(define-post-form-handler "/camp-form" 'mail-camp-form)
(defun main ()
(start-server 4242)