controller: Add POST handler for issue comments.

1 files changed, 40 insertions, 0 deletions

diff --git a/mumi/web/controller.scm b/mumi/web/controller.scm
index 62a9b00..b787539 100644
--- a/mumi/web/controller.scm
+++ b/mumi/web/controller.scm
@@ -27,6 +27,7 @@
   #:use-module (gcrypt base64)
   #:use-module (gcrypt mac)
   #:use-module (mumi config)
+  #:use-module (mumi jobs)
   #:use-module (mumi messages)
   #:use-module (mumi web render)
   #:use-module (mumi web download)
@@ -115,6 +116,45 @@
              (render-html (issue-page bug message)
                           #:extra-headers headers))
            (render-html (unknown id)))))
+    (('POST "issue" (? string->number id) "comment")
+     (if (mailer-enabled?)
+         (let ((headers   (request-headers request))
+               (form-data (parse-form-submission request body))
+               (cookie    (or (session-data %session-manager request)
+                              '())))
+           (if (and
+                ;; The encrypted cookie must be fresh and contain the
+                ;; current issue id.
+                (and=> (assoc-ref cookie 'issue-id)
+                       (cut string=? id <>))
+                ;; The request must come with a local referer
+                (and=> (assoc-ref headers 'referer)
+                       (lambda (referer)
+                         (equal? (uri-host referer)
+                                 (and=> (assoc-ref headers 'host) first))))
+                ;; The honeypot field "validation" must remain empty
+                (let ((val (assoc-ref form-data 'validation)))
+                  (and val (string-null? (string-trim-both val))))
+                ;; Submission may not have happened too quickly
+                (let ((time (assoc-ref form-data 'timestamp)))
+                  (and time (reasonable-timestamp? time)))
+                ;; Message must not be too short
+                (and=> (assoc-ref form-data 'text)
+                       (lambda (text)
+                         (> (string-length (string-trim-both text)) 10)))
+                ;; Message must have sender
+                (and=> (assoc-ref form-data 'from)
+                       (compose (negate string-null?) string-trim-both)))
+               (begin
+                 ;; Send comment to list
+                 (enqueue 'mail
+                          `((from . ,(string-trim-both (assoc-ref form-data 'from)))
+                            (to . ,(format #f "~a@~a"
+                                           id (%config 'debbugs-domain)))
+                            (text . ,(assoc-ref form-data 'text))))
+                 (redirect (list "issue" id) "comment-ok"))
+               (redirect (list "issue" id) "comment-error")))
+         (redirect (list "issue" id) "comment-error")))
     (('GET "issue" (? string->number id)
            "attachment" (? string->number msg-num)
            (? string->number path) ...)