summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--journal-content.lisp84
-rw-r--r--main.lisp33
-rw-r--r--utils.lisp21
3 files changed, 137 insertions, 1 deletions
diff --git a/journal-content.lisp b/journal-content.lisp
index 65ac245..cf31ae6 100644
--- a/journal-content.lisp
+++ b/journal-content.lisp
@@ -68,7 +68,15 @@
:db-info (:join-class journal-comment
:home-key id
:foreign-key entry-id
- :set t))))
+ :set t))
+ (trackbacks :db-kind :join
+ :db-constraints :not-null
+ :accessor %trackbacks-about
+ :initarg :trackbacks
+ :db-info (:join-class journal-trackback
+ :home-key id
+ :foreign-key entry-id
+ :set t))))
(clsql:def-view-class journal-comment ()
@@ -127,6 +135,61 @@
:accessor submitter-user-agent
:initarg :submitter-user-agent)))
+(clsql:def-view-class journal-trackback ()
+ ((id :db-kind :key
+ :type integer
+ :db-constraints :not-null
+ :accessor id-of
+ :initarg :id)
+ (entry-id :type integer
+ :db-constraints :not-null
+ :accessor entry-id-of
+ :initarg :entry-id)
+ (entry :db-kind :join
+ :db-constraints :not-null
+ :accessor entry-of
+ :initarg :entries
+ :db-info (:join-class journal-entry
+ :home-key entry-id
+ :foreign-key id
+ :set nil))
+ (uuid :type (string 36)
+ :db-constraints :not-null
+ :accessor uuid-of
+ :initarg :uuid)
+ (date :type universal-time
+ :db-constraints :not-null
+ :accessor date-of
+ :initarg :date)
+ (excerpt :type string
+ :db-constraints :not-null
+ :accessor excerpt-of
+ :initarg :excerpt
+ :initform "")
+ (title :type string
+ :accessor title-of
+ :initarg :title
+ :initform nil)
+ (blog-name :type string
+ :accessor blog-name-of
+ :initarg :blog-name
+ :initform nil)
+ (url :type string
+ :accessor url-of
+ :initarg :website
+ :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 ()
((id :db-kind :key
@@ -152,6 +215,8 @@
;; (@* "Journal entry operations")
(defgeneric comments-about (thing &key ordered-p))
(defgeneric (setf comments-about) (new-value thing &key ordered-p))
+(defgeneric trackbacks-about (thing &key ordered-p))
+(defgeneric (setf trackbacks-about) (new-value thing &key ordered-p))
(defmethod comments-about ((journal-entry journal-entry) &key ordered-p ham-p)
#.(locally-enable-sql-reader-syntax)
@@ -182,6 +247,13 @@
(setf (%comments-about journal-entry) new-value))
+(defmethod (setf trackbacks-about) (new-value
+ (journal-entry journal-entry)
+ &key ordered-p)
+ (declare (ignore ordered-p))
+ (setf (%trackbacks-about journal-entry) new-value))
+
+
(defun make-journal-entry-id ()
#.(locally-enable-sql-reader-syntax)
(prog1
@@ -202,6 +274,16 @@
#.(restore-sql-reader-syntax-state)))
+(defun make-journal-trackback-id ()
+ #.(locally-enable-sql-reader-syntax)
+ (prog1
+ (1+ (or (single-object (select [max [slot-value 'journal-trackback 'id]]
+ :from [journal-trackback]
+ :flatp t))
+ -1))
+ #.(restore-sql-reader-syntax-state)))
+
+
(defun find-entry (number)
#.(locally-enable-sql-reader-syntax)
(prog1
diff --git a/main.lisp b/main.lisp
index 9bc8d43..48c575d 100644
--- a/main.lisp
+++ b/main.lisp
@@ -50,6 +50,7 @@
((string= "comment-feed" (first *subpath*)) :view-comment-feed)
((string= "debug" (first *subpath*)) :view-debugging-page)
((string= "preview" (car (last *subpath*))) :preview-entry)
+ ((string= "trackback" (car (last *subpath*))) :post-trackback)
((string= "save" (car (last *subpath*))) :save-entry)
(*post-number* :view)
(t nil))))
@@ -187,6 +188,38 @@
(when (eq *site* :nfs.net)
(mail-comment *notification-email* comment entry))))
(show-web-journal))
+ (:post-trackback (with-transaction ()
+ (let* ((entry (find-entry *post-number*))
+ (trackback
+ (make-instance 'journal-trackback
+ :id (make-journal-trackback-id)
+ :uuid (make-uuid)
+ :entry-id (id-of entry)
+ :date (get-universal-time)
+ :blog-name (getf *query* :blog-name)
+ :title (getf *query* :title)
+ :excerpt (getf *query* :excerpt)
+ :url (getf *query* :url)
+ :submitter-ip (gethash "REMOTE_ADDR" *http-env*)
+ :submitter-user-agent (gethash "HTTP_USER_AGENT" *http-env*))))
+ (http-send-headers "application/atom+xml; charset=UTF-8")
+ (cond
+ ((getf *query* :url)
+ (push trackback (trackbacks-about entry))
+ (format t "<?xml version=\"1.0\" encoding=\"utf-8\"?>~&<response>~&<error>0</error>~&</response>"))
+ (t
+ (format t "<?xml version=\"1.0\" encoding=\"utf-8\"?>~&<response>~&<error>1</error>~&<message>No URI was provided.</message>~&</response>")))
+ (with-slots (spam-p) trackback
+ (setq spam-p (detect-spam trackback
+ :referrer (gethash "HTTP_REFERER" *http-env*))))
+ (update-records-from-instance trackback)
+ (update-records-from-instance entry)
+ (unless (spamp trackback)
+ (update-records 'journal_trackback
+ :where [= [slot-value 'journal-trackback 'id] (id-of trackback)]
+ :av-pairs `((spam_p nil))))
+ (when (eq *site* :nfs.net)
+ (mail-trackback *notification-email* trackback entry)))))
(:view-atom-feed (show-atom-feed))
(:view-comment-feed (show-comment-feed))
(:view-debugging-page (show-debugging-page))
diff --git a/utils.lisp b/utils.lisp
index 877343e..4b09584 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -328,6 +328,27 @@ ELEMENT-TYPE as the stream's."
(spamp comment)
(body-of comment))))
+(defun mail-trackback (address comment entry)
+ (mail address
+ (format nil "[Trackback] ~A" (title-of entry))
+ (format nil "~&Trackback von: ~A~
+ ~&Nummer: ~A~
+ ~&Titel: ~A~
+ ~&Web-Adresse: ~A~
+ ~&IP-Adresse: ~A~
+ ~&Webbrowser: ~A~
+ ~&Als Spam erkannt: ~A~
+ ~&~%~
+ ~&~A"
+ (blog-name-of comment)
+ (id-of comment)
+ (title-of comment)
+ (url-of comment)
+ (submitter-ip comment)
+ (submitter-user-agent comment)
+ (spamp comment)
+ (excerpt-of comment))))
+
(defun revalidate-cache-or-die (content-type)
#+clisp
(when *if-modified-since*