api of mt-form almost ready
This commit is contained in:
		
							parent
							
								
									d0ebf6baab
								
							
						
					
					
						commit
						89deac098f
					
				
					 1 changed files with 200 additions and 91 deletions
				
			
		
							
								
								
									
										109
									
								
								src/main.lisp
									
										
									
									
									
								
							
							
						
						
									
										109
									
								
								src/main.lisp
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -277,6 +277,39 @@
 | 
			
		|||
                                          :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"
 | 
			
		||||
  (uiop:println form)
 | 
			
		||||
  (let ((first-name (cdr (assoc "firstname" form :test 'string=)))
 | 
			
		||||
        (last-name (cdr (assoc "lastname" form :test 'string=))))
 | 
			
		||||
    (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 Mission Trip Form!" first-name last-name)
 | 
			
		||||
     (format nil "Mission Trip 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 Mission Trip Form")
 | 
			
		||||
               (:style (apply #'lass:compile-and-write *mail-css*)))
 | 
			
		||||
        (:body
 | 
			
		||||
         (:h1 (format nil "Mission Trip 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)))))))))))
 | 
			
		||||
  (uiop:println "Mail sent!"))
 | 
			
		||||
 | 
			
		||||
(defun mail-form (form attachment)
 | 
			
		||||
  "Takes the form as an alist and sends a table formatted email
 | 
			
		||||
with the image attached"
 | 
			
		||||
| 
						 | 
				
			
			@ -401,6 +434,82 @@ with the image attached"
 | 
			
		|||
                         (:td (trim-whitespace
 | 
			
		||||
                               (cdr row)))))))))))))
 | 
			
		||||
 | 
			
		||||
(hunchentoot:define-easy-handler (respond :uri "/mt-form") ()
 | 
			
		||||
  (setf (hunchentoot:content-type*) "plain/text")
 | 
			
		||||
  (let* ((request-type (hunchentoot:request-method hunchentoot:*request*))
 | 
			
		||||
         (req hunchentoot:*request*)
 | 
			
		||||
         (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")
 | 
			
		||||
                                           (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")
 | 
			
		||||
                               (if (uiop:file-exists-p image-file-name)
 | 
			
		||||
                                   (progn
 | 
			
		||||
                                     (save-string-file
 | 
			
		||||
                                      (apply #'concatenate 'string content)
 | 
			
		||||
                                      image-file-name)
 | 
			
		||||
                                     (setq form-list (acons name image-file-name form-list))
 | 
			
		||||
                                     (setf attachment image-file-name)))
 | 
			
		||||
                               (setq form-list (acons name content form-list))))))
 | 
			
		||||
           (if (mail-mt-form form-list attachment)
 | 
			
		||||
               (format nil "thankyou"))))))
 | 
			
		||||
 | 
			
		||||
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
 | 
			
		||||
  (setf (hunchentoot:content-type*) "plain/text")
 | 
			
		||||
  (let ((request-type (hunchentoot:request-method hunchentoot:*request*)))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue