diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2009-10-08 11:24:55 +0200 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2009-10-08 11:24:55 +0200 |
commit | 55c3f987bd80ca38fa68c9eb08c1448a0329fee7 (patch) | |
tree | 12903cc17034ef3cbd42cb9b5fcf42947ab63b8c /main.lisp | |
parent | 23f65542a32de726c8b605e108094b74c7a3d137 (diff) |
Support the posting of trackbacks.
Ignore-this: 5f2d53c3ba9415a9e66240e7b7711c4b
darcs-hash:6c085435bf95459afcb1ce53a55b058ef5b5a3d7
Diffstat (limited to 'main.lisp')
-rw-r--r-- | main.lisp | 33 |
1 files changed, 33 insertions, 0 deletions
@@ -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)) |