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

some cleanup of how the lisp server works

Browse source
This commit is contained in:
Chris Cochrun 2024-04-25 09:53:36 -05:00
parent d653ccdf9f
commit 36fe8f6a63
3 changed files with 20 additions and 145 deletions
Download patch file Download diff file Expand all files Collapse all files

73
src/main.lisp
View file

@ -240,30 +240,6 @@
:verbose t)
))
(defun print-hash-entry (key value)
(format t "~S: ~S~%" key
(if (hash-table-p value)
(maphash 'print-hash-entry value)
(if (simple-vector-p value)
(loop
:for item
:in (setq value (coerce value 'list))
:do (maphash 'print-hash-entry item))
value))))
(defun process-form (form)
"Processes the form and sends it on"
(uiop:println "---")
(maphash 'print-hash-entry form)
(uiop:println "---"))
(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))
(defun mail-mt-form (form attachment)
"Takes the form as an alist and sends a table formatted email
with the image attached to us"
@ -381,7 +357,7 @@ with the image attached"
(:th (car row))
(:td (cdr row))))))))))))
(tbnl:define-easy-handler (respond :uri "/health-form") ()
(tbnl:define-easy-handler (health-form :uri "/health-form") ()
(setf (tbnl:header-out :access-control-expose-headers) "*")
(let* ((data (tbnl:post-parameters* tbnl:*request*))
(registration (cdr (assoc "registration" data :test 'string=)))
@ -433,7 +409,7 @@ with the image attached"
(:p :class "text-md"
"If you'd like to pay for your registration go to the donate tab in the top right when you are ready and find the camp registration option.")))))))
(hunchentoot:define-easy-handler (respond :uri "/camp-api") ()
(hunchentoot:define-easy-handler (camp-form :uri "/camp-api") ()
(let* ((request-type (hunchentoot:request-method hunchentoot:*request*))
(data (hunchentoot:post-parameters* hunchentoot:*request*))
(registration (cdr (assoc "registration" data :test 'string=)))
@ -472,51 +448,6 @@ with the image attached"
(uiop:println (tbnl:headers-out*))
(mail-camp-form data nil)))))
(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")))))))
(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)
(format t "Server has started on port 4242~&")