From 0c692b3197ff79dfbcd1eaad132b517fb81943f9 Mon Sep 17 00:00:00 2001 From: Chris Cochrun Date: Wed, 10 Jan 2024 09:36:08 -0600 Subject: [PATCH] making the lisp server leaner --- src/main.lisp | 186 +++++++++++++------------------------------------- 1 file changed, 49 insertions(+), 137 deletions(-) diff --git a/src/main.lisp b/src/main.lisp index 23c4f4c..e2b3b5c 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -313,46 +313,45 @@ with the image attached to us" (defun mail-health-form (form attachment) "Takes the form as an alist and sends a table formatted email with the image attached" - (let ((first-name (serapeum:trim-whitespace - (cdr (assoc "firstname" form + (let* ((first-name (serapeum:trim-whitespace + (cdr (assoc "firstname" form + :test 'string=)))) + (last-name (serapeum:trim-whitespace + (cdr (assoc "lastname" form :test 'string=)))) - (last-name (serapeum:trim-whitespace - (cdr (assoc "lastname" form - :test 'string=)))) - (parent-name (concatenate 'string - (serapeum:trim-whitespace - (cdr (assoc "parentfirstname" form - :test 'string=))) - " " - (serapeum:trim-whitespace - (cdr (assoc "parentlastname" form - :test 'string=)))))) - (let ((form (reverse form))) - (not (cl-smtp:send-email - "mail.tfcconnection.org" - "no-reply@mail.tfcconnection.org" - '("chris@tfcconnection.org" "ethan@tfcconnection.org") - (format nil "~a ~a filled out a Health Form!" first-name last-name) - (format nil "Health 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 "Health Form for ~a ~a" first-name last-name)) - (:hr) - (:table - (loop for row in form - do (:tr - (:th (car row)) - (:td (trim-whitespace - (cdr row)))))))))))))) + (attachment (uiop:copy-file attachment (path-join hunchentoot:*tmp-directory* (format nil "~a_~a" "Frodo" "Braggins")))) + (parent-name (concatenate 'string + (serapeum:trim-whitespace + (cdr (assoc "parentfirstname" form + :test 'string=))) + " " + (serapeum:trim-whitespace + (cdr (assoc "parentlastname" form + :test 'string=)))))) + (not (cl-smtp:send-email + "mail.tfcconnection.org" + "no-reply@mail.tfcconnection.org" + '("chris@tfcconnection.org") + (format nil "~a ~a filled out a Health Form!" first-name last-name) + (format nil "Health 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 "Health Form for ~a ~a" first-name last-name)) + (:hr) + (:table + (loop for row in form + do (:tr + (:th (car row)) + (:td (cdr row)))))))))))) (hunchentoot:define-easy-handler (respond :uri "/mt-form") () (setf (hunchentoot:content-type*) "plain/text") @@ -438,106 +437,19 @@ with the image attached" (hunchentoot:define-easy-handler (respond :uri "/health-form") () (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*)) + (attachment nil)) (cond ((eq request-type :get) nil) ((eq request-type :post) - (uiop:println hunchentoot:*request*) - (setq *last* hunchentoot:*request*) - (setq *stream* (hunchentoot::content-stream hunchentoot:*request*)) - (let* ((data (hunchentoot::get-post-data :request *last*)) - (content-type - (hunchentoot:header-in "content-type" hunchentoot:*request*)) - (boundary (let ((position (position #\= content-type))) - (when position - (subseq content-type (1+ position))))) - (string-data (flexi-streams:octets-to-string data)) - (parts (ppcre:split boundary string-data)) - (attachment nil)) - - (setq *last-data* parts) - (setq *last-list-data* nil) - (loop :for i :in *last-data* - :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") - (butlast - (rest - (rest - (rest - (rest - (serapeum:lines i - :eol-style - :crlf - :honor-crlf t - :keep-eols t)))))) - (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)) - (form-list nil)) - - ;; This gets rid of beginning and ending NIL values - (if (string/= name "image") - (if (listp content) - (setq content - (serapeum:mapconcat - (lambda (x) (if (string= x "") - (coerce #\Newline 'string) - x)) - content "")))) - (if name - (if (string/= name "image") - (progn - (format t "~&~A: ~A" name content) - (setq form-list - (acons name content form-list)))) nil) - - (if (string= "image" name) - (progn - (format t "~&~A: ~A" name image-file-name) - (if (uiop:file-exists-p image-file-name) - (progn - (setq form-list - (acons name image-file-name form-list)) - (save-string-file - (apply #'concatenate 'string content) - image-file-name) - (setf attachment image-file-name))))) - - (setq *last-list-data* - (append *last-list-data* form-list)))) - ;; (post-health-form *last-list-data*) - (if (mail-health-form *last-list-data* attachment) - (format nil "thankyou"))))))) + (loop :for d :in post-data + :do (progn + (uiop:println d) + (if (string= "image" (car d)) + (progn (setf attachment (cadr d)) + (uiop:println attachment))))) + (if (mail-health-form post-data attachment) + (format nil "thankyou")))))) (defun main () (start-server 4242)