summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--globals.lisp3
-rwxr-xr-xjournal-admin.cgi2
-rwxr-xr-xjournal.cgi2
-rw-r--r--main.lisp26
-rw-r--r--utils.lisp72
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))))