Support comment submission notification via e-mail.

darcs-hash:72d3c69e6dc8ef47e9e6224adcc135637957ad09

5 files changed, 93 insertions, 12 deletions

diff --git a/globals.lisp b/globals.lisp
index ade91a3..a81d0ef 100644
--- a/globals.lisp
+++ b/globals.lisp
@@ -26,6 +26,9 @@
 (defparameter *site* nil
   "One of :WIRSELKRAUT and :NFS.NET.")
 
+(defparameter *notification-email* "mulk@gmx.net"
+  "The e-mail address that comment submissions are to be sent to.")
+
 (defparameter *debugging-p* nil)
 
 (defparameter *query* nil
diff --git a/journal-admin.cgi b/journal-admin.cgi
index 10ac2f5..bbff8a3 100755
--- a/journal-admin.cgi
+++ b/journal-admin.cgi
@@ -8,4 +8,4 @@ else
     LISPINIT_DIR=/home/protected/journal
 fi
 
-exec clisp -M "$LISPINIT_DIR/lispinit.mem.gz" "$DIR/run.lisp" --admin-mode
+exec env LC_ALL=de_DE.UTF-8 clisp -M "$LISPINIT_DIR/lispinit.mem.gz" "$DIR/run.lisp" --admin-mode
diff --git a/journal.cgi b/journal.cgi
index 43082f4..0d6208f 100755
--- a/journal.cgi
+++ b/journal.cgi
@@ -8,4 +8,4 @@ else
     LISPINIT_DIR=/home/protected/journal
 fi
 
-exec clisp -M "$LISPINIT_DIR/lispinit.mem.gz" "$DIR/run.lisp"
+exec env LC_ALL=de_DE.UTF-8 clisp -M "$LISPINIT_DIR/lispinit.mem.gz" "$DIR/run.lisp"
diff --git a/main.lisp b/main.lisp
index bbc08e6..fdd6b67 100644
--- a/main.lisp
+++ b/main.lisp
@@ -160,7 +160,9 @@
                                      f&uuml;r die Spamerkennung.</p>")
                                      *journal-warnings*)))
                          (update-records-from-instance comment)
-                         (update-records-from-instance entry)))
+                         (update-records-from-instance entry)
+                         (when (eq *site* :nfs.net)
+                           (mail-comment *notification-email* comment entry))))
                      (show-web-journal))
     (:view-atom-feed (show-atom-feed))
     (:view-debugging-page (show-debugging-page))
@@ -169,15 +171,19 @@
 
 #+clisp
 (defun journal-main ()
-  (ext:letf ((custom:*terminal-encoding* (ext:make-encoding
-                                          :charset charset:utf-8)))
-    (with-initialised-journal
-      (let ((*random-state* (make-random-state t)))
-        (if (member "--admin-mode"
-                    (coerce (ext:argv) 'list)
-                    :test #'string=)
-            (dispatch-admin-action)
-            (dispatch-user-action))))))
+  (let ((encoding (ext:make-encoding :charset charset:utf-8)))
+    (ext:letf* ((custom:*terminal-encoding* encoding)
+                (custom:*foreign-encoding* encoding)
+                (custom:*misc-encoding* encoding)
+                (custom:*pathname-encoding* encoding)
+                (custom:*default-file-encoding* encoding))
+      (with-initialised-journal
+        (let ((*random-state* (make-random-state t)))
+          (if (member "--admin-mode"
+                      (coerce (ext:argv) 'list)
+                      :test #'string=)
+              (dispatch-admin-action)
+              (dispatch-user-action)))))))
 
 
 #+clisp
diff --git a/utils.lisp b/utils.lisp
index 64edb9e..413d14a 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -245,3 +245,75 @@ ELEMENT-TYPE as the stream's."
   (ignore-errors
     (akismet-login)
     (string= "true" (akismet-check-comment comment referrer))))
+
+
+(defun mail (address subject body)
+  #-clisp
+  (cerror "Can't send e-mail on this Lisp implementation.")
+  #+clisp
+  (let ((sendmail-stdin (ext:run-program "sendmail"
+                                         :arguments (list address)
+                                         :wait t
+                                         :output nil
+                                         :input :stream)))
+    (format sendmail-stdin "~&To: ~A~
+                            ~&MIME-Version: 1.0~
+                            ~&Content-type: text/plain; charset=utf-8~
+                            ~&Content-transfer-encoding: quoted-printable~
+                            ~&Subject: =?utf-8?Q?~A?=~
+                            ~&~%~
+                            ~&~A"
+            address
+            (quote-printable subject nil)
+            (quote-printable body t))
+    (close sendmail-stdin)))
+
+
+(defun char-octets (string-designator)
+  #-clisp
+  (error "Can't convert strings to byte vectors on this Lisp implementation.")
+  #+clisp
+  (ext:convert-string-to-bytes (string string-designator)
+                               custom:*default-file-encoding*))
+
+
+(let ((printable-chars
+       ;; This list is incomplete, but that doesn't hurt.
+       (cons #\Newline
+             (coerce "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ,.-!~"
+                     'list))))
+  (defun quote-printable (text line-breaks-p)
+    (with-output-to-string (out)
+      (let ((i 0))
+        (loop for char across text
+              do (if (member char printable-chars)
+                     (princ char out)
+                     (loop for byte across (char-octets char)
+                           do (format out "=~2,'0X" byte)))
+              when (and line-breaks-p (= i 73))
+                do (progn
+                     (princ #\= out)
+                     (terpri out)
+                     (setq i 0))
+              else
+                do (incf i))))))
+
+
+(defun mail-comment (address comment entry)
+  (mail address
+        (format nil "[Kommentar] ~A" (title-of entry))
+        (format nil "~&Kommentar von: ~A~
+                     ~&E-Mail: ~A~
+                     ~&Website: ~A~
+                     ~&IP-Adresse: ~A~
+                     ~&Webbrowser: ~A~
+                     ~&Als Spam erkannt: ~A~
+                     ~&~%~
+                     ~&~A"
+                (author-of comment)
+                (email-of comment)
+                (website-of comment)
+                (submitter-ip comment)
+                (submitter-user-agent comment)
+                (spamp comment)
+                (body-of comment))))