Make use of Akismet for spam detection.

darcs-hash:8828531ab148ca71cca0a0dbef7733717834cbb4

10 files changed, 138 insertions, 14 deletions

diff --git a/defpackage.lisp b/defpackage.lisp
index 72ba573..793d6c7 100644
--- a/defpackage.lisp
+++ b/defpackage.lisp
@@ -23,5 +23,5 @@
 (defpackage #:mulk.journal
   (:nicknames #:journal)
   (:use #:cl #:fad #:iterate #:markdown #:yaclml #:http #:alexandria
-        #:xml-emitter #:split-sequence #:clsql)
+        #:xml-emitter #:split-sequence #:clsql #:drakma)
   (:shadow #:format-date))
diff --git a/globals.lisp b/globals.lisp
index 9d5f1f7..ade91a3 100644
--- a/globals.lisp
+++ b/globals.lisp
@@ -65,3 +65,9 @@
 
 (defparameter *cache-dir* nil
   "The directory used for caching generated markup.")
+
+(defparameter *wordpress-key* nil
+  "The WordPress/Akismet API key to use.")
+
+(defparameter *journal-warnings* nil
+  "Warnings that should be displayed to the user.")
diff --git a/journal-content.lisp b/journal-content.lisp
index 6529b57..92c5d6c 100644
--- a/journal-content.lisp
+++ b/journal-content.lisp
@@ -79,17 +79,17 @@
        :initarg :id)
    (entry-id :type integer
              :db-constraints :not-null
-             :accessor id-of
+             :accessor entry-id-of
              :initarg :entry-id)
    (entry :db-kind :join
           :db-constraints :not-null
           :accessor entry-of
           :initarg :entries
-          :initform '()
           :db-info (:join-class journal-entry
                     :home-key entry-id
                     :foreign-key id
-                    :set nil))
+                    :set nil
+                    :retrieval :immediate))
    (uuid :type (string 36)
          :db-constraints :not-null
          :accessor uuid-of
@@ -114,7 +114,19 @@
    (website :type string
             :accessor website-of
             :initarg :website
-            :initform nil)))
+            :initform nil)
+   (spam-p :type boolean
+           :accessor spamp
+           :initarg :spamp
+           :initform :spamp)
+   (submitter-ip :type string
+                 :db-constraints :not-null
+                 :accessor submitter-ip
+                 :initarg :submitter-ip)
+   (submitter-user-agent :type string
+                         :db-constraints :not-null
+                         :accessor submitter-user-agent
+                         :initarg :submitter-user-agent)))
 
 
 (clsql:def-view-class journal-category ()
diff --git a/journal.css b/journal.css
index 7d2c5c0..aca6f5a 100644
--- a/journal.css
+++ b/journal.css
@@ -100,3 +100,20 @@ img.JOURNAL-ENTRY-PORTRAIT {
   text-align: justify;
   text-indent: 1em;
 }
+
+#WARNINGS {
+  align: center;
+  width: 100%;
+}
+
+.JOURNAL-WARNING {
+  position: relative;
+  left: 15%;
+  width: 70%;
+  border: 3px outset #666;
+  color: #000;
+  background-color: #ffd0c0;
+  margin: 1em 0 0 0;
+  padding: 0 0.3em 0 0.3em;
+  text-align: justify;
+}
diff --git a/journal.lisp b/journal.lisp
index 5da6fe1..8e612e5 100755
--- a/journal.lisp
+++ b/journal.lisp
@@ -198,9 +198,14 @@
      (<:p (<:as-is "Bitte beachten Sie, da&szlig; E-Mail-Adressen niemals
                     ver&ouml;ffentlicht werden und nur von Matthias eingesehen
                     werden k&ouml;nnen."))
-     (<:p (<:strong "Hinweis an Spammer: ")
-          (<:as-is "Hyperlinks werden so erzeugt, da&szlig; sie von Suchmaschinen
-                    nicht beachtet werden.  Sparen Sie sich also die M&uuml;he."))
+     (<:p (<:strong "Hinweise: ")
+          "Diese Website verwendet "
+          (<:a :href "http://akismet.com/" "Akismet")
+          " zur Spamerkennung. "
+          (<:as-is "E-Mail-Adressen werden auch gegen&uuml;ber Akismet
+                    unter Verschlu&szlig; gehalten.  Nur unformatierter
+                    Text ist erlaubt.  Leerzeilen trennen
+                    Abs&auml;tze."))
      (<:form :action (link-to :view :post-id id)
              :method "post"
              :accept-charset #+(or) "ISO-10646-UTF-1"
@@ -279,6 +284,12 @@
           "NEU!  Jetzt ohne regelm&auml;&szlig;ige Serverabst&uuml;rze!"
           "NEU!  Jetzt mit mehr als 3 % Uptime!")))
       (<:as-is " &bull;&bull;&bull;")))
+    (when *journal-warnings*
+      (<:div :id :warnings
+       (dolist (warning *journal-warnings*)
+         (<:div :class :journal-warning
+          (<:p (<:strong "Achtung!"))
+          (<:as-is warning)))))
     (<:div :id :contents
      (funcall thunk))
     (<:div :id :navigation))
diff --git a/main.lisp b/main.lisp
index 90487cd..bbc08e6 100644
--- a/main.lisp
+++ b/main.lisp
@@ -62,6 +62,10 @@
                               (:mst-plus *script-dir*)
                               (:nfs.net #p"/home/protected/journal/")))
          (*cache-dir*       (merge-pathnames #p"cache/" *data-dir*))
+         (*wordpress-key*   (with-open-file (file (merge-pathnames
+                                                   "wordpress-api-key.key"
+                                                   *data-dir*))
+                              (read-line file)))
          (database-file     (merge-pathnames #p"journal.sqlite3" *data-dir*))
          (sqlite-library    (merge-pathnames #p"libsqlite3.so"
                                              (ecase *site*
@@ -126,8 +130,35 @@
                                   :author   (getf *query* :author)
                                   :email    (getf *query* :email)
                                   :website  (getf *query* :website)
-                                  :body     (getf *query* :comment-body))))
+                                  :body     (getf *query* :comment-body)
+                                  :submitter-ip (gethash "REMOTE_ADDR" *http-env*)
+                                  :submitter-user-agent (gethash "HTTP_USER_AGENT" *http-env*))))
                          (push comment (comments-about entry))
+                         (with-slots (spam-p) comment
+                           (setq spam-p (detect-spam comment
+                                                     :referrer (gethash "HTTP_REFERER" *http-env*)))
+                           (when spam-p
+                             (push (format nil
+                                    "<p>Ihr Kommentar wurde als ~
+                                     m&ouml;gliche unerw&uuml;nschte ~
+                                     Werbung (Spam) klassifiert.  Der ~
+                                     Inhaber dieses Journals wird Ihre ~
+                                     Nachricht manuell moderieren ~
+                                     m&uuml;ssen, weshalb eine ~
+                                     Ver&ouml;ffentlichung noch etwas ~
+                                     auf sich warten lassen kann.</p> ~
+                                     ~
+                                     <p>Wenn Sie ganz sichergehen ~
+                                     wollen, da&szlig; Ihr Beitrag ~
+                                     ver&ouml;ffentlicht wird, dann ~
+                                     k&ouml;nnen Sie versuchen, ihn ~
+                                     abzu&auml;ndern und erneut ~
+                                     einzuschicken.</p>~
+                                     ~
+                                     <p>Hinweis: Diese Website verwendet ~
+                                     <a href=\"http://akismet.com/\">Akismet</a> ~
+                                     f&uuml;r die Spamerkennung.</p>")
+                                     *journal-warnings*)))
                          (update-records-from-instance comment)
                          (update-records-from-instance entry)))
                      (show-web-journal))
diff --git a/make-clisp-package.sh b/make-clisp-package.sh
index 6ecf370..69fc85a 100755
--- a/make-clisp-package.sh
+++ b/make-clisp-package.sh
@@ -1,6 +1,10 @@
 #! /bin/sh
 cd ~
-for x in Downloads/Git/clsql Downloads/Darcs/{cffi,metabang-bind,iterate,cl-markdown,cl-containers,defsystem-compatibility,alexandria,lw-compat,moptilities,metatilities,Bese/arnesi_dev,Bese/yaclml,asdf-system-connections,closer-mop,parenscript} .clc/site/{xml-emitter-1.0.2,lisp-cgi-utils-0.10,cl-utilities-1.2.4} /usr/share/common-lisp/source/{asdf,cl-fad,cl-ppcre,slime,split-sequence}; do
-	find "$x" -not -regex ".*/_darcs/.*" \( -regex ".*\\.c" -or -regex "Makefile.*" -or -regex ".*\\.lisp" -or -regex ".*\\.asd" -or -regex "COPYING" -or -regex "index.lml" \)
+for x in Downloads/Git/clsql\
+         Downloads/Darcs/{cffi,metabang-bind,iterate,cl-markdown,cl-containers,defsystem-compatibility,alexandria,lw-compat,moptilities,metatilities,Bese/arnesi_dev,Bese/yaclml,asdf-system-connections,closer-mop,parenscript}\
+         Downloads/CVS/SLIME/slime\
+         .clc/site/{drakma-0.6.2,xml-emitter-1.0.2,lisp-cgi-utils-0.10,cl-utilities-1.2.4}\
+         /usr/share/common-lisp/source/{asdf,cl-chunga,cl-plus-ssl,cl-base64,cl-fad,cl-ppcre,cl-flexi-streams,puri,split-sequence,trivial-sockets,cl-trivial-gray-streams}; do
+	find "$x" -not -regex ".*/_darcs/.*" \( -regex ".*\\.c" -or -name "Makefile" -or -name "Makefile.*" -or -regex ".*\\.lisp" -or -regex ".*\\.asd" -or -regex "COPYING" -or -regex "index.lml" \)
 done | tar -T - -cjf - | ssh mulk_benkard@ssh.phx.nearlyfreespeech.net 'mkdir -p /tmp/clisp-stuff && cd /tmp/clisp-stuff && tar xjf - && mkdir -p /tmp/asdf && cd /tmp/asdf && find ../clisp-stuff -name "*.asd" | xargs -I "{}" ln -sf "{}" . && mkdir -p /home/tmp/clisp-stuff/Downloads/Darcs/asdf-system-connections/website/source/images && touch /home/tmp/clisp-stuff/Downloads/Darcs/asdf-system-connections/website/source/index.lml && gmake -C /tmp/clisp-stuff/Downloads/Git/clsql/uffi' && \
-ssh -t mulk_benkard@ssh.phx.nearlyfreespeech.net 'cd /tmp/clisp-stuff && clisp -x "(load \"usr/share/common-lisp/source/asdf/asdf.lisp\")" -x "(let ((asdf:*central-registry* (quote (#p\"/tmp/asdf/\")))) (dolist (x (list :cffi :cl-ppcre :cl-fad :iterate :cl-markdown :parenscript :yaclml :lisp-cgi-utils :alexandria :xml-emitter :split-sequence :clsql :clsql-sqlite3)) (asdf:oos (quote asdf:load-op) x)) (saveinitmem \"lispinit.mem\"))" && gzip -f lispinit.mem && mv lispinit.mem.gz /home/private/ && mv /tmp/clisp-stuff/Downloads/Git/clsql/uffi/clsql_uffi.so /home/private/ && rm -rf /tmp/clisp-stuff && rm -rf /tmp/asdf'
+ssh -t mulk_benkard@ssh.phx.nearlyfreespeech.net 'cd /tmp/clisp-stuff && clisp -x "(load \"usr/share/common-lisp/source/asdf/asdf.lisp\")" -x "(let ((asdf:*central-registry* (quote (#p\"/tmp/asdf/\")))) (dolist (x (list :drakma :cffi :cl-ppcre :cl-fad :iterate :cl-markdown :parenscript :yaclml :lisp-cgi-utils :alexandria :xml-emitter :split-sequence :clsql :clsql-sqlite3)) (asdf:oos (quote asdf:load-op) x)) (saveinitmem \"lispinit.mem\"))" && gzip -f lispinit.mem && mv lispinit.mem.gz /home/private/ && mv /tmp/clisp-stuff/Downloads/Git/clsql/uffi/clsql_uffi.so /home/private/ && rm -rf /tmp/clisp-stuff && rm -rf /tmp/asdf'
diff --git a/make-core-image.sh b/make-core-image.sh
index 6eb467b..a8d6130 100755
--- a/make-core-image.sh
+++ b/make-core-image.sh
@@ -2,7 +2,7 @@
 clisp -q -q -on-error exit <<EOF
 (dolist (system '(:cl-ppcre :cl-fad :iterate :cl-markdown :parenscript
                   :yaclml :lisp-cgi-utils :alexandria :xml-emitter
-                  :split-sequence :clsql :clsql-sqlite3))
+                  :split-sequence :clsql :clsql-sqlite3 :drakma))
   (clc:clc-require system))
 (saveinitmem "lispinit.mem")
 (quit)
