From 6bed4694e00bbfe3ff65dd00ccb45decf1321d57 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 27 Feb 2012 00:00:12 +0100 Subject: New subsite: Book Marx. --- src/mulk/benki/auth.clj | 6 +-- src/mulk/benki/book_marx.clj | 124 +++++++++++++++++++++++++++++++++++++++++++ src/mulk/benki/main.clj | 2 +- src/mulk/benki/util.clj | 8 ++- 4 files changed, 134 insertions(+), 6 deletions(-) create mode 100644 src/mulk/benki/book_marx.clj (limited to 'src') 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 ""}) -- cgit v1.2.3