diff options
author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2011-03-15 13:28:36 +0100 |
---|---|---|
committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2011-03-15 13:28:36 +0100 |
commit | c5436f91374bdf463e4c83637c90ac888f973a3f (patch) | |
tree | 073d0d838ce6f1ce036bb359e722e4b5fef4d4f3 | |
parent | ed8b8445f4981095ca30d59102ea124be7a13565 (diff) |
Add support for spam detection via Akismet.
-rw-r--r-- | mulkcms.asd | 2 | ||||
-rw-r--r-- | mulkcms.lisp | 47 |
2 files changed, 44 insertions, 5 deletions
diff --git a/mulkcms.asd b/mulkcms.asd index 13f0bc6..7668a81 100644 --- a/mulkcms.asd +++ b/mulkcms.asd @@ -10,7 +10,7 @@ :version "0.0.1" :depends-on (:cl-who :cl-json :alexandria :postmodern :split-sequence :cl-ppcre :cl-fad :cxml :closure-html :json-template :cxml-stp - :ironclad :flexi-streams) + :ironclad :flexi-streams :drakma) :components ((:file "package") (:file "site") (:file "mulkcms") diff --git a/mulkcms.lisp b/mulkcms.lisp index 03f57af..1445730 100644 --- a/mulkcms.lisp +++ b/mulkcms.lisp @@ -35,6 +35,42 @@ (every #'zerop (subseq digest 0 2)))) +(defun akismet-login () + ;; Taken from Mulkblog. + (drakma:http-request "http://rest.akismet.com/1.1/verify-key" + :protocol :http/1.0 + :method :post + :user-agent "MulkCMS/0.1.0" + :parameters `(("key" . ,*wordpress-key*) + ("blog" . ,*base-uri*)))) + + +(defun akismet-check-comment (body author-name author-website user-agent submitter-ip) + ;; Taken from Mulkblog. + (drakma:http-request + (format nil + "http://~A.rest.akismet.com/1.1/comment-check" + *wordpress-key*) + :protocol :http/1.0 + :method :post + :user-agent "Mulk Journal/0.0.1" + :parameters `(("blog" . ,*base-uri*) + ("user_ip" . ,submitter-ip) + ("user_agent" . ,user-agent) + ("comment_type" . "comment") + ("comment_author" . ,author-name) + ("comment_author_url" . ,author-website) + ("comment_content" . ,body)))) + + +(defun spamp/akismet (&rest comment-data) + ;; Taken from Mulkblog. + (when (and (boundp '*wordpress-key*) *wordpress-key*) + (ignore-errors + (akismet-login) + (string= "true" (apply #'akismet-check-comment comment-data))))) + + (defun find-canonical-article-alias (article) (query "SELECT alias FROM article_aliases WHERE article = $1 LIMIT 1" article @@ -681,10 +717,13 @@ (revision (cdr (assoc "revision" params :test #'equal))) (tkey (cdr (assoc "transaction-key" params :test #'equal))) (salt (cdr (assoc "salt" params :test #'equal))) - (spam-p (or (null tkey) - (null salt) - (not (hashcash-hash-validp - (format nil "~A:~A:~A" body tkey salt)))))) + (spam-p (if tkey + (or (null salt) + (not (hashcash-hash-validp + (format nil "~A:~A:~A" body tkey salt)))) + (spamp/akismet body name website + (hunchentoot:real-remote-addr) + (hunchentoot:user-agent))))) (with-transaction () (let ((comment (query "INSERT INTO comments(article, global_id) VALUES ($1, $2) |