diff --git a/mulk-journal.asd b/mulk-journal.asd
index 8dad08c..6cd1da5 100644
--- a/mulk-journal.asd
+++ b/mulk-journal.asd
@@ -25,7 +25,8 @@
   :licence     "Affero General Public License, version 1 or higher"
   :depends-on  (#:cl-ppcre #:cl-fad #:iterate #:cl-markdown #:parenscript
                 #:yaclml #:lisp-cgi-utils #:alexandria #:xml-emitter
-                #:split-sequence #:clsql #:clsql-uffi #:clsql-sqlite3)
+                #:split-sequence #:clsql #:clsql-uffi #:clsql-sqlite3
+                #:drakma)
   :components  ((:file "defpackage")
                 (:file "macros")
                 (:file "globals")
diff --git a/utils.lisp b/utils.lisp
index d4a2d77..64edb9e 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -203,3 +203,45 @@ ELEMENT-TYPE as the stream's."
   (when errorp
     (assert (not (null list))))
   (first list))
+
+
+(defun akismet-login ()
+  (drakma:http-request "http://rest.akismet.com/1.1/verify-key"
+                       :protocol :http/1.0
+                       :method :post
+                       :user-agent "Mulk Journal/0.0.1"
+                       :parameters `(("key" . ,*wordpress-key*)
+                                     ("blog" . "http://matthias.benkard.de/journal"))))
+
+
+(defun akismet-check-comment (comment referrer)
+  #.(locally-enable-sql-reader-syntax)
+  (prog1
+      (with-slots (submitter-user-agent submitter-ip body author website entry-id)
+                  comment
+         (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" . "http://matthias.benkard.de/journal")
+                                            ("user_ip" . ,submitter-ip)
+                                            ("user_agent" . ,submitter-user-agent)
+                                            ,@(when referrer
+                                                `(("referrer" . ,referrer)))
+                                            ("permalink" . ,(link-to :view
+                                                                     :post-id (first
+                                                                               (select [id]
+                                                                                       :from [journal-entry]
+                                                                                       :where [= [id] entry-id]
+                                                                                       :flatp t))))
+                                            ("comment_type" . "comment")
+                                            ("comment_author" . ,author)
+                                            ("comment_author_url" . ,website)
+                                            ("comment_content" . ,body))))
+    #.(restore-sql-reader-syntax-state)))
+
+
+(defun detect-spam (comment &key referrer)
+  (ignore-errors
+    (akismet-login)
+    (string= "true" (akismet-check-comment comment referrer))))