summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2012-02-27 00:00:12 +0100
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2012-02-27 00:00:12 +0100
commit6bed4694e00bbfe3ff65dd00ccb45decf1321d57 (patch)
tree2e1b396a9ee840addac4ae6c5ef633724833939f
parent57b0f4c5bde98ca9c0824c879a449e16b8849be4 (diff)
New subsite: Book Marx.
-rw-r--r--schema.sql21
-rw-r--r--src/mulk/benki/auth.clj6
-rw-r--r--src/mulk/benki/book_marx.clj124
-rw-r--r--src/mulk/benki/main.clj2
-rw-r--r--src/mulk/benki/util.clj8
5 files changed, 155 insertions, 6 deletions
diff --git a/schema.sql b/schema.sql
index b005380..51d487e 100644
--- a/schema.sql
+++ b/schema.sql
@@ -40,5 +40,26 @@ CREATE TABLE wiki_page_revisions(
CHECK (format IN ('mulkwiki', 'html5', 'xhtml5', 'markdown', 'textile', 'muse', 'bbcode'))
);
+
+CREATE TABLE bookmarks(
+ id SERIAL NOT NULL,
+ owner INTEGER,
+ date TIMESTAMP DEFAULT now(),
+ uri VARCHAR NOT NULL,
+ title VARCHAR,
+ description VARCHAR,
+ visibility VARCHAR,
+ PRIMARY KEY(id),
+ FOREIGN KEY(owner) REFERENCES users,
+ CHECK (visibility IN ('private', 'protected', 'public'))
+);
+
+CREATE TABLE bookmark_tags(
+ bookmark INTEGER NOT NULL,
+ tag VARCHAR NOT NULL,
+ PRIMARY KEY(bookmark, tag),
+ FOREIGN KEY(bookmark) REFERENCES bookmarks
+);
+
ROLLBACK;
--COMMIT;
diff --git a/src/mulk/benki/auth.clj b/src/mulk/benki/auth.clj
index e0c730d..93e106e 100644
--- a/src/mulk/benki/auth.clj
+++ b/src/mulk/benki/auth.clj
@@ -18,10 +18,6 @@
(defonce manager (ConsumerManager.))
-(defn redirect [x]
- {:status 302, :headers {"Location" x}, :body ""})
-
-
(defn return-from-openid-provider []
(let [parlist (ParameterList. (:query-params (request/ring-request)))
discovered (session/get :discovered)
@@ -79,6 +75,8 @@
)})
(defpage "/login" []
+ (session/flash-put! (or (session/flash-get)
+ (get-in (request/ring-request) [:headers "Referer"])))
(layout login-page-layout "Benki Login"
[:form {:action (resolve-uri "/login/authenticate"),
:method "GET"
diff --git a/src/mulk/benki/book_marx.clj b/src/mulk/benki/book_marx.clj
new file mode 100644
index 0000000..bf574d4
--- /dev/null
+++ b/src/mulk/benki/book_marx.clj
@@ -0,0 +1,124 @@
+(ns mulk.benki.book_marx
+ (:refer-clojure)
+ (:use [clojure repl]
+ [hiccup core page-helpers]
+ [clojureql predicates]
+ [clojure.core.match :only [match]]
+ noir.core
+ [mulk.benki util db auth])
+ (:require [clojure.algo.monads :as m]
+ [clojure.java.jdbc :as sql]
+ [clojure.string :as string]
+ [clojureql.core :as cq]
+ [noir.request :as request]
+ [noir.session :as session])
+ (:import [org.jsoup.Jsoup]))
+
+(def bookmark_tags (cq/table :bookmark_tags))
+(def bookmarks (cq/table :bookmarks))
+(def tags (cq/table :tags))
+(def users (cq/table :users))
+
+
+(def bookmarx-list-page {})
+(def bookmarx-submission-page {})
+
+(defn restrict-visibility [table user]
+ (if user
+ (cq/select table
+ (cq/where (or (=* :visibility "public")
+ (=* :visibility "protected")
+ (and (=* :visibility "private")
+ (=* :owner user)))))
+ (cq/select table
+ (cq/where (=* :visibility "public")))))
+
+
+(defpage "/marx" {}
+ (let [user (session/get :user)
+ marks (-> bookmarks
+ (cq/join users (=* :bookmarks.owner :users.id))
+ (restrict-visibility (session/get :user))
+ (cq/sort [:date#desc]))]
+ (with-dbt
+ (layout bookmarx-list-page "Book Marx"
+ [:p
+ ;;(.toString marks)
+ [:ul {:class "bookmarx-list"}
+ (for [mark @marks]
+ [:li {:class "bookmark"}
+ [:h2 {:class "bookmark-title"}
+ [:a {:href (:uri mark)}
+ (:title mark)]]
+ [:p {:class "bookmark-date"}
+ (:date mark)]
+ [:p {:class "bookmark-description"}
+ (:description mark)]])]]))))
+
+(defmacro ignore-errors [& body]
+ `(try (do ~@body)
+ (catch java.lang.Exception e#
+ nil)))
+
+(defpage [:get "/marx/submit"] {uri :uri, description :description, origin :origin}
+ (with-auth
+ (let [title (m/domonad m/maybe-m
+ ;; FIXME: Using slurp here is a potential security problem
+ ;; because it permits access to internal resources!
+ [:when uri
+ :when (or (.startsWith uri "http://")
+ (.startsWith uri "https://"))
+ soup (ignore-errors (slurp uri))
+ page (org.jsoup.Jsoup/parse soup)
+ title (.select page "title")]
+ (.text title))
+ origin (or origin (get-in (request/ring-request) [:headers "Referer"]))]
+ (layout bookmarx-submission-page "Submit New Bookmark"
+ [:form {:method "POST"}
+ [:table
+ [:tr [:td "URI: "] [:td [:input {:type "text", :name "uri", :size 100, :value uri}]]]
+ [:tr [:td "Title: "] [:td [:input {:type "text", :name "title", :size 100, :value title}]]]
+ [:tr [:td "Description: "] [:td [:textarea {:name "description", :rows 25, :cols 100}]]]
+ [:tr [:td "Tags: "] [:td [:input {:type "text", :name "tags", :size 100, :id "bookmark-tags-field"}]]]
+ [:tr
+ [:td "Visibility: "]
+ [:td
+ [:input {:type "radio", :name "visibility", :value "private"}
+ "Private"]
+ [:input {:type "radio", :name "visibility", :value "protected",
+ :checked "checked"}
+ "Semi-private"]
+ [:input {:type "radio", :name "visibility", :value "public"}
+ "Public"]]]]
+ [:input {:type "hidden", :name "origin", :value origin}]
+ [:input {:type "submit"}]]))))
+
+(defpage [:post "/marx/submit"] {uri :uri, description :description,
+ title :title, tags :tags, visibility :visibility,
+ origin :origin}
+ (with-auth
+ (let [tagseq (map string/trim (string/split tags #","))
+ user (session/get :user)]
+ (with-dbt
+ (let [bookmark (sql/with-query-results
+ results
+ ["INSERT INTO bookmarks (owner, uri, title, description,
+ visibility)
+ VALUES (?, ?, ?, ?, ?)
+ RETURNING id"
+ user uri title description visibility]
+ (:id (first (into () results))))]
+ (doseq [tag tagseq]
+ (sql/insert-values :bookmark_tags [:bookmark :tag] [bookmark tag]))))))
+ (if (and origin (not= origin ""))
+ (redirect origin)
+ (redirect (link :marx))))
+
+
+;; (defpage "/users/:id/marx" {user :id}
+;; (let [user (session/get :user)
+;; marks (-> bookmarks
+;; (cq/join users (cqp/=* :tags.owner user))
+;; (sort [:date#desc]))]
+;; (with-dbt
+;; @marks)))
diff --git a/src/mulk/benki/main.clj b/src/mulk/benki/main.clj
index 9076104..5367068 100644
--- a/src/mulk/benki/main.clj
+++ b/src/mulk/benki/main.clj
@@ -5,7 +5,7 @@
[hiccup core page-helpers]
[mulk.benki util config])
(:require [noir server options]
- [mulk.benki wiki auth]
+ [mulk.benki wiki auth book_marx]
[ring.middleware.file]
[noir.session :as session]))
diff --git a/src/mulk/benki/util.clj b/src/mulk/benki/util.clj
index 5c7cd97..d61eca4 100644
--- a/src/mulk/benki/util.clj
+++ b/src/mulk/benki/util.clj
@@ -41,7 +41,10 @@
(defn link [& args]
(match [(vec args)]
- [[:wiki title & xs]] (fresolve "/wiki/~a~@[~a~]" title (first xs))))
+ [[:login]] (fresolve "/login")
+ [[:marx]] (fresolve "/marx")
+ [[:wiki title & xs]] (fresolve "/wiki/~a~@[~a~]" title (first xs))
+ ))
(defn call-with-auth [thunk]
(if (session/get :user)
@@ -51,3 +54,6 @@
(defmacro with-auth [& body]
`(call-with-auth (fn [] ~@body)))
+
+(defn redirect [x]
+ {:status 302, :headers {"Location" x}, :body ""})