Rewrite from scratch

LICENSE

@@ -0,0 +1,29 @@
+Rhino
+
+Rhino is copyright Mozilla, released under the GPL 2.0.  See http://www.mozilla.org/rhino/
+
+Javascript libraries
+
+See the files in /public/js for their respective creator and license information.  All Javascript libraries are open source and re-distributed with permission.
+
+Everything else:
+
+Copyright (c) 2009 Brian Carper (http://briancarper.net)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE. 

README

@@ -0,0 +1,67 @@
+# cow-blog
+by [Brian Carper](http://briancarper.net/)
+
+Now featuring thread safety!
+
+This is a complete rewrite of my blog engine written in Clojure using Compojure and Tokyo Cabinet.  Previous versions of this code were terrible and you should not use them.
+
+## Purpose
+
+This is intended as a working proof-of-concept of a simple website using Compojure.  This is a clean rewrite that's close (but not identical) to the code I have been using to run my blog for the past year.
+
+You should **NOT** expect to unpack this code and fire it up and have it work.  This code is meant largely as a learning tool or HOWTO for writing a web app in Clojure.  You should read the code carefully and understand it.  It's only ~700 lines of code and it shouldn't be hard to read through.
+
+Some effort has been made to make this a bit secure but **not much**.  Read and understand (and fix) this code before deploying it publicly.  Use at your own risk.
+
+## Features
+
+* Post tags, categories, comments
+* Markdown
+* Gravatars
+* RSS
+* Add/edit posts via admin interface
+
+## Dependencies
+
+* [Clojure](http://clojure.org/), [clojure-contrib](http://code.google.com/p/clojure-contrib/), [Compojure](http://github.com/weavejester/compojure) (duh).
+
+* [Tokyo Cabinet](http://1978th.net/tokyocabinet/).  You must install the C library (compile it yourself, it's straightforward), then install the Java bindings.  Then you have to tell Java where to find everything via `$CLASSPATH` and possibly `LD_LIBRARY_PATH`.  Follow the [directions](http://1978th.net/tokyocabinet/javadoc/) closely.
+
+* [Rhino javascript engine](http://www.mozilla.org/rhino/).  Download and install it, all you need is `js.jar`.
+
+* JQuery and some JQuery plugins (included in `/public/js`).
+
+* [Showdown](http://attacklab.net/showdown/) JS Markdown library (included in `/deps`); I have slightly edited showdown to include a few extra features and integrate better with my blog.  Vanilla Showdown will likely not work.
+
+## TODO
+
+These features are very simple to implement (like, one or two functions each) but I haven't bothered yet; they will show up in he next version.
+
+* Documentation!
+* Better stylesheet.
+* Editing comments, deleting posts/comments (you can do this from the REPL in the meantime)
+* Spam filtering
+* Archives
+* Tag cloud
+
+## Getting started
+
+Make sure Tokyo Cabinet, Showdown, Compojure, and all of the files in `/blog` are on your $CLASSPATH.
+
+Then edit `blog/config.clj`.  Then run this in a REPL:
+
+    (.start blog.server/blog-server)
+
+Visit http://localhost:8080 in a browser.
+
+A file `posts.db` will be created to store your data.  Start reading `server.clj` to see what's what.
+
+## Bugs
+
+Bugs are a certainty.
+
+For bug reports, feedback, or suggestions, please email me at brian@briancarper.net or open an issue on github.
+
+## LICENSE
+
+See the `LICENSE` file.

blog/admin.clj

@@ -0,0 +1,91 @@
+(ns blog.admin
+  (:use (compojure.html gen form-helpers)
+        (compojure.http session helpers)
+        (clojure.contrib str-utils)
+        (blog layout config db util)))
+
+(defn login-page []
+  {:title "Login"
+   :body [:div
+          [:h2 "Log in"]
+          (form-to [:post "/admin/login"]
+            [:div
+             (label "username" "Username:")
+             (text-field "username")]
+            [:div
+             (label "password" "Password:")
+             (password-field "password")]
+            [:div.submit
+             (submit-button "Log in")])]})
+
+(defn- generate-user [username password]
+  {:username username :password (sha-256 (str PASSWORD-SALT password))})
+
+(defn- validate-user [username password]
+  (= (generate-user username password) ADMIN-USER))
+
+(defn do-login [username password]
+  (if (validate-user username password)
+    [(flash-assoc :message "Logged in OK.")
+     (session-assoc :username username)
+     (redirect-to "/")]
+    [(flash-assoc :error "Login failed.")
+     (redirect-to "/admin/login")]))
+
+(defn do-logout []
+  [(session-dissoc :username)
+   (redirect-to "/")])
+
+(defn- post-form
+  ([target] (post-form target {}))
+  ([target post]
+     [:div.add-post.markdown
+      [:p "Leave nothing blank!"]
+      [:p "Tags should be comma-separated."]
+      (form-to [:post target]
+        (form-row text-field "title" "Title" (:title post))
+        (form-row text-field "id" "ID" (:id post))
+        (form-row text-field "category" "Category" (:title (:category post)))
+        (form-row text-field "tags" "Tags" (str-join #", " (map :title (:tags post))))
+        (form-row text-area "markdown" "Body" (:markdown post))
+        (submit-row "Submit"))
+      (preview-div)]))
+
+(defn add-post-page []
+  {:title "Add Post"
+   :body (post-form "/admin/do-add-post")})
+
+(defn- validate* [arg]
+  `(when (empty? ~arg)
+     (die "You left '" (str '~arg) "' blank.  Try again.")))
+
+(defmacro validate [& args]
+  `(do ~@(map validate* args)))
+
+(defn- post-from-params [ip id title category tags markdown]
+  (validate ip id title category tags markdown)
+  {:id id
+   :title title
+   :markdown markdown
+   :ip ip
+   :category (make-category {:title category})
+   :tags (map #(make-tag {:title %})
+              (re-split  #"\s*,\s*" tags))})
+
+(defn do-add-post [& args]
+  (add-post (apply post-from-params args))
+  [(flash-assoc :message "Post added.")
+   (redirect-to "/")])
+
+(defn edit-post-page [id]
+  (if-let [post (get-post id)]
+    {:title "Edit Post"
+     :body (post-form (str "/admin/do-edit-post/" id) post)}
+    [(flash-assoc :error "Post not found.")
+     (redirect-to "/")]))
+
+(defn do-edit-post [old-id & args]
+  (edit-post old-id (apply post-from-params args))
+  [(flash-assoc :message "Post edited.")
+   (redirect-to "/")])
+

blog/config.clj

@@ -0,0 +1,18 @@
+(ns blog.config)
+
+(def SITE-TITLE "A Clojure Blog (\u03bb)")
+(def SITE-URL "http://localhost:8080")
+(def SITE-DESCRIPTION "Some guy's blog about Clojure.")
+
+(def PUBLIC-DIR "public")  ;;CS/JS/images live here.  Relative path.
+
+;; For now, only a single admin user can exist, and this is where the login details live.
+;; use blog.admin/generate-user to generate a new user and then put it here.
+;; Below:
+;;   username = foo
+;;   password = bar
+(def ADMIN-USER {:username "foo"
+                 :password "4bdec02a2dd5e6b6e28935bccf9bf4e7e5becce96b7845bee692768f4e4a810"})
+
+;; Change this.
+(def PASSWORD-SALT "K@#$J@$#(FJ@#!$M@#n1NELKDwdjf9wef123krJ@!FKnjef2i#JR@R")

blog/db.clj

@@ -0,0 +1,114 @@
+(ns blog.db
+  (:use (clojure.contrib def str-utils)
+        (blog util tokyocabinet markdown)))
+
+(defonce posts (make-dataref "posts.db"))
+
+(defn- uuid []
+  (str (java.util.UUID/randomUUID)))
+
+(defn title-to-id [s]
+  (when s
+   (->> s
+       (re-gsub #"\s" "-")
+       (re-gsub #"[^-A-Za-z0-9_]" "")
+       .toLowerCase)))
+
+(defn- with-type [type x]
+  (with-meta x {:type type}))
+
+(defn- valid-id? [id]
+  (re-matches #"^[-A-Za-z0-9_]+$" id))
+
+(defn make-post [post]
+  (if (and (valid-id? (post :id))
+           (not (empty? (post :markdown))))
+    (with-type :post
+      (assoc post
+        :date (or (post :date) (now))
+        :html (markdown-to-html (post :markdown) false)))
+    (die "Invalid post data.  You left something blank:  " post)))
+
+(defn make-comment [post c]
+  (with-type :comment
+    (assoc c
+      :id (uuid)
+      :post-id (post :id)
+      :date (or (c :date) (now))
+      :html (markdown-to-html (:markdown c) true))))
+
+(defn make-category [cat]
+  (when cat
+   (with-type :category
+     (assoc cat
+       :id (title-to-id (:title cat))))))
+
+(defn make-tag [tag]
+  (when tag
+   (with-type :tag
+     (assoc tag
+       :id (title-to-id (:title tag))))))
+
+(defn all-posts []
+  (reverse (sort-by :date (vals @posts))))
+
+(defn get-post [id]
+  (posts id))
+
+(defn- store-post [post]
+  (dosync (alter posts assoc (post :id) (make-post post))))
+
+(defn add-post [post]
+  (when (get-post (:id post))
+    (die "A post with that ID already exists."))
+  (store-post post))
+
+(defn remove-post [id]
+  (dosync (alter posts dissoc id)))
+
+(defn edit-post [old-id post]
+  (dosync
+   (when (not= old-id (:id post))
+     (remove-post old-id))
+   (store-post post)))
+
+(defn all-categories []
+  (sort-by :name
+           (set (filter identity
+                        (map :category (all-posts))))))
+
+(defn get-category [cat]
+  (first (filter #(= (:id %) cat)
+                 (all-categories))))
+
+(defn all-tags []
+  (sort-by :name
+           (set (filter identity
+                        (mapcat :tags (all-posts))))))
+
+(defn get-tag [tag]
+  (first (filter #(= (:id %) tag)
+                 (all-tags))))
+
+(defn all-posts-with-category [category]
+  (filter #(= (:category %) category)
+          (all-posts)))
+
+(defn all-posts-with-tag [tag]
+  (filter #(some #{tag} (:tags %))
+          (all-posts)))
+
+(defn get-comments [post]
+  (sort-by :date (post :comments)))
+
+(defn add-comment [post comment]
+  (dosync
+   (let [id (:id post)
+         post-in-ref (get-post id)]
+    (alter posts assoc id
+           (assoc post-in-ref :comments
+                  (conj (:comments post-in-ref)
+                        (make-comment post comment)))))))
+
+(defn db-watcher-status []
+  (agent-errors (:watcher ^posts)))