create an abstraction for POST forms
This commit is contained in:
parent
31f05fc5be
commit
5cc601e577
125
src/main.lisp
125
src/main.lisp
|
@ -319,7 +319,6 @@ with the image attached"
|
|||
(last-name (serapeum:trim-whitespace
|
||||
(cdr (assoc "lastname" form
|
||||
:test 'string=))))
|
||||
(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
|
||||
|
@ -331,7 +330,7 @@ with the image attached"
|
|||
(not (cl-smtp:send-email
|
||||
"mail.tfcconnection.org"
|
||||
"no-reply@mail.tfcconnection.org"
|
||||
'("chris@tfcconnection.org")
|
||||
'("chris@tfcconnection.org" "chris@cochrun.xyz")
|
||||
(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"
|
||||
|
@ -353,103 +352,49 @@ with the image attached"
|
|||
(:th (car row))
|
||||
(:td (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")
|
||||
nil
|
||||
;; (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")
|
||||
(when (stringp content)
|
||||
(progn
|
||||
(if (not (uiop:file-exists-p image-file-name))
|
||||
(save-string-file
|
||||
(apply #'concatenate 'string content)
|
||||
image-file-name))
|
||||
(setf attachment image-file-name)
|
||||
(delete-file image-file-name)))
|
||||
(setq form-list (acons name content form-list))))))
|
||||
(if (mail-mt-form form-list attachment)
|
||||
(progn
|
||||
(uiop:println "Mail sent")
|
||||
(format nil "thankyou")))))))
|
||||
|
||||
(hunchentoot:define-easy-handler (respond :uri "/health-form") ()
|
||||
(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))
|
||||
(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))
|
||||
(progn (setf attachment (cadr d))
|
||||
(uiop:println attachment)))))
|
||||
(if (mail-health-form post-data attachment)
|
||||
(format nil "thankyou"))))))
|
||||
(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)
|
||||
|
||||
(defun main ()
|
||||
(start-server 4242)
|
||||
|
|
Loading…
Reference in a new issue