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

updating with log info set properly

Browse source
This commit is contained in:
Chris Cochrun 2024-04-25 21:22:21 -05:00
parent 99aff941dd
commit c3bf1e3a9f
1 changed files with 10 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/main.lisp
View file

@ -13,6 +13,8 @@
(in-package :tfcserver) (in-package :tfcserver)
(log:config :daily "/tmp/tfc-%Y%m%d.log")
(defvar *server*) (defvar *server*)
(defun start-server (port) (defun start-server (port)
(setq *server* (setq *server*
@ -243,7 +245,7 @@
(defun mail-mt-form (form attachment) (defun mail-mt-form (form attachment)
"Takes the form as an alist and sends a table formatted email "Takes the form as an alist and sends a table formatted email
with the image attached to us" with the image attached to us"
(uiop:println form) (log:info form)
(let ((first-name (cdr (assoc "firstname" form :test 'string=))) (let ((first-name (cdr (assoc "firstname" form :test 'string=)))
(last-name (cdr (assoc "lastname" form :test 'string=))) (last-name (cdr (assoc "lastname" form :test 'string=)))
(form (reverse form))) (form (reverse form)))
@ -371,11 +373,9 @@ with the image attached"
(uiop:println d) (uiop:println d)
(if (string= "firstname" (car d)) (if (string= "firstname" (car d))
(progn (progn
(uiop:println (cdr d))
(setf first-name (cdr d)))) (setf first-name (cdr d))))
(if (string= "lastname" (car d)) (if (string= "lastname" (car d))
(progn (progn
(uiop:println (cdr d))
(setf last-name (cdr d)))) (setf last-name (cdr d))))
(if (string= "image" (car d)) (if (string= "image" (car d))
(let ((path (path-join (let ((path (path-join
@ -391,8 +391,8 @@ with the image attached"
(cadr (uiop:split-string (cadr (uiop:split-string
(car (last d 2)) :separator "."))))) (car (last d 2)) :separator ".")))))
(setf attachment path) (setf attachment path)
(uiop:println attachment))))) (log:info attachment)))))
(uiop:println data) (log:info data)
(mail-health-form data attachment) (mail-health-form data attachment)
(cond ((string= registration "now") (cond ((string= registration "now")
(setf (hunchentoot:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JPJ")) (setf (hunchentoot:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JPJ"))
@ -414,19 +414,18 @@ with the image attached"
(data (hunchentoot:post-parameters* hunchentoot:*request*)) (data (hunchentoot:post-parameters* hunchentoot:*request*))
(registration (cdr (assoc "registration" data :test 'string=))) (registration (cdr (assoc "registration" data :test 'string=)))
(health (cdr (assoc "health" data :test 'string=)))) (health (cdr (assoc "health" data :test 'string=))))
(uiop:println data) (log:info data)
;; This is extremely necessary so that cors is right ;; This is extremely necessary so that cors is right
(setf (tbnl:header-out :access-control-expose-headers) "*") (setf (tbnl:header-out :access-control-expose-headers) "*")
(if (string= health "later") (if (string= health "later")
(progn (uiop:println "Selected health later") (progn (uiop:println "Selected health later")
(cond ((string= registration "now") (cond ((string= registration "now")
(setf (hunchentoot:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JPJ") (setf (hunchentoot:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JPJ")
(uiop:println (tbnl:headers-out*)) (log:info (tbnl:headers-out*))
(uiop:println (hunchentoot:return-code*))
(mail-camp-form data nil)) (mail-camp-form data nil))
((string= registration "full") ((string= registration "full")
(setf (tbnl:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JQE") (setf (tbnl:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JQE")
(uiop:println (tbnl:headers-out*)) (log:info (tbnl:headers-out*))
(mail-camp-form data nil)) (mail-camp-form data nil))
((string= registration "later") ((string= registration "later")
(let ((first-name (cdr (assoc "firstname" data :test 'string=))) (let ((first-name (cdr (assoc "firstname" data :test 'string=)))
@ -443,14 +442,13 @@ with the image attached"
(:p :class "text-md" (: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."))))))) "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.")))))))
(progn (progn
(uiop:println "Health now")
(setf (tbnl:header-out :HX-Redirect) (format nil "/camp-health-form/?registration=~A" registration)) (setf (tbnl:header-out :HX-Redirect) (format nil "/camp-health-form/?registration=~A" registration))
(uiop:println (tbnl:headers-out*)) (log:info (tbnl:headers-out*))
(mail-camp-form data nil))))) (mail-camp-form data nil)))))
(defun main () (defun main ()
(start-server 4242) (start-server 4242)
(format t "Server has started on port 4242~&") (log:info "Server has started on port 4242~&")
(handler-case (handler-case
(bt:join-thread (find-if (lambda (th) (bt:join-thread (find-if (lambda (th)
(search "hunchentoot" (bt:thread-name th))) (search "hunchentoot" (bt:thread-name th)))