resolve site.clj conflict

5 files changed, 1762 insertions, 1464 deletions

diff --git a/scripts/cronic b/scripts/cronic
new file mode 100755
index 0000000..80f1cad
--- /dev/null
+++ b/scripts/cronic
@@ -0,0 +1,54 @@
+#!/bin/bash
+
+# Cronic v2 - cron job report wrapper
+# Copyright 2007 Chuck Houpt. No rights reserved, whatsoever.
+# Public Domain CC0: http://creativecommons.org/publicdomain/zero/1.0/
+
+set -eu
+
+OUT=/tmp/cronic.out.$$
+ERR=/tmp/cronic.err.$$
+TRACE=/tmp/cronic.trace.$$
+LOGDIR=/var/log/cronic
+
+set +e
+"$@" >$OUT 2>$TRACE
+RESULT=$?
+set -e
+
+PATTERN="^${PS4:0:1}\\+${PS4:1}"
+if grep -aq "$PATTERN" $TRACE
+then
+    ! grep -av "$PATTERN" $TRACE > $ERR
+else
+    ERR=$TRACE
+fi
+
+if [ $RESULT -ne 0 -o -s "$ERR" ]
+    then
+    echo "Cronic detected failure or error output for the command:"
+    echo "$@"
+    echo
+    echo "RESULT CODE: $RESULT"
+    echo
+    echo "ERROR OUTPUT:"
+    cat "$ERR"
+    echo
+    echo "STANDARD OUTPUT:"
+    cat "$OUT"
+    if [ $TRACE != $ERR ]
+    then
+        echo
+        echo "TRACE-ERROR OUTPUT:"
+        cat "$TRACE"
+    fi
+fi
+
+# sbostler: write log for all job runs
+SCRIPT=$(basename $1)
+OUTLOG=$(date +"$LOGDIR/$SCRIPT.%Y-%m-%d__%T.log")
+cat "$OUT" > $OUTLOG
+
+rm -f "$OUT"
+rm -f "$ERR"
+rm -f "$TRACE"
diff --git a/scripts/dailyimgupload.py b/scripts/dailyimgupload.py
new file mode 100644
index 0000000..186614d
--- /dev/null
+++ b/scripts/dailyimgupload.py
@@ -0,0 +1,157 @@
+import ctypes

+import datetime

+import os

+import platform

+import shutil

+import sys

+import traceback

+import s3upload

+

+

+def freespace(p):

+     """

+     FROM: http://atlee.ca/blog/2008/02/23/getting-free-diskspace-in-python/

+           http://stackoverflow.com/questions/51658/cross-platform-space-remaining-on-volume-using-python

+     Returns the number of free bytes on the drive that ``p`` is on

+     """

+     if platform.system() == 'Windows':

+         free_bytes = ctypes.c_ulonglong(0)

+         ctypes.windll.kernel32.GetDiskFreeSpaceExW(ctypes.c_wchar_p(p), None, None, ctypes.pointer(free_bytes))

+         return free_bytes.value

+     else:

+         s = os.statvfs(p)

+         return s.f_bsize * s.f_bavail

+

+def directory_size(path):

+    """

+    FROM: http://stackoverflow.com/questions/1392413/calculating-a-directory-size-using-python

+    """

+    total_size = 0.0

+    for dirpath, dirnames, filenames in os.walk(path):

+        for f in filenames:

+            fp = os.path.join(dirpath, f)

+            total_size += os.path.getsize(fp)

+    return total_size

+

+def parse_date_dir(d, date_fmt):

+    if not os.path.exists(d):

+        raise ValueError('%s does not exist' % d)

+    if not os.path.isdir(d):

+        raise ValueError('%s is not a directory' % d)

+    return datetime.datetime.strptime(os.path.basename(d), date_fmt)

+

+def is_date_dir(d, date_fmt):

+    try:

+        parse_date_dir(d, date_fmt)

+        return True

+    except ValueError:

+        return False

+

+def get_directory_list(path, date_fmt='%Y%m%d'):

+    parse_func = lambda d: parse_date_dir(d, date_fmt)

+    subdirs = [os.path.join(path, child) for child in os.listdir(path)]

+    datedirs = [d for d in subdirs if is_date_dir(d, date_fmt)]

+    return sorted(datedirs, key=parse_func)

+    

+

+def upload_dirs_until_free(path, target_free_mbs, dryrun):

+    starting_freespace = float(freespace(path))

+    dirs_uploaded = 0

+    files_uploaded = 0

+    cur_freespace = starting_freespace

+    reclaimed_space = 0.0

+    error = False

+    directory_list = get_directory_list(path)

+

+    if not directory_list:

+        print "Target directory %s has no subdirectories!" % path

+        sys.exit(1)

+

+    print "Target directory: %s" % path

+    print "Starting freespace: %.02f MBs" % (starting_freespace / 1024 / 1024)

+    print "Target freespace: %.02f MBs"  % target_free_mbs

+    print "Image subdirectories: %s" % len(directory_list)

+

+    if dryrun:

+        print

+        print '!!! Doing dryrun -- current free space will be estimated !!!'

+

+    print

+    try:

+        for dir_to_upload in directory_list:

+            if cur_freespace >= target_free_mbs * 1024 * 1024:

+                break

+        

+            dir_size = directory_size(dir_to_upload)

+            print 'Uploading %s (%.02f MBs)' % (dir_to_upload, dir_size / 1024 / 1024)

+

+            res = s3upload.do_upload(dir_to_upload, verbose=False, dryrun=dryrun)

+            files_uploaded += res['files_uploaded']

+            print "%s files uploaded in %.02fs" % (res['files_uploaded'], res['sec_elapsed'])

+

+            dirs_uploaded += 1

+            reclaimed_space += dir_size

+

+            if not dryrun:

+                print "Deleting %s" % dir_to_upload

+                shutil.rmtree(dir_to_upload)

+                

+            if dryrun:

+                cur_freespace += dir_size 

+            else:

+                cur_freespace = float(freespace(path))

+            print "%.02f MBs now free" % (cur_freespace / 1024 / 1024)

+            print

+

+    except Exception:

+        print "An unexpected error occured!"

+        error = True

+        traceback.print_exc()

+

+    print "---------------------------------------"

+    if error:

+        pass

+    else:

+        pass

+    print "Finished successfully" if not error else "!!! Terminated abnormally !!!"

+    print "Current free space: %.02f MBs" % (cur_freespace / 1024 / 1024)

+    print "Reclaimed space: %.02f MBs" % (reclaimed_space / 1024 / 1024)

+    print "Directories uploaded: %s" % dirs_uploaded

+    print "Files uploaded: %s" % files_uploaded

+

+

+if __name__ == '__main__':

+    if not 4 <= len(sys.argv) <= 5:

+        print "usage: dailyimgupload.py workingdir path megabytes [dryrun]"

+        sys.exit(1)

+

+    wd = sys.argv[1]

+    if not os.path.isdir(wd):

+        print "Invalid working directory: %s" % wd

+        sys.exit(1)

+    print "Switching working directory to %s" % wd

+    os.chdir(wd)

+

+    path = sys.argv[2]

+    if not os.path.isdir(path):

+        print "invalid image directory: %s" % path

+        sys.exit(1)

+

+    mbs = sys.argv[3]

+    try:

+        target_free_mbs = float(mbs)

+    except ValueError:

+        print "invalid number of megabytes: %s" % mbs

+        sys.exit(1)

+

+    if len(sys.argv) == 5:

+        dryrun = sys.argv[4]

+        if dryrun in ('true', 'false'):

+            dryrun = dryrun == 'true'

+        else:

+            print "invalid dry run argument: %s (must be either 'true' or 'false')" % dryrun

+            sys.exit(1)

+    else:

+        dryrun = True

+

+    upload_dirs_until_free(path, target_free_mbs, dryrun)

diff --git a/scripts/s3upload.py b/scripts/s3upload.py
index 724561c..e761ea5 100644
--- a/scripts/s3upload.py
+++ b/scripts/s3upload.py
@@ -9,19 +9,28 @@ CONN = None
 AWS_ACCESS_KEY_ID = 'AKIAIOP42NFKLLJXEGJQ'
 AWS_SECRET_ACCESS_KEY = '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'
 BUCKET_NAME = 'dumpfm'
-COUNTER = 0
+
+def get_or_initialize_aws_connection():
+    global CONN
+    if not CONN:
+        print "Initializing AWS connection with ID %s, bucket %s" % (AWS_ACCESS_KEY_ID,
+                                                                     BUCKET_NAME)
+        CONN = S3.AWSAuthConnection(AWS_ACCESS_KEY_ID, AWS_SECRET_ACCESS_KEY)
+    return CONN
+        
 
 def retry_func(f, count):
     try:
         f()
+    except KeyboardInterrupt:
+        raise
     except:
         if count <= 1: raise
         else:
             print 'Error! retrying %s more time(s)' % (count - 1)
             retry_func(f, count - 1)
 
-def upload_file(path):
-    global COUNTER
+def upload_file(path, verbose=True, dryrun=False):
     path = os.path.normpath(path)
     if path == '.' or not os.path.isfile(path):
         return
@@ -34,35 +43,44 @@ def upload_file(path):
     path = path.replace('\\', '/') # Windows hack
     start = time.time()
     def do_upload():
-        CONN.put(BUCKET_NAME, path, S3.S3Object(filedata),
+        conn = get_or_initialize_aws_connection()
+        conn.put(BUCKET_NAME, path, S3.S3Object(filedata),
                  {'x-amz-acl': 'public-read', 'Content-Type': content_type})
-    retry_func(do_upload, 3)
+
+    if not dryrun:
+        retry_func(do_upload, 3)
     
     ms_took = (time.time() - start) * 1000
-    print "uploaded %s   (%0.0fms)   (%sKB)" % (path, ms_took, size / 1024)
-    COUNTER += 1
+    if verbose:
+        print "uploaded %s   (%0.0fms)   (%sKB)" % (path, ms_took, size / 1024)
+    return 1
 
-def upload_directory(path):
+def upload_directory(path, verbose=True, dryrun=False):
+    counter = 0
     for f in sorted(os.listdir(path)):
         subpath = os.path.join(path, f)
         if os.path.isdir(subpath):
-            upload_directory(subpath)
+            counter += upload_directory(subpath, verbose=verbose, dryrun=dryrun)
         else:
-            upload_file(subpath)
+            counter += upload_file(subpath, verbose=verbose, dryrun=dryrun)
+    return counter
 
-def do_upload(path):
-    global CONN
-    CONN = S3.AWSAuthConnection(AWS_ACCESS_KEY_ID, AWS_SECRET_ACCESS_KEY)
+def do_upload(path, verbose=True, dryrun=False):
+    counter = 0
 
     start = time.time()
 
     if os.path.isdir(path):
-        upload_directory(path)
+        counter += upload_directory(path, verbose=verbose, dryrun=dryrun)
     else:
-        upload_file(path)
+        counter += upload_file(path, verbose=verbose, dryrun=dryrun)
 
     s_took = (time.time() - start)
-    print "uploaded %s files in %0.0fs" % (COUNTER, s_took)
+
+    if verbose:
+        print "uploaded %s files in %0.0fs" % (counter, s_took)
+    return { 'sec_elapsed': s_took,
+             'files_uploaded': counter }
 
 
 if __name__ == "__main__":
diff --git a/src/site.clj b/src/site.clj
index 6f97c81..161f0d5 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -1,1445 +1,1511 @@
-(ns pichat

-  (:import java.lang.System

-           java.text.SimpleDateFormat

-           java.util.Date

-           java.io.File

-           javax.imageio.ImageIO

-           javax.servlet.http.Cookie

-	   org.antlr.stringtemplate.StringTemplateGroup)

-  (:use clojure.xml

-        clojure.contrib.command-line

-        clojure.contrib.duck-streams

-        clojure.contrib.json.write

-        clojure.contrib.seq-utils

-        clojure.contrib.sql

-        clojure.contrib.str-utils

-        clojure.contrib.def

-        clojure.contrib.pprint

-        config

-        admin

-        compojure

-        email

-        fame

-        utils

-        cookie-login

-        session-sweeper

-        feed

-        rooms

-        tags

-        scheduled-agent

-        user)

-  (:require redis))

-

-; Create image directories if they don't exist.

-(.mkdir (new File *image-directory*))

-(.mkdir (new File *avatar-directory*))

-

-

-;; Logging

-

-; is there a better way to do this or am i insane for introducing state? just wanna do

-; (let [log (debug-log)]

-;   (log "something")

-;   (log "something else")

-;   (log)) ; gets log array for output to template

-(defn make-debug-logger

-  ([] (make-debug-logger (new java.util.ArrayList)))

-  ([log]

-    (fn

-      ([] (to-array log))

-      ([s] (make-debug-logger (.add log s))))))

-

-(defn make-time-logger

-  ([] (make-time-logger (new java.util.ArrayList)))

-  ([log]

-    (fn

-      ([] (to-array log));

-            ([f & args]

-        (let [start (.getTime (new Date))

-             ret (apply f args)

-              log-string (str f ": " (- (.getTime (new Date)) start) " msecs" )]

-              (.add log log-string)

-              ret)))))

-

-;; Output

-

-(defn strip-empty-vals [m]

-  (into {} (filter (fn [[k v]] (non-empty-string? v)) m)))

-

-(defn process-message-for-json [d]

-  (assoc d :created_on (.getTime (d :created_on))))

-

-(defn message-room-link [m]

-  (if (= (:key m) "dumpfm")

-    "http://dump.fm/chat"

-    (format "http://%s.dump.fm" (:key m))))

-

-(defn process-message-for-output [d]

-  (escape-html-deep 

-   (strip-empty-vals

-    (if (contains? d :created_on)

-      (assoc d

-        :created_on (format-timestamp (d :created_on))

-        :roomlink (message-room-link d))

-      d))))

-

-(defn new-messages [room ts]

-  (reverse (take-while #(.after (% :created_on) ts) 

-                       @(room :messages))))

-

-(defn new-favs [nick ts]

-  (filter #(.after (:added %) ts)

-          (get @fav-map nick [])))

-

-(defn process-user [u]

-  (stringify-and-escape (strip-empty-vals u)))

-

-(defn process-directory-listing [d]

-  (stringify-and-escape

-   (strip-empty-vals d)))

-

-(defn prepare-user-list [room sort?]

-  (let [users (vals @(room :users))]

-    (map process-user (if sort?

-			(sort-by (fn [u] (.toLowerCase (:nick u))) users)

-			users))))

-

-(defn updates [nick room ts]

-  {"users"    (prepare-user-list room false) ; Sorting is done on client

-   "messages" (map process-message-for-json

-                   (new-messages room ts))

-   "favs"     (new-favs nick ts)})

-

-

-(defn fetch-public-message-by-id [m-id]

-  (let [msg (tags/fetch-dump-by-id m-id)]

-    (if (and msg (not (:admin_only msg)))

-      msg)))

-

-;;  User-id/nick cache

-;;  I keep needing to grab user-id from a nick so I thought I'd cache them

-;;  @timb: I just duplicated this in the user-info map :(

-;;         we should reconcile our user caches

-(def user-id-cache (ref {}))

-(def *user-id-cache-size* 500)

-

-(defn user-id-from-nick [nick]

-  (let [nick (lower-case nick)

-        found (@user-id-cache nick)]

-    (if found

-      found

-      (let [query (str "SELECT user_id FROM users WHERE lower(nick) = ?")

-            res (first (do-select [query nick]))]

-        (if (nil? res)

-          nil

-          (let [found (res :user_id)]

-            (dosync

-              (if (> (count @user-id-cache) *user-id-cache-size*) (ref-set user-id-cache {}))

-                (alter user-id-cache assoc nick found))

-            found))))))

-

-;; Login code

-

-(defn session-map-from-db

-  [user-info]

-  {:user_id  (user-info :user_id)

-   :nick     (user-info :nick)

-   :is_admin (user-info :is_admin)

-   :avatar   (user-info :avatar)})

-

-(defn session-assoc-from-db

-  [user-info]

-  (session-assoc

-   :user_id        (user-info :user_id)

-   :nick           (user-info :nick)

-   :email          (user-info :email)

-   :is_admin       (user-info :is_admin)

-   :avatar         (user-info :avatar)

-   :password_login true))

-

-;; login-token functions

-

-(defn logged-in?

-  "Test whether user is logged in by presence of nick key in session.

-   (Apply to request map)"

-  [{session :session}]

-  (contains? session :nick))

-

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-; Login-token version history

-;

-; v0: Format: nick%expiry%token-hash

-;     Date:   Mists of dump antiquity

-;

-; v1: Format: v1%nick%expiry%token-hash

-;     Date:   2010/04/24

-;     Note:   Contains same information as v0, but created under the

-;             wildcard domain (i.e. ".dump.fm") so that logins work

-;             across all subdomains.

-

-(defn encode-login-token [nick hash expiry]

-  (let [token-hash (sha1-hash hash expiry)]

-    (str "v1%" nick "%" expiry "%" token-hash)))

-

-(defn- parse-login-vec [v]

-  (try [(aget v 1) (Long/parseLong (aget v 2)) (aget v 3)]

-       (catch NumberFormatException _ nil)))

-

-(defn parse-login-token [token]

-  ; If users have multiple login-cookies across different domains

-  ; (i.e. both "dump.fm" and ".dump.fm"), token will be a vector

-  ; instead of a string.

-  (if (not (string? token))

-    (some identity (map parse-login-token token))

-    (let [v  (.split token "\\%")]

-      (if (and (= (alength v) 4) (= (aget v 0) "v1"))

-        (parse-login-vec v)))))

-

-(defn read-login-token [token]

-  (if-let [[nick expiry token-hash]  (parse-login-token token)]

-    (if (>= expiry (System/currentTimeMillis))

-      (let [db-info (fetch-nick nick)

-            computed-hash (sha1-hash (db-info :hash) expiry)]

-        (if (= token-hash computed-hash)

-          (select-keys db-info [:user_id :nick :email :is_admin :avatar]))))))

-

-(defn make-login-token

-  [{nick :nick hash :hash}]

-  (let [expiration (ms-in-future *login-token-expiry*)

-        token      (encode-login-token nick hash expiration)]

-    (set-cookie *login-token-key* token

-                :expires (gmt-string (new Date expiration))

-                :domain *cookie-domain*)))

-

-;; Landing

-

-(defn landing [session]

-  (redirect-to "/chat"))

-

-(defn log-login [user_id ip]

-  ;; i'm using do-cmds here because update-values can't deal with stuff like 'last_login = now()'

-  (let [query (format "UPDATE users SET last_ip = '%s'::cidr, last_login = now() WHERE user_id = %s" (str ip) (str user_id))]

-    (do-cmds query))

-)

-

-(defn login [session params cookies request]

-  (let [nick         (or (params :nick) "")

-        hash         (or (params :hash) "")

-        remember-me  (= (params :rememberme) "yes")

-        db-user      (authorize-nick-hash nick hash)

-        login-cookie (if remember-me

-                       (make-login-token db-user)

-                       (clear-login-token *login-token-key*))

-        ip           (get-ip request)]

-      (if db-user

-        (do

-           (log-login (db-user :user_id) ip)

-          [(session-assoc-from-db db-user)

-           login-cookie

-           (resp-success "OK")]

-      )

-      (resp-error "BAD_LOGIN"))))

-

-(defn logout [session]

-  [(session-dissoc :nick :user_id :is_admin :avatar)

-   (set-cookie *login-token-key* "dummy"

-               :expires "Thu, 01-Jan-1970 00:00:01 GMT"

-               :domain *cookie-domain*)

-   (redirect-to "http://dump.fm/")])

-

-;; Registration

-

-(def muted-ips-query "

-SELECT DISTINCT

-       last_ip

-FROM   users

-WHERE  user_id IN

-    (SELECT user_id FROM mutes

-     WHERE  (set_on + duration) > now()

-     AND    NOT cancelled)")

-

-(defn get-ip-str [db-ip]

-  (first (.split (.getValue db-ip) "/")))

-  

-

-(defn ip-recently-muted? [ip]

-  (let [muted-ips   (set (map (comp get-ip-str :last_ip)

-                              (do-select [muted-ips-query])))]

-    (contains? muted-ips ip)))

-

-(def *reserved-nicks-path* "docs/reserved_nicks.txt")

-(def *reserved-nicks-refresh-period-sec* 300)

-

-(defn load-invalid-nicks []

-  (set (read-lines *reserved-nicks-path*)))

-

-(def reserved-nicks

-     (scheduled-agent load-invalid-nicks

-                      *reserved-nicks-refresh-period-sec*

-                      (load-invalid-nicks)))

-

-(defn nick-reserved? [nick]

-  (let [query "SELECT * FROM users WHERE LOWER(nick) = ? LIMIT 1"]

-    (or (contains? (poll reserved-nicks) nick)

-        (> (count (do-select [query (lower-case nick)])) 0))))

-

-(defn register [session params request]

-  (let [nick                (or (params :nick) "")

-        email               (or (params :email) "")

-        hash                (or (params :hash) "")

-        ip                  (get-ip request)

-        invalid-nick-reason (is-invalid-nick? nick)]

-    (cond invalid-nick-reason     (resp-error invalid-nick-reason)

-	  (nick-reserved? nick)   (resp-error "NICK_TAKEN")

-          (ip-recently-muted? ip) (resp-error "RECENTLY_MUTED")

-	  :else (do

-                  (do-insert :users

-                             [:nick :hash :email]

-                             [nick hash email])

-                  (let [db-user (fetch-nick nick)

-                        user_id (db-user :user_id)

-                        query   (format "UPDATE users SET created_ip = '%s'::cidr WHERE user_id = %s" (str ip) (str user_id))]

-                    (try (send-registration-email nick email)

-                         (catch Exception e nil))

-                    (do-cmds query) ; timb: doing this update query rather than using previous insert because jdbc 

-                                    ; can't figure out how to convert to cidr on prepared statements

-		                [(session-assoc-from-db db-user)

-		                 (resp-success "OK")])))))

-

-;; Fav scores

-

-(def *score-query* "

-SELECT u.user_id,

-       u.nick,

-       COUNT(*) AS cnt

-FROM   tags t,

-       messages m,

-       users u

-WHERE  t.message_id = m.message_id

-       AND m.user_id != t.user_id

-       AND m.user_id = u.user_id

-GROUP  BY u.user_id, u.nick

-ORDER BY cnt DESC

-")

-

-(defn build-score-list []

-  (let [res (vec (do-select [*score-query*]))]

-    {:list res

-     :map  (zipmap (map :nick res) (map :cnt res))}))

-

-(def *scores-refresh-period-sec* (* 29 60))

-

-(def *user-scores*

-     (scheduled-agent build-score-list

-                      *scores-refresh-period-sec*

-                      []))

-

-(def *piece-map*

-     (zipmap

-      [:pawn :knight :bishop :rook :queen :king :skull]

-      ["&#9823;" "&#9822;" "&#9821;" "&#9820;" "&#9819;" "&#9818;" "&#9760;"]))

-

-(defn score-to-piece [score]

-  (cond (= score -1)   :skull 

-        (= score 0)    :pawn

-        (< score 50)   :knight

-        (< score 150)  :bishop

-        (< score 300)  :rook

-        (< score 1000) :queen

-        :else :king))

-

-(def score-to-entity (comp *piece-map* score-to-piece))

-

-(defn lookup-score [nick]

-  (if (= (lower-case nick) "scottbot")

-    -1

-    (let [scores (:map (poll *user-scores*))]

-      (get scores nick 0))))

-

-(defn get-user-ranking [offset num]

-  (if-let [ranking  (:list (poll *user-scores*))]

-    (let [cnt       (count ranking)]

-      (subvec ranking

-              (min cnt (* offset num))

-              (min cnt (* (inc offset) num))))))

-

-

-;; Profile

-

-(defn pull-random-dump-images [dumps num]

-  (take num

-        (shuffle

-         (set (apply concat

-                     (map

-                      (comp take-images :content)

-                      dumps))))))

-

-(defn profile

-  ([session profile-nick] (profile session profile-nick "profile"))

-  ([session profile-nick template]

-     (if-let [user-info (fetch-nick profile-nick)]

-       (let [st            (fetch-template template session)

-             profile-nick  (:nick user-info) ; Update to get right casing

-             nick          (session :nick)

-             logger        (make-time-logger)

-             is-home       (and nick (= nick profile-nick))

-             score         (lookup-score profile-nick)

-	     dumps         (logger tags/fetch-dumps

-                                   :user-tag-id (:user_id session)

-				   :nick profile-nick

-				   :limit 10)

-             imgs          (pull-random-dump-images dumps 5)]

-         (do

-           (.setAttribute st "is_home" is-home)

-           (doseq [a [:nick :avatar :contact :bio]]

-	     (let [v (user-info a)]

-	       (.setAttribute st (name a)

-			      (if (non-empty-string? v) (escape-html v)))))

-	   (.setAttribute st "score" (comma-format score))

-	   (.setAttribute st "score_ent" (score-to-entity score))

-           (if (not (empty? imgs))

-	     (.setAttribute st "imgs" imgs))

-	   (.setAttribute st "debug_log_items" (logger))

-	   (.toString st)))

-       (resp-error "NO_USER"))))

-

-(defn update-user-db [user-id attr val]

-  (with-connection *db*

-    (update-values "users" ["user_id = ?" user-id] {attr val})))

-

-(defn update-avatar [session url] 

-  (update-user-db (session :user_id) "avatar" url)

-  [(session-assoc :avatar url)

-   (resp-success url)])

-

-(defn update-profile [session params]

-  (let [user-id (session :user_id)

-        attr (params :attr)

-        val (params :val)

-        attr-set #{"avatar" "contact" "bio"}]

-    (cond (not user-id)                   (resp-error "MUST_LOGIN")

-          (not (and user-id attr val))    (resp-error "BAD_REQUEST")

-          (not (contains? attr-set attr)) (resp-error "BAD_REQUEST")

-          (= attr "avatar")               (update-avatar session val)

-          :else (do (update-user-db user-id attr val)

-                    (resp-success "OK")))))

-

-;; Generic Handler

-

-(defn generic-profile-handler [session nick date msg-id

-                               func redirecter unknown]

-  (if-let [user-info (fetch-nick nick)]

-    ;; If a valid msg-id is provided, the date is ignored.

-    ;; This makes urls such as /user/bogus/5 valid.

-    (cond msg-id (if-let [msg-id (maybe-parse-int msg-id)]

-                   (func session user-info nil msg-id)

-                   (redirecter user-info))

-          ;; If an invalid date is provided, we redirect to the user's first favs page.

-          date   (if-let [date (parse-yyyy-mm-dd-date date)]

-                   (func session user-info date nil)

-                   (redirecter user-info))

-          :else (func session user-info nil nil))

-    (unknown)))

-

-;; User log

-

-(defn build-mini-profile [user-info]

-  (let [st    (fetch-template-fragment "mini_profile")

-        nick  (user-info :nick)

-        score (lookup-score nick)]

-    (doseq [a [:nick :avatar :contact :bio]]

-      (let [v (user-info a)]

-        (.setAttribute st (name a)

-                       (if (non-empty-string? v) (escape-html v)))))

-    (doto st

-      (.setAttribute "score" (comma-format score))

-      (.setAttribute "score_ent" (score-to-entity score))

-      (.toString))))

-

-;; The next-page link is generated by retrieving one additional dump,

-;; and creating a link from its date and message id.

-(defn log-next-page-link [last-msg]

-  (format "/%s/%s/%s"

-          (:nick last-msg)

-          (format-yyyy-mm-dd (:created_on last-msg))

-          (:message_id last-msg)))

-

-(defn user-log [session user-info date msg-id]

-  (let [st            (fetch-template "userlog" session)

-        logger        (make-time-logger)

-        raw-dumps     (tags/fetch-dumps

-                       :nick (:nick user-info)

-                       :user-tag-id (:user_id session)

-                       :msg-id msg-id

-                       :date (if msg-id nil date)

-                       :limit (inc *dumps-per-page*))

-        back-dumps    (if (or date msg-id)

-                        (tags/fetch-dumps

-                         :nick (:nick user-info)

-                         :msg-id msg-id

-                         :date (if msg-id nil date)

-                         :limit (inc *dumps-per-page*)

-                         :direction :forward))

-        dumps         (map process-message-for-output (take *dumps-per-page* raw-dumps))]

-    (.setAttribute st "nick" (:nick user-info))

-    (.setAttribute st "is_home" (= (:nick user-info) (:nick session)))

-    (.setAttribute st "mini_profile" (build-mini-profile user-info))

-    (if (> (count dumps) 0)

-      (.setAttribute st "dumps" dumps))

-    (.setAttribute st "prev"

-                   (if back-dumps

-                     (cond

-                      (> (count back-dumps) *dumps-per-page*) (log-next-page-link (last back-dumps))

-                      (> (count back-dumps) 1) (format "/%s/log" (:nick user-info))

-                      :else nil)))

-    (if (> (count raw-dumps) *dumps-per-page*)

-      (.setAttribute st "next" (log-next-page-link (last raw-dumps))))

-    (.setAttribute st "debug_log_items" (logger))

-    (.toString st)))

-

-(defn user-log-handler [session nick date msg-id]

-  (generic-profile-handler session nick date msg-id

-                           user-log

-                           (fn [u] (redirect-to (str "/" (:nick u))))

-                           #(resp-error "NO_USER")))

-

-;; Who faved me

-

-(def popular-dumps-qry "

-select u.nick, u.avatar, r.key, m.message_id, m.content, m.created_on, count(*) as count,

-               array_agg(u2.nick) as user_nicks,

-               array_agg(u2.avatar) as user_avs,

-               array_agg(t.created_on) as favtime,

-               (select exists (select 1 from tags

-                        where tag = 'favorite' and user_id = ? and message_id = m.message_id)) as favorited

-from users u, messages m, rooms r, tags t, users u2

-where lower(u.nick) = lower(?)

-and u.user_id = m.user_id and m.message_id = t.message_id

-and m.room_id = r.room_id and m.is_image = true and r.admin_only = false

-and t.tag = 'favorite' and t.user_id != u.user_id

-and t.user_id = u2.user_id

-group by u.nick, u.avatar, r.key, m.message_id, m.content, m.created_on

-order by count desc limit ? offset ?")

-

-(def num-popular-dumps 40)

-

-(defn get-popular-dumps [nick user-id]

-  (for [d (do-select [popular-dumps-qry user-id nick 40 0])]

-    (let [fav-nicks (.getArray (:user_nicks d))]

-      (assoc d

-	:favers (sort-by :t (comp #(* -1 %) compare)

-			 (map (fn [n a t] (if (non-empty-string? a)

-					    {:nick n :avatar a :t t}

-					    {:nick n :t t}))

-			      fav-nicks

-			      (.getArray (:user_avs d))

-			      (.getArray (:favtime d))))

-	:user_nicks nil :user_avs nil :favtime nil))))

-

-(defn popular [session profile-nick]

-  (if-let [user-info (fetch-nick profile-nick)]

-    (let [st            (fetch-template "popular" session)

-	  profile-nick  (:nick user-info)

-	  raw-dumps     (get-popular-dumps profile-nick (or (:user_id session) -1))

-	  dumps         (map process-message-for-output raw-dumps)]

-      (.setAttribute st "nick" profile-nick)

-      (.setAttribute st "mini_profile" (build-mini-profile user-info))

-      (.setAttribute st "dumps" dumps)

-      (.toString st))

-    (resp-error "NO_USER")))

-

-;; Directory

-

-(def *per-directory-page* 25)

-

-(defn process-directory-entry [entry]

-  (let [score (lookup-score (:nick entry))]

-    (assoc (stringify-and-escape entry)

-      "score_ent" (score-to-entity score)

-      "score"     score)))

-

-(def directory-cache-ttl (minutes 10))

-(def memoized-lookup-recent-posts-tagless

-     (ttl-memoize lookup-recent-posts-tagless directory-cache-ttl))

-  

-

-(defn add-recent-posts [user-id users]

-  (if-not (empty? users)

-    (let [f    (if user-id lookup-recent-posts lookup-recent-posts-tagless)

-          res  (f user-id (map :user_id users))]

-      (for [u users]

-        (merge u (find-first #(= (:user_id u) (:user_id %)) res))))))

-

-(defn get-directory-info [user-id offset]

-  (map process-directory-entry

-       (add-recent-posts user-id

-        (get-user-ranking offset *per-directory-page*))))

-    

-(defn directory [session offset]

-  (let [st     (fetch-template "directory" session)

-        users  (get-directory-info (:user_id session) offset)]

-    (.setAttribute st "users" users)

-    (cond (= offset 0) (.setAttribute st "prev" false)

-          (= offset 1) (.setAttribute st "prev" "")

-          :else (.setAttribute st "prev" (str "/" (dec offset))))

-    (if (> offset 0)

-      (.setAttribute st "cur" offset))

-    (.setAttribute st "next" (str "/" (inc offset)))

-    (.toString st)))

-

-;; Single posts

-

-(defn single-message [session nick-from-url id-from-url]

-  (if-let [user-info (fetch-nick nick-from-url)]

-    (if-let [message (fetch-public-message-by-id id-from-url)]

-      ; error if nick in url doesn't match the nick who posted the message from the id in url 

-      ; this prevents people from scraping all the content by incrementing the id in the url

-      (if (= (user-info :user_id) (message :user_id))

-        (let [st (fetch-template "single_message" session)

-              message (tags/add-favorited-flag message session)

-              message (tags/remove-tags-for-output message)]

-          (.setAttribute st "dump" (process-message-for-output message))

-          (.toString st))

-        (resp-error "NO_MESSAGE"))

-      (resp-error "NO_MESSAGE"))

-    (resp-error "NO_USER")))

-

-

-;; Chat

-

-(defn validate-room-access [room-key session]

-  (if-let [room (lookup-room room-key)]

-    (or (not (room :admin_only))

-	(is-vip? session))))

-

-(def default-room-template "chat")

-

-(defn lookup-room-template [session room-key template]

-  (or (fetch-template (str "rooms/" (or template room-key)) session)

-      (fetch-template (str "rooms/" default-room-template) session)))

-

-(defn chat [session room template]

-  (if-let [st (lookup-room-template session (:key room) template)]

-    (let [now              (System/currentTimeMillis)

-	  nick             (session :nick)

-	  raw-msgs         (reverse (tags/fetch-dumps :room (:key room)

-                                                      :image-only false

-                                                      :user-tag-id (:user_id session)

-                                                      :hide-vip false

-                                                      :limit (:history_size room)))

-	  message-list     (to-array (map process-message-for-output raw-msgs))]

-      (if nick

-	(dosync

-	 (login-user (user-struct-from-session session) room)))

-      (doto st

-	(.setAttribute "users" (prepare-user-list room true))

-	(.setAttribute "messages" message-list)

-	(.setAttribute "roomkey" (room :key))

-	(.setAttribute "isadminroom" (room :admin_only))

-	(.setAttribute "json_room_key" (json-str (room :key)))

-	(.setAttribute "json_user_nick" (if nick (json-str nick) "null"))

-	(.setAttribute "roomname" (room :name))

-	(.setAttribute "dis" (= (room :name) "dis"))

-	(.setAttribute "timestamp" now))

-      (.toString st))

-    [404 "UNKNOWN PAGE"]))

-

-(defn validated-chat

-  ([session room-key] (validated-chat session room-key nil))

-  ([session room-key template]

-     (let [room-key   (if (= (lower-case room-key) "www") *default-room* room-key)]

-       (if (validate-room-access room-key session)

-	 (chat session (lookup-room room-key) template)

-	 (resp-error "UNKNOWN_ROOM")))))

-

-(defn refresh [session params room]

-  (dosync

-   (let [now      (System/currentTimeMillis)

-         old-ts   (new Date (maybe-parse-long (params :since) now))

-         nick     (session :nick)

-         users    (room :users)]

-     (if nick

-       (if-let [user-info (@users nick)]

-         ; Incorporate avatar updates

-	 (commute users assoc nick (merge user-info {:last-seen now

-						     :avatar    (session :avatar)}))

-	 (commute users assoc nick (user-struct-from-session session))))

-     (resp-success (assoc (updates nick room old-ts)

-		          :timestamp now)))))

-

-(defn validated-refresh [session params]

-  (let [room-key (params :room)

-        room (lookup-room room-key)]

-    (if (validate-room-access room-key session)

-      (refresh session params room)

-      (resp-error "UNKNOWN_ROOM"))))

-

-;; admins can post arbitrary html if wrapped in <safe>

-;; this is temporary so that i can test generating html messages

-(defn validated-content [content session]

-  (if (.startsWith content "<safe>")

-      (if (is-vip? session)

-          (str content)

-          (str "<unsafe>" content "</unsafe>"))

-      (str content)))

-

-(defn msg-db [user-id room-id content]

-  (let [msg-type (classify-msg content)

-        is-image (boolean (#{:image :mixed} msg-type))

-        is-text  (boolean (#{:mixed :text} msg-type))

-	qry      (str "INSERT INTO messages (user_id, room_id, content, is_image, is_text) "

-		      "VALUES (?, ?, ?, ?, ?) RETURNING message_id")]

-    (with-connection *db*

-      ((first (do-select [qry user-id room-id content is-image is-text]))

-       :message_id))))

-

-(defn msg [session params]

-   (let [user-id      (session :user_id)

-         mute         (get (poll *active-mutes*) user-id)

-         nick         (session :nick)

-         room-key     (params :room)

-         room         (lookup-room room-key)

-         content      (.trim (params :content))]

-     (cond (not room) (resp-error "BAD_ROOM")

-           (not nick) (resp-error "NOT_LOGGED_IN")

-           mute       (resp-error (format-mute mute))

-           :else

-	   (let [content  (validated-content content session)

-	         msg-id (msg-db user-id (room :room_id) content)]

-	     (dosync

-              (if (not (contains? (ensure (room :users)) nick))

-                (login-user (user-struct-from-session session) room))

-              (add-message (build-msg nick content msg-id) room))

-	     (resp-success msg-id)))))

-

-

-(defn validated-msg [session params request]

-  (cond

-   (not (validate-room-access (params :room) session)) (resp-error "UNKNOWN_ROOM")

-   :else (msg session params)))

-

-;; Browser

-

-;; TODO: make work for all rooms

-(defn browser [session]

-  (let [room  (lookup-room *default-room*)

-        now   (System/currentTimeMillis)

-        nick  (session :nick)

-        st    (fetch-template "browser" session)]

-    (if nick

-      (dosync

-       (login-user (user-struct-from-session session) room)))

-    (let [user-list (prepare-user-list room false)]

-      (.setAttribute st "users" user-list))

-    (.setAttribute st "roomkey" (room :key))

-    (.setAttribute st "isadminroom" (room :admin_only))

-    (.setAttribute st "json_room_key" (json-str (room :key)))

-    (.setAttribute st "json_user_nick" (if nick (json-str nick) "null"))

-    (.setAttribute st "roomname" (room :name))

-    (.setAttribute st "timestamp" now)

-    (.toString st)))

-

-

-;; Chat Log

-

-(defn log [session room offset params]

-  (let [roomkey     (room :key)

-        st          (fetch-template "log" session)

-        logger      (make-time-logger)

-	offset      (maybe-parse-int offset 0)

-        dump-offset (* offset *dumps-per-page*)

-        image-only  (and (not (room :admin_only))

-                         (not= (params :show) "all"))

-        raw-dumps   (logger tags/fetch-dumps-by-room :room-id (room :room_id)

-                            :image-only image-only

-                            :amount (+ 1 *dumps-per-page*)

-                            :offset dump-offset)

-        dumps       (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session))

-        ;;   json-tags (for [dump dumps :when (not (empty? (dump :tags)))] 

-        ;;               (json-str {"id" (dump :message_id) "tags" (dump :tags) }))

-        dumps       (map tags/remove-tags-for-output dumps)

-        dumps       (logger doall (map process-message-for-output dumps))]

-    (if (> (count raw-dumps) *dumps-per-page*)

-      (.setAttribute st "next" (inc offset)))

-    (if (not= offset 0)

-      (.setAttribute st "prev" (max (dec offset) 0)))

-    (.setAttribute st "dumps" dumps)

-    (if (default-room? roomkey)

-      (.setAttribute st "roomkey" "")

-      (.setAttribute st "roomkey" (str roomkey ".")))

-    (.setAttribute st "roomname" (room :name))

-    (.setAttribute st "debug_log_items" (logger))

-    (.toString st)))

-

-(defn validated-log [session room-key offset params]

-  (let [room-key (if (= (lower-case room-key) "www") "dumpfm" room-key)]

-    (if (validate-room-access room-key session)

-      (log session (lookup-room room-key) offset params)

-      (resp-error "UNKNOWN_ROOM"))))

-

-;; Hiscore test... redis test...

-

-(defn redis-ids-test [period]

-  (let [reddis-server  {:host "127.0.0.1" :port 6379 :db 0}

-        ids            (redis/with-server reddis-server 

-                         (redis/zrevrange (str "hiscore:" period) 0 -1))

-        ids            (map maybe-parse-int ids)]

-    ids))

-

-(defn hiscore-test [session params period]

-  (let [st     (fetch-template "hiscore_test" session)

-        dumps  (tags/fetch-dumps-by-ids (redis-ids-test period))

-        dumps  (map tags/add-favorited-flag dumps (repeat session))

-        dumps  (map tags/add-fav-count dumps)

-        dumps  (reverse (sort-by :favcount dumps))

-        dumps  (map tags/remove-tags-for-output dumps)

-        dumps  (map process-message-for-output dumps)]

-    (.setAttribute st "dumps" dumps)

-    (.toString st)))

-        

-

-

-;; Altars

-

-;; if :nick is in params, will fetch only altars by that nick

-;; next page links look like /altars/message-id and select <= message_id order desc

-;; prev page links look like /altars/-message-id and select > message_id order asc

-(defn altar-log [session params]

-  (let [id         (params :id)

-        nick       (params :nick)

-        user-id    (if nick (user-id-from-nick nick) nil)

-        template   (if user-id "altar_user_log" "altar_log")

-        st         (fetch-template template session)

-        raw-dumps  (tags/fetch-altars :message-id id :amount (+ 1 *dumps-per-page*) :user-id user-id)

-        dumps      (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session))

-        dumps      (map tags/remove-tags-for-output dumps)

-        dumps      (map process-message-for-output dumps)]

-    (.setAttribute st "dumps" dumps)

-    (.setAttribute st "nick" nick)

-    (if (> (count raw-dumps) *dumps-per-page*)

-      (.setAttribute st "next" ((last raw-dumps) :message_id)))

-    (if id

-      (.setAttribute st "prev" ((first raw-dumps) :message_id)))

-    (.toString st)))

-

-;; Tags 

-

-(defn undecoded-url-piece [url position]

-  "Get nth thing out of a url path.

-  For example, (undecoded-url-piece 'http://example.com/a/b/c?foo' 2) will return 'c'"

-  (let [path-without-domain (nth (re-find #"//[^/]+/(.+)" url) 1)]

-    (nth (re-split #"/|\?" path-without-domain) position)))

-

-(defn add-tag [user msg tag]

-  (try

-   (do-insert "tags" 

-              ["user_id" "message_id" "tag"]

-              [(:user_id user) (msg :message_id) tag])

-   (if (and (= tag "favorite")

-            (not (= (msg :nick) (user :nick))))

-     (insert-fav-notification! (msg :nick)

-                               (user :nick)

-                               (user :avatar)

-                               (msg :content)))

-   true

-    ; catch error when inserting duplicate tags

-   (catch Exception e false)))

-

-

-(defn validated-add-tag [session params]

-  (if (session :nick)

-    (let [nick          (session :nick)

-          user-id       (session :user_id)

-          user-admin?   (session :admin-only)

-          msg-id        (params :message_id)

-          tag           (validate-tag (params :tag))

-          msg           (fetch-message-by-id msg-id)

-          access        (or (is-vip? session)

-                            (not (:admin-only msg)))]

-      (cond (not msg)      (resp-error "NO_MSG")

-            (not access)   (resp-error "NO_MSG")

-            (not tag)      (resp-error "NO_TAG")

-            :else (if (add-tag session msg tag)

-                    (resp-success "OK")

-                    (resp-error "TAG_EXISTS_ALREADY_OR_SOMETHING_ELSE_IS_FUCKED"))))

-    (resp-error "NO_USER")))

-

-(defn remove-tag [user-id message-id tag]

-  (let [query "user_id = ? AND message_id = ? AND lower(tag) = ?"]

-       (do-delete "tags" [query user-id (maybe-parse-int message-id) (normalize-tag-for-db (.toLowerCase tag))])

-       (resp-success "OK")))

-

-(defn validated-remove-tag [session params]

-  (if (session :nick)

-     (remove-tag (session :user_id) (params :message_id) (params :tag))

-     (resp-error "NO_USER")))

-

-;; message-user-id: get messages posted by this user

-;; tag-user-id: get messages tagged by this user

-(defnk tagged-dumps-template [session params tags url page-title info-bar

-                              :message-user-id false

-                              :tag-user-id false

-                              :logger (make-time-logger)

-                              :include-vip false]

-  (let [st (fetch-template "tagged_dumps" session)

-	      offset (maybe-parse-int (params :offset) 0)

-        dump-offset (* offset *dumps-per-page*)

-        raw-dumps (logger tags/fetch-dumps-by-tag :tags tags 

-                                                  :image-only false 

-                                                  :amount (+ 1 *dumps-per-page*)

-                                                  :offset dump-offset

-                                                  :message-user-id message-user-id

-                                                  :tag-user-id tag-user-id

-                                                  :include-vip include-vip)

-        dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session))

-        dumps (map tags/remove-tags-for-output dumps)

-        dumps (logger doall (map process-message-for-output dumps))]

-    (.setAttribute st "dumps" dumps)

-    (.setAttribute st "infobar" info-bar)

-    (.setAttribute st "page_title" page-title)

-    (.setAttribute st "page_url" url)

-    (if (not= offset 0)

-      (.setAttribute st "prev" (format "/%s/%s" url (max 0 (dec offset)))))

-    (if (> (count raw-dumps) *dumps-per-page*)

-      (.setAttribute st "next" (format "/%s/%s" url (inc offset))))

-    (.setAttribute st "debug_log_items" (logger))

-    (.toString st)))

-

-;; gotta parse tag intersections myself because +'s get decoded into spaces

-;; there's probably a less hacky way to do this

-(defn tagged-dumps-by-nick [session params url]

-  (let [nick (params :nick)

-	user-id (user-id-from-nick nick)

-	user-info (fetch-nick nick)

-	info-bar (build-mini-profile user-info)

-        tags (map url-decode (re-split #"\+" (undecoded-url-piece url 2)))

-        url (str nick "/tag/" (str-join "+" (map url-encode tags)))

-        page-title (str "dumps " nick " tagged as '" (escape-html (str-join "' and '" tags)) "'")]

-    (tagged-dumps-template session params tags url page-title info-bar :tag-user-id user-id)))

-

-(defn tagged-dumps [session params url]

-  (let [tags (map url-decode (re-split #"\+" (undecoded-url-piece url 1)))

-        url (str "tag/" (str-join "+" (map url-encode tags)))

-        page-title (str "dumps tagged as '" (escape-html (str-join "' and '" tags)) "'")]

-    (tagged-dumps-template session params tags url page-title "")))

-

-(defn favorites-next-page-link [nick last-msg]

-  (format "/%s/favorites/%s/%s"

-          nick

-          (format-yyyy-mm-dd (:tagged_on last-msg))

-          (:message_id last-msg)))

-

-(defn favorites [session user-info date msg-id]

-  (let [st            (fetch-template "tagged_dumps" session)

-        logger        (make-time-logger)

-        raw-dumps     (tags/fetch-tagged-dumps

-                       :nick (:nick user-info)

-                       :user-tag-id (:user_id session)

-                       :msg-id msg-id

-                       :date (if msg-id nil date)

-                       :limit (inc *dumps-per-page*))

-        back-dumps    (if (or date msg-id)

-                        (tags/fetch-tagged-dumps

-                         :nick (:nick user-info)

-                         :msg-id msg-id

-                         :date (if msg-id nil date)

-                         :limit (inc *dumps-per-page*)

-                         :direction :forward))

-        dumps         (map process-message-for-output (butlast raw-dumps))]

-    (.setAttribute st "prev"

-                   (if back-dumps

-                     (cond

-                      (> (count back-dumps) *dumps-per-page*) (favorites-next-page-link (:nick user-info)

-                                                                                        (last back-dumps))

-                      (> (count back-dumps) 1) (format "/%s/favorites" (:nick user-info))

-                      :else nil)))

-    (if (> (count raw-dumps) *dumps-per-page*)

-      (.setAttribute st "next" (favorites-next-page-link (:nick user-info) (last raw-dumps))))

-    (.setAttribute st "dumps" dumps)

-    (.setAttribute st "infobar" (build-mini-profile user-info))

-    (.setAttribute st "page_title" (format "%s'S FAVS" (:nick user-info)))

-    (.setAttribute st "debug_log_items" (logger))

-    (.toString st)))

-

-(defn favorites-handler [session nick date msg-id]

-  (generic-profile-handler session nick date msg-id

-                           favorites

-                           (fn [u] (redirect-to (format "/%s/favorites" (:nick u))))

-                           #(resp-error "NO_USER")))                       

-

-(defn json-favorites [session params]

-  (let [nick (params :nick)

-        user-id (user-id-from-nick nick)

-        raw-favs (tags/fetch-tagged-dumps :nick nick

-                                          :limit 50)

-        favs (reduce (fn [m fav] (assoc m (str (fav :message_id)) (fav :content))) {} raw-favs)]

-    (str "RawFavs=" (json-str favs))))

-

-(defn search-query [num-tokens]

-  (str "select 

-  url from image_urls

-  where url ilike " (str-join " and url ilike " (take num-tokens (repeat "?"))) "

-  order by last_posted desc 

-  limit 200;"))

-

-;; note: _ is a wildcard in a postgres 'like' query... 

-(defn search-replace-weird-chars [token]

-  (str (.replaceAll token "[^A-Za-z0-9\\-.=+]" "_"))

-)

-

-;; timb: this can be called with a callback or not...

-;; 

-;; dump.fm/cmd/search/foo -> [result, result]

-;; cons: can only be ajax get'd from the same domain

-;; 

-;; dump.fm/cmd/search/foo?callback=someFunc -> someFunc([result, result])

-;; cons: has to use a <script> tag. seems to freeze browser until results returned

-;; 

-(defn json-search [undecoded-url-searchterms params]

-   (let [tokens (map url-decode (re-split #"\+" undecoded-url-searchterms))

-         tokens (map search-replace-weird-chars tokens)

-	       tokens (map #(str "%" %1 "%") tokens)

-	       query (search-query (count tokens))

-	       rows (do-select (vec (concat [query] tokens)))]

-	    (if (:callback params) 

-	      (str (:callback params) "(" (json-str rows) ")")

-	      (json-str rows))))

-

-

-;; Local testing

-

-(def random-posts

-     ["http://24.media.tumblr.com/tumblr_l41x4eLWZm1qzon5ko1_400.png hi"

-      "lol http://29.media.tumblr.com/tumblr_l3o3wuRFpM1qawuaao1_500.jpg"

-      "http://dump.fm/images/20100819/1282199186063-dumpfm-timb-dump.stone.logo.gif http://teamassignment.com/images/getmesomemore.jpg http://26.media.tumblr.com/tumblr_l7kro0os531qaajkio1_500.gif"])

-

-(defn make-random-post! []

-  (msg {:user_id 1

-        :nick "scottbot"

-        :avatar "http://i.imgur.com/isKqZ.gif"}

-       {:room "dumpfm"

-        :content (rand-elt random-posts)}))

-

-(def random-poster

-     (scheduled-agent make-random-post! 5 nil))

-  

-;; Account resets

-

-(defn reset-request-page [session]

-  (.toString (fetch-template "req_reset" session)))

-

-(defn reset-request! [session {nick :nick}]

-  (if-let [info   (fetch-nick nick)]

-    (let [nick   (info :nick) ; get correct casing

-	  email  (info :email)

-          hash   (info :hash)

-          ts     (System/currentTimeMillis)

-          token  (reset-token nick hash ts)

-          link   (reset-link nick token ts)]

-      (do (send-reset-email nick email link)

-          (resp-success "OK")))

-    (resp-error "NO_NICK")))

-

-(defn reset-page [session params]

-  (let [st    (fetch-template "reset" session)

-        nick  (params :nick)

-        ts    (maybe-parse-long (params :ts) 0)

-        token (params :token)

-        valid (valid-reset-link? nick token ts)]

-    (if (and (zero? ts)

-             (nil? nick)

-             (nil? token))

-      (reset-request-page session)

-      (do

-        (.setAttribute st "valid_request" valid)

-        (.setAttribute st "nick" nick)

-        (when valid

-          (.setAttribute st "link" (reset-link nick token ts)))

-        (.toString st)))))

-

-(defn reset-account! [session params]

-  (let [nick   (params :nick)

-        ts     (maybe-parse-long (params :ts) 0)

-        token  (params :token)

-        hash   (params :hash)]

-    (if (and (valid-reset-link? nick token ts) hash)

-      (let [info (fetch-nick nick)]

-        (update-nick-hash nick hash)

-        [(session-assoc-from-db info)

-         (redirect-to "http://dump.fm/")])

-      [200 "BAD_REQUEST"])))

-

-;; Upload

-

-(def max-avatar-dimensions [800 800])

-(def max-avatar-size (kbytes 500))

-

-(defn is-file-too-big? [f limit]

-  (if (> (.length f) limit)

-    (str "FILE_TOO_BIG " limit)))

-

-(defn invalid-image-dimensions? [f [max-width max-height]]

-  (try

-    (let [i (ImageIO/read f)

-          height (.getHeight i)

-          width (.getWidth i)]

-      (if (or (> width max-width)

-              (> height max-height))

-        (str "INVALID_RESOLUTION "  max-width " " max-height)))

-    (catch Exception _ "INVALID_IMAGE")))

-

-(defn format-filename [s nick]

-  (let [spaceless (.replace s \space \-)

-        nick-clean (re-gsub #"[^A-Za-z0-9]" "" nick)

-        subbed (re-gsub #"[^\w.-]" "" spaceless)]

-    (str-join "-" [(System/currentTimeMillis) "dumpfm" nick-clean subbed])))

-

-(defn image-url-from-file [dir date file]

-  (str-join "/" [*server-url* dir date (.getName file)]))

-

-(defn validate-upload-file [f room]

-  (or (is-file-too-big? f (:max_file_size room))

-      (invalid-image-dimensions? f [(:max_image_width room)

-                                    (:max_image_height room)])))

-

-(defn validate-avatar-file [f]

-  (or (is-file-too-big? f max-avatar-size)

-      (invalid-image-dimensions? f max-avatar-dimensions)))

-

-

-; Upload notes:

-; The webcam code doesn't feature an error handler,

-; so all upload responses not equal to "OK" are considered

-; errors.

-; The upload code doesn't use jQuery.ajax, and doesn't JSON-eval

-; responses. Therefore, return strings should not be JSON-encoded.

-

-(defn do-upload [session image room]

-  (if-let [err (validate-upload-file (image :tempfile) room)]

-    (resp-error err)

-    (let [filename (format-filename (:filename image) (session :nick))

-          date (today)

-          dest (open-file [*image-directory* date] filename)

-          url (image-url-from-file "images" date dest)

-          msg-id (msg-db (session :user_id) (room :room_id) url)

-          msg (struct message-struct (session :nick) url (new Date) msg-id)]

-      (do 

-        (dosync

-         (add-message msg room))

-        (copy (:tempfile image) dest)

-        [200 "OK"]))))

-

-(defn upload [session params request]

-  (let [room-key   (params :room)

-        nick       (session :nick)

-        user-id    (session :user_id)

-        image      (params :image)

-        mute       (get (poll *active-mutes*) user-id)

-        has-access (validate-room-access room-key session)]

-    (cond (not nick)       [200 "NOT_LOGGED_IN"]

-          (not image)      [200 "INVALID_REQUEST"]

-          mute             [200 (format-mute mute)]

-          (not has-access) [200 "UNKNOWN_ROOM"]

-          :else (do-upload session image (lookup-room room-key)))))

-

-(defn upload-photo [session params]

-  (let [room-key   (params :room)

-        nick       "~photobot"

-        user-id    (rooms/fetch-or-create-bot-id! nick)

-        image      (params :image)]

-    (do-upload {:is_admin true :nick nick :user_id user-id} image (lookup-room room-key))))

-

-;; N.B. -- Upload responses aren't JSON-evaluated

-(defn do-upload-avatar [session image]

-  (let [filename (format-filename (:filename image) (session :nick))

-        date (today)

-        dest (open-file [*avatar-directory* date] filename)

-        url (image-url-from-file "avatars" date dest)]

-    (do

-      (copy (:tempfile image) dest)

-      (update-user-db (session :user_id) "avatar" url)

-      [(session-assoc :avatar url)

-       [200 url]])))

-

-(defn upload-avatar [session params]

-  (let [image (params :image)]

-    (cond (not image)           [200 "INVALID_REQUEST"]

-          (not (session :nick)) [200 "NOT_LOGGED_IN"]

-          :else (if-let [err (validate-avatar-file (:tempfile image))]

-		  [200 err]

-		  (do-upload-avatar session image)))))

-

-(defn serve-meme [session meme]

-  (if-let [st   (fetch-template meme session)]

-    (let [now  (System/currentTimeMillis)]

-      (.setAttribute st "timestamp" now)

-      (.toString st))

-    (unknown-page)))

-

-(defn hall-of-fame [session]

-  (let [st   (fetch-template "fame" session)

-	msgs (add-user-favs-to-msgs (poll hall-results)

-				    (session :user_id))]

-    (.setAttribute st "dumps" (map process-message-for-output msgs))

-    (.toString st)))

-

-;; MGMT logic

-

-(def mgmt-pw "idontgetit")

-

-(defn mgmt [session pw]

-  (if (= (and pw (lower-case pw)) mgmt-pw)

-    (validated-chat session "mgmt" "chat")

-    (validated-chat session "mgmt")))

-

-;; Compojure Routes

-

-(defn serve-static [dir path]

-  (if (= path "")

-    (redirect-to "http://dump.fm")

-    (serve-file dir path)))

-

-(defroutes static

-  (GET "/static/*"  (serve-static "static" (params :*)))

-  (GET "/images/*"  (serve-static *image-directory* (params :*)))

-  (GET "/avatars/*" (serve-static *avatar-directory* (params :*)))

-;; irl

-  (GET "/irl"      (redirect-to "/irl/"))

-  (GET "/irl/"     (serve-static "static/319"  "index.html"))

-  (GET "/irl/*"    (serve-static "static/319"  (params :*)))

-  (GET "/irl2"     (redirect-to "/irl2/"))

-  (GET "/irl2/"    (serve-static "static/319"  "res.html"))

-  (GET "/irl2/*"   (serve-static "static/319" (params :*)))

-  (GET "/irlhell"  (redirect-to "/irhell/"))

-  (GET "/irhell"   (redirect-to "/irhell/"))

-  (GET "/irhell/"  (serve-static "static/319"  "irhell.html"))

-  (GET "/irhell/*" (serve-static "static/319"  (params :*))))

-

-

-

-(defroutes pichat

-  (GET "http://:sub.dump.fm/"     (validated-chat session (params :sub)))

-  (GET "http://:sub.dump.fm/chat" (validated-chat session (params :sub)))

-  (GET "http://:sub.dump.fm/chat" (validated-chat session (params :sub) (params :t)))

-  (GET "/:room/chat"              (validated-chat session (params :room)))

-  (GET "/chat"                    (validated-chat session *default-room*))

-  (GET "/chat/:t"                 (validated-chat session *default-room* (params :t)))

-

-  (GET "http://:sub.dump.fm/log"         (validated-log session (params :sub) "0" params))

-  (GET "http://:sub.dump.fm/log/:offset" (validated-log session (params :sub) (params :offset) params))

-  (GET "/log"                            (validated-log session *default-room* "0" params))

-  (GET "/log/:offset"                    (validated-log session *default-room* (params :offset) params))

-  (GET "/r/:room/log"                      (validated-log session (params :room) "0" params))

-  (GET "/r/:room/log/:offset"              (validated-log session (params :room) (params :offset) params))

-

-  (GET "/favicon.ico" (serve-static "static" "favicon.ico"))

-  (GET "/u/:nick"  (redirect-to (str "/" (params :nick))))

-  (GET "/u/:nick/" (redirect-to (str "/" (params :nick))))

-  (GET "/u/:nick/tag/:tag" (tagged-dumps-by-nick session params (request-url request)))

-  (GET "/u/:nick/tag/:tag/:offset" (tagged-dumps-by-nick session params (request-url request)))

-  (GET "/u/:nick/favorites" (redirect-to (format "/%s/favorites" (params :nick))))

-  (GET "/u/:nick/favorites/:offset" (redirect-to (format "/%s/favorites" (params :nick))))

-  (GET "/json/:nick/favorites" (json-favorites session params))

-  

-  ; have to put this route after favs

-  (GET "/u/:nick/:offset" (redirect-to (str "/" (params :nick))))

-  

-  (GET "/p/:nick/:postid" (single-message session (params :nick) (params :postid)))

-

-  ;; TODO: delete GET routes very shortly

-  (GET "/login" (login session params cookies request))

-  (POST "/login" (login session params cookies request))

-  (GET "/logout" (logout session))

-  (POST "/logout" (logout session))

-  (GET "/register" (serve-static "static" "register.html"))

-  (GET "/registerdis" (serve-static "static" "registerdis.html"))

-  (GET "/browser" (browser session))

-  (GET "/refresh" (validated-refresh session params))

-  (GET "/tag/:tag" (tagged-dumps session params (request-url request)))

-  (GET "/tag/:tag/:offset" (tagged-dumps session params (request-url request)))

-  (POST "/cmd/tag/add" (validated-add-tag session params))

-  (POST "/cmd/tag/rm" (validated-remove-tag session params))

-

-  ;; Altars

-  (GET "/altars" (altar-log session params))

-  (GET "/altars/" (altar-log session params))

-  (GET "/altars/:id" (if (maybe-parse-int (params :id) false)

-                         (altar-log session params)

-                         (redirect-to (str "/" (params :id) "/altars")))) ;; redirect /altars/timb to /timb/altars

-

-  ;; testing

-  (GET "/test/hiscores" (hiscore-test session params "week"))

-  (GET "/test/hiscores/alltime" (hiscore-test session params "all"))

-  (GET "/test/hiscores/day" (hiscore-test session params "day"))

-  (GET "/test/hiscores/week" (hiscore-test session params "week"))

-  (GET "/test/hiscores/month" (hiscore-test session params "month"))

-  

-  (GET "/mgmt" (mgmt session nil))

-  (GET "/mgmt/:pw" (mgmt session (:pw params)))

-

-  ;; Events

-;  (GET "/event" (event-page session))

-;  (GET "/event/proxy" (image-proxy session params request))

-;  (POST "/event/submit" (submit! session params request))

-

-       ;; Fullscreen

-  (GET "/fullscreen" (serve-meme session "fullscreen"))

-

-  ;; TODO: add form tokens for all destructive actions

-  (POST "/msg" (validated-msg session params request))

-  (POST "/submit-registration" (register session params request))

-  (POST "/update-profile" (update-profile session params))

-  (GET "/directory" (directory session 0))

-  (GET "/directory/:offset"

-       (directory session (maybe-parse-int (params :offset) 0)))

-  (GET "/reset-request" (reset-request-page session))

-  (POST "/reset-request" (reset-request! session params))

-  (GET  "/reset" (reset-page session params))

-  (POST "/reset" (reset-account! session params))

-

-  ;; Admin stuff (should be own route?)

-  (GET  "/debug" (debug-page session flash))

-  (POST "/debug" (debug-commmand! session params))

-  (GET  "/mutes" (show-mutes session))

-  (GET  "/roomlist" (show-rooms session))

-  (POST "/mute" (mute! session params))

-  (POST "/cancel-mute" (handle-cancel-mute! session params))

-  (GET  "/profile-test/:t" (profile session "ryder" (params :t)))

-  (GET  "/reports"       (list-reports-dir session))

-  (GET  "/reports/:file" (show-report session (params :file)))

-

-  (GET "/cmd/search/:searchterm" (json-search (undecoded-url-piece (request-url request) 2) params))

-  (GET "/search" (serve-template "search_files" session))

-

-  ;; Memes

-  (GET "/m/:m" (serve-meme session (params :m)))

-  (GET "/hall" (hall-of-fame session))

-

-  ;; Store

-  (GET "/stickers" (serve-static "static" "sticker.html"))

-  

-  ;; Footer pages

-  (GET "/about_us" (serve-template "about_us" session))

-  (GET "/goodies" (serve-template "goodies" session))

-  (GET "/help" (serve-template "help" session))

-  (GET "/privacy" (serve-template "privacy" session))

-  (GET "/terms" (serve-template "terms" session))

-  (GET "/error/ie" (serve-template "error_ie" session))

-

-  ;; Put username routes below all others in priority

-  (GET "/:nick"           (profile session (params :nick)))

-  (GET "/:nick/"          (profile session (params :nick)))

-  (GET "/:nick/altars"     (altar-log session params))

-  (GET "/:nick/altars/"    (altar-log session params))

-  (GET "/:nick/altars/:id" (altar-log session params))

-  (GET "/:nick/tag/:tag" (tagged-dumps-by-nick session params (request-url request)))

-  (GET "/:nick/tag/:tag/:offset" (tagged-dumps-by-nick session params (request-url request)))

-  (GET "/:nick/favorites" (favorites-handler session (params :nick) nil nil))

-  (GET "/:nick/favorites/" (favorites-handler session (params :nick) nil nil))

-  (GET "/:nick/favorites/:date" (favorites-handler session (params :nick) (params :date) nil))

-  (GET "/:nick/favorites/:date/" (favorites-handler session (params :nick) (params :date) nil))

-  (GET "/:nick/favorites/:date/:msg" (favorites-handler session (params :nick) (params :date) (params :msg)))

-  (GET "/:nick/favs" (favorites-handler session (params :nick) nil nil))

-  (GET "/:nick/favs/:date" (favorites-handler session (params :nick) (params :date) nil))

-  (GET "/:nick/favs/:date/:msg" (favorites-handler session (params :nick) (params :date) (params :msg)))

-  (GET "/:nick/popular" (popular session (params :nick)))

-  (GET "/:nick/log"        (user-log-handler session (params :nick) nil nil))

-  (GET "/:nick/log/"        (user-log-handler session (params :nick) nil nil))

-  (GET "/:nick/:date"      (user-log-handler session (params :nick) (params :date) nil))

-  (GET "/:nick/:date/"      (user-log-handler session (params :nick) (params :date) nil))

-  (GET "/:nick/:date/:msg" (user-log-handler session (params :nick) (params :date) (params :msg)))

-

-  (GET "/" (landing session))

-  (ANY "*" (unknown-page)))

-

-(defroutes multipart

-  (POST "/upload/message" (upload session params request))

-  (POST "/upload/photo" (upload-photo session params))

-  (POST "/upload/avatar" (upload-avatar session params)))

-

-;; Add jpeg to list

-(def mimetypes

-  {"css"  "text/css"

-   "gif"  "image/gif"

-   "gz"   "application/gzip"

-   "htm"  "text/html"

-   "html" "text/html"

-   "jpg"  "image/jpeg"

-   "jpeg" "image/jpeg"

-   "js"   "text/javascript"

-   "pdf"  "application/pdf"

-   "png"  "image/png"

-   "svg"  "image/svg+xml"

-   "swf"  "application/x-shockwave-flash"

-   "txt"  "text/plain"

-   "xml"  "text/xml"

-   "zip"  "application/zip"})

-

-(decorate static

-  (with-mimetypes {:mimetypes mimetypes}))

-

-(def *session-cookie-params* {:type :memory

-                              :expires (* 60 60)

-                              :domain *cookie-domain*})

-

-(decorate pichat

-  (with-mimetypes {:mimetypes mimetypes})

-  (with-cookie-login (comp not logged-in?) make-login-token read-login-token)

-  (with-session *session-cookie-params*))

-

-(decorate multipart

-  (with-mimetypes {:mimetypes mimetypes})

-  (with-cookie-login (comp not logged-in?) make-login-token read-login-token)

-  (with-session *session-cookie-params*)

-  (with-multipart))

-

-

-;;; Startup Code

-

-(defn start-server [port] 

-  (run-server {:port port

-               :nio  true}

-              "/static/*" (servlet static)

-              "/images/*" (servlet static)

-              "/avatars/*" (servlet static)

-              "/irl" (servlet static)

-              "/irl2" (servlet static)

-              "/irl/*" (servlet static)

-              "/irl2/*" (servlet static)

-              "/irhell" (servlet static)

-              "/irhell/*" (servlet static)

-              "/upload/*" (servlet multipart)

-              "/*" (servlet pichat)))

-

-(defn parse-command-args

-  "Parses command-line arguments. First arg is script name,

-  second arg is port number (defaults to 8080)."

-  ([script] {:port 8080})

-  ([script port] {:port (Integer/parseInt port)}))

-

-(def options 

-     (apply parse-command-args *command-line-args*))

-

-(load-rooms!)

-(start! reserved-nicks)

-(def server (start-server (options :port)))

-(start! *active-mutes*)

-

-; Delay the following to reduce start-load

-(Thread/sleep 15000)

-(start! *user-scores*)

-

-(start-user-flusher!)

-(start-session-pruner!)

-(start! hall-results)

-

-;; Scott 2010/8/30: disable feeds to test impact on server load

-;; (and see if anyone notices)

-;; (if (= *server-url* "http://dump.fm")

-;;  (do (start! feed-downloader)

-;;       (start! feed-inserter)))

-

-

-;(if (not= *server-url* "http://dump.fm")

-;  (start! random-poster))

-  

+(ns pichat
+  (:import java.lang.System
+           java.text.SimpleDateFormat
+           java.util.Date
+           java.io.File
+           javax.imageio.ImageIO
+           javax.servlet.http.Cookie
+	   org.antlr.stringtemplate.StringTemplateGroup)
+  (:use clojure.xml
+        clojure.contrib.command-line
+        clojure.contrib.duck-streams
+        clojure.contrib.json.write
+        clojure.contrib.seq-utils
+        clojure.contrib.sql
+        clojure.contrib.str-utils
+        clojure.contrib.def
+        clojure.contrib.pprint
+        config
+        admin
+        compojure
+        email
+        fame
+        utils
+        cookie-login
+        session-sweeper
+        feed
+        rooms
+        tags
+        scheduled-agent
+        user)
+  (:require redis))
+
+; Create image directories if they don't exist.
+(.mkdir (new File *image-directory*))
+(.mkdir (new File *avatar-directory*))
+
+
+;; Logging
+
+; is there a better way to do this or am i insane for introducing state? just wanna do
+; (let [log (debug-log)]
+;   (log "something")
+;   (log "something else")
+;   (log)) ; gets log array for output to template
+(defn make-debug-logger
+  ([] (make-debug-logger (new java.util.ArrayList)))
+  ([log]
+    (fn
+      ([] (to-array log))
+      ([s] (make-debug-logger (.add log s))))))
+
+(defn make-time-logger
+  ([] (make-time-logger (new java.util.ArrayList)))
+  ([log]
+    (fn
+      ([] (to-array log));
+            ([f & args]
+        (let [start (.getTime (new Date))
+             ret (apply f args)
+              log-string (str f ": " (- (.getTime (new Date)) start) " msecs" )]
+              (.add log log-string)
+              ret)))))
+
+;; Output
+
+(defn strip-empty-vals [m]
+  (into {} (filter (fn [[k v]] (non-empty-string? v)) m)))
+
+(defn process-message-for-json [d]
+  (assoc d :created_on (.getTime (d :created_on))))
+
+(defn message-room-link [m]
+  (if (= (:key m) "dumpfm")
+    "http://dump.fm/chat"
+    (format "http://%s.dump.fm" (:key m))))
+
+(defn process-message-for-output [d]
+  (escape-html-deep 
+   (strip-empty-vals
+    (if (contains? d :created_on)
+      (assoc d
+        :created_on (format-timestamp (d :created_on))
+        :roomlink (message-room-link d))
+      d))))
+
+(defn new-messages [room ts]
+  (reverse (take-while #(.after (% :created_on) ts) 
+                       @(room :messages))))
+
+(defn new-favs [nick ts]
+  (filter #(.after (:added %) ts)
+          (get @fav-map nick [])))
+
+(defn process-user [u]
+  (stringify-and-escape (strip-empty-vals u)))
+
+(defn process-directory-listing [d]
+  (stringify-and-escape
+   (strip-empty-vals d)))
+
+(defn prepare-user-list [room sort?]
+  (let [users (vals @(room :users))]
+    (map process-user (if sort?
+			(sort-by (fn [u] (.toLowerCase (:nick u))) users)
+			users))))
+
+(defn updates [nick room ts]
+  {"users"    (prepare-user-list room false) ; Sorting is done on client
+   "messages" (map process-message-for-json
+                   (new-messages room ts))
+   "favs"     (new-favs nick ts)})
+
+(defn count-messages-by-nick [nick image-only]
+  (let [query (str "SELECT COUNT(*)
+		    FROM messages m, users u, rooms r
+		    WHERE m.user_id = u.user_id AND u.nick = ?
+                    AND r.room_id = m.room_id AND r.admin_only = false "
+		   (if image-only "AND m.is_image = true " ""))]
+    (do-count [query nick])))
+
+(defn fetch-messages-by-nick 
+  ([nick image-only] (fetch-messages-by-nick nick image-only 0))
+  ([nick image-only offset]
+     (let [query (str "SELECT m.content, m.created_on, m.message_id, u.nick, u.avatar, r.key
+                       FROM messages m, users u, rooms r
+                       WHERE m.user_id = u.user_id AND u.nick = ?
+                       AND r.room_id = m.room_id AND r.admin_only = false "
+                      (if image-only "AND m.is_image = true " "")
+                      "ORDER BY created_on DESC
+                       LIMIT ? OFFSET ?")]
+       (do-select [query nick *dumps-per-page* offset]))))
+
+(defn fetch-message-by-id [m-id]
+  (let [query "SELECT m.message_id, m.content, m.created_on, m.user_id,
+                      u.nick, u.avatar, r.key, r.admin_only
+               FROM messages m, users u, rooms r
+               WHERE m.user_id = u.user_id
+               AND r.room_id = m.room_id
+               AND m.message_id = ?"]
+    (first (do-select [query (maybe-parse-int m-id -1)]))))
+
+(defn fetch-public-message-by-id [m-id]
+  (let [msg (tags/fetch-dump-by-id m-id)]
+    (if (and msg (not (:admin_only msg)))
+      msg)))
+
+;;  User-id/nick cache
+;;  I keep needing to grab user-id from a nick so I thought I'd cache them
+;;  @timb: I just duplicated this in the user-info map :(
+;;         we should reconcile our user caches
+(def user-id-cache (ref {}))
+(def *user-id-cache-size* 500)
+
+(defn user-id-from-nick [nick]
+  (let [nick (lower-case nick)
+        found (@user-id-cache nick)]
+    (if found
+      found
+      (let [query (str "SELECT user_id FROM users WHERE lower(nick) = ?")
+            res (first (do-select [query nick]))]
+        (if (nil? res)
+          nil
+          (let [found (res :user_id)]
+            (dosync
+              (if (> (count @user-id-cache) *user-id-cache-size*) (ref-set user-id-cache {}))
+                (alter user-id-cache assoc nick found))
+            found))))))
+
+;; Login code
+
+(defn session-map-from-db
+  [user-info]
+  {:user_id  (user-info :user_id)
+   :nick     (user-info :nick)
+   :is_admin (user-info :is_admin)
+   :avatar   (user-info :avatar)})
+
+(defn session-assoc-from-db
+  [user-info]
+  (session-assoc
+   :user_id        (user-info :user_id)
+   :nick           (user-info :nick)
+   :email          (user-info :email)
+   :is_admin       (user-info :is_admin)
+   :avatar         (user-info :avatar)
+   :password_login true))
+
+;; login-token functions
+
+(defn logged-in?
+  "Test whether user is logged in by presence of nick key in session.
+   (Apply to request map)"
+  [{session :session}]
+  (contains? session :nick))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Login-token version history
+;
+; v0: Format: nick%expiry%token-hash
+;     Date:   Mists of dump antiquity
+;
+; v1: Format: v1%nick%expiry%token-hash
+;     Date:   2010/04/24
+;     Note:   Contains same information as v0, but created under the
+;             wildcard domain (i.e. ".dump.fm") so that logins work
+;             across all subdomains.
+
+(defn encode-login-token [nick hash expiry]
+  (let [token-hash (sha1-hash hash expiry)]
+    (str "v1%" nick "%" expiry "%" token-hash)))
+
+(defn- parse-login-vec [v]
+  (try [(aget v 1) (Long/parseLong (aget v 2)) (aget v 3)]
+       (catch NumberFormatException _ nil)))
+
+(defn parse-login-token [token]
+  ; If users have multiple login-cookies across different domains
+  ; (i.e. both "dump.fm" and ".dump.fm"), token will be a vector
+  ; instead of a string.
+  (if (not (string? token))
+    (some identity (map parse-login-token token))
+    (let [v  (.split token "\\%")]
+      (if (and (= (alength v) 4) (= (aget v 0) "v1"))
+        (parse-login-vec v)))))
+
+(defn read-login-token [token]
+  (if-let [[nick expiry token-hash]  (parse-login-token token)]
+    (if (>= expiry (System/currentTimeMillis))
+      (let [db-info (fetch-nick nick)
+            computed-hash (sha1-hash (db-info :hash) expiry)]
+        (if (= token-hash computed-hash)
+          (select-keys db-info [:user_id :nick :email :is_admin :avatar]))))))
+
+(defn make-login-token
+  [{nick :nick hash :hash}]
+  (let [expiration (ms-in-future *login-token-expiry*)
+        token      (encode-login-token nick hash expiration)]
+    (set-cookie *login-token-key* token
+                :expires (gmt-string (new Date expiration))
+                :domain *cookie-domain*)))
+
+;; Landing
+
+(defn landing [session]
+  (redirect-to "/chat"))
+
+(defn log-login [user_id ip]
+  ;; i'm using do-cmds here because update-values can't deal with stuff like 'last_login = now()'
+  (let [query (format "UPDATE users SET last_ip = '%s'::cidr, last_login = now() WHERE user_id = %s" (str ip) (str user_id))]
+    (do-cmds query))
+)
+
+(defn login [session params cookies request]
+  (let [nick         (or (params :nick) "")
+        hash         (or (params :hash) "")
+        remember-me  (= (params :rememberme) "yes")
+        db-user      (authorize-nick-hash nick hash)
+        login-cookie (if remember-me
+                       (make-login-token db-user)
+                       (clear-login-token *login-token-key*))
+        ip           (get-ip request)]
+      (if db-user
+        (do
+           (log-login (db-user :user_id) ip)
+          [(session-assoc-from-db db-user)
+           login-cookie
+           (resp-success "OK")]
+      )
+      (resp-error "BAD_LOGIN"))))
+
+(defn logout [session]
+  [(session-dissoc :nick :user_id :is_admin :avatar)
+   (set-cookie *login-token-key* "dummy"
+               :expires "Thu, 01-Jan-1970 00:00:01 GMT"
+               :domain *cookie-domain*)
+   (redirect-to "http://dump.fm/")])
+
+;; Registration
+
+(def muted-ips-query "
+SELECT DISTINCT
+       last_ip
+FROM   users
+WHERE  user_id IN
+    (SELECT user_id FROM mutes
+     WHERE  (set_on + duration) > now()
+     AND    NOT cancelled)")
+
+(defn get-ip-str [db-ip]
+  (first (.split (.getValue db-ip) "/")))
+  
+
+(defn ip-recently-muted? [ip]
+  (let [muted-ips   (set (map (comp get-ip-str :last_ip)
+                              (do-select [muted-ips-query])))]
+    (contains? muted-ips ip)))
+
+(def *reserved-nicks-path* "docs/reserved_nicks.txt")
+(def *reserved-nicks-refresh-period-sec* 300)
+
+(defn load-invalid-nicks []
+  (set (read-lines *reserved-nicks-path*)))
+
+(def reserved-nicks
+     (scheduled-agent load-invalid-nicks
+                      *reserved-nicks-refresh-period-sec*
+                      (load-invalid-nicks)))
+
+(defn nick-reserved? [nick]
+  (let [query "SELECT * FROM users WHERE LOWER(nick) = ? LIMIT 1"]
+    (or (contains? (poll reserved-nicks) nick)
+        (> (count (do-select [query (lower-case nick)])) 0))))
+
+(defn register [session params request]
+  (let [nick                (or (params :nick) "")
+        email               (or (params :email) "")
+        hash                (or (params :hash) "")
+        ip                  (get-ip request)
+        invalid-nick-reason (is-invalid-nick? nick)]
+    (cond invalid-nick-reason     (resp-error invalid-nick-reason)
+	  (nick-reserved? nick)   (resp-error "NICK_TAKEN")
+          (ip-recently-muted? ip) (resp-error "RECENTLY_MUTED")
+	  :else (do
+                  (do-insert :users
+                             [:nick :hash :email]
+                             [nick hash email])
+                  (let [db-user (fetch-nick nick)
+                        user_id (db-user :user_id)
+                        query   (format "UPDATE users SET created_ip = '%s'::cidr WHERE user_id = %s" (str ip) (str user_id))]
+                    (try (send-registration-email nick email)
+                         (catch Exception e nil))
+                    (do-cmds query) ; timb: doing this update query rather than using previous insert because jdbc 
+                                    ; can't figure out how to convert to cidr on prepared statements
+		                [(session-assoc-from-db db-user)
+		                 (resp-success "OK")])))))
+
+;; Fav scores
+
+(def *score-query* "
+SELECT u.user_id,
+       u.nick,
+       COUNT(*) AS cnt
+FROM   tags t,
+       messages m,
+       users u
+WHERE  t.message_id = m.message_id
+       AND m.user_id != t.user_id
+       AND m.user_id = u.user_id
+GROUP  BY u.user_id, u.nick
+ORDER BY cnt DESC
+")
+
+(defn build-score-list []
+  (let [res (vec (do-select [*score-query*]))]
+    {:list res
+     :map  (zipmap (map :nick res) (map :cnt res))}))
+
+(def *scores-refresh-period-sec* (* 29 60))
+
+(def *user-scores*
+     (scheduled-agent build-score-list
+                      *scores-refresh-period-sec*
+                      []))
+
+(def *piece-map*
+     (zipmap
+      [:pawn :knight :bishop :rook :queen :king :skull]
+      ["&#9823;" "&#9822;" "&#9821;" "&#9820;" "&#9819;" "&#9818;" "&#9760;"]))
+
+(defn score-to-piece [score]
+  (cond (= score -1)   :skull 
+        (= score 0)    :pawn
+        (< score 50)   :knight
+        (< score 150)  :bishop
+        (< score 300)  :rook
+        (< score 1000) :queen
+        :else :king))
+
+(def score-to-entity (comp *piece-map* score-to-piece))
+
+(defn lookup-score [nick]
+  (if (= (lower-case nick) "scottbot")
+    -1
+    (let [scores (:map (poll *user-scores*))]
+      (get scores nick 0))))
+
+(defn get-user-ranking [offset num]
+  (if-let [ranking  (:list (poll *user-scores*))]
+    (let [cnt       (count ranking)]
+      (subvec ranking
+              (min cnt (* offset num))
+              (min cnt (* (inc offset) num))))))
+
+
+;; Profile
+
+(defn pull-random-dump-images [dumps num]
+  (take num
+        (shuffle
+         (set (apply concat
+                     (map
+                      (comp take-images :content)
+                      dumps))))))
+  
+(defn count-dumps-posted [nick]
+  (:count
+   (first 
+    (do-select ["select count(*) from messages m, users u
+                 where m.user_id = u.user_id and lower(u.nick) = ?
+                 and m.is_image = true" (.toLowerCase nick)]))))
+
+(defn count-dumps-user-faved [nick]
+  (:count
+   (first
+    (do-select ["select count(distinct(m.message_id)) from users u, tags t, messages m
+                 where lower(u.nick) = ? and u.user_id = t.user_id
+                 and t.tag = 'favorite'
+                 and t.message_id = m.message_id and m.is_image = true"
+		(.toLowerCase nick)]))))
+
+(defn profile
+  ([session profile-nick] (profile session profile-nick "profile"))
+  ([session profile-nick template]
+     (if-let [user-info (fetch-nick profile-nick)]
+       (let [st            (fetch-template template session)
+             profile-nick  (:nick user-info) ; Update to get right casing
+             nick          (session :nick)
+             logger        (make-time-logger)
+             is-home       (and nick (= nick profile-nick))
+             score         (lookup-score profile-nick)
+	     dumps         (logger tags/fetch-dumps
+                                   :user-tag-id (:user_id session)
+				   :nick profile-nick
+				   :limit 10)
+             imgs          (pull-random-dump-images dumps 5)]
+         (do
+           (.setAttribute st "is_home" is-home)
+           (doseq [a [:nick :avatar :contact :bio]]
+	     (let [v (user-info a)]
+	       (.setAttribute st (name a)
+			      (if (non-empty-string? v) (escape-html v)))))
+	   (.setAttribute st "score" (comma-format score))
+	   (.setAttribute st "score_ent" (score-to-entity score))
+           (if (not (empty? imgs))
+	     (.setAttribute st "imgs" imgs))
+	   (.setAttribute st "debug_log_items" (logger))
+	   (.toString st)))
+       (resp-error "NO_USER"))))
+
+(defn update-user-db [user-id attr val]
+  (with-connection *db*
+    (update-values "users" ["user_id = ?" user-id] {attr val})))
+
+(defn update-avatar [session url] 
+  (update-user-db (session :user_id) "avatar" url)
+  [(session-assoc :avatar url)
+   (resp-success url)])
+
+(defn update-profile [session params]
+  (let [user-id (session :user_id)
+        attr (params :attr)
+        val (params :val)
+        attr-set #{"avatar" "contact" "bio"}]
+    (cond (not user-id)                   (resp-error "MUST_LOGIN")
+          (not (and user-id attr val))    (resp-error "BAD_REQUEST")
+          (not (contains? attr-set attr)) (resp-error "BAD_REQUEST")
+          (= attr "avatar")               (update-avatar session val)
+          :else (do (update-user-db user-id attr val)
+                    (resp-success "OK")))))
+
+;; Generic Handler
+
+(defn generic-profile-handler [session nick date msg-id
+                               func redirecter unknown]
+  (if-let [user-info (fetch-nick nick)]
+    ;; If a valid msg-id is provided, the date is ignored.
+    ;; This makes urls such as /user/bogus/5 valid.
+    (cond msg-id (if-let [msg-id (maybe-parse-int msg-id)]
+                   (func session user-info nil msg-id)
+                   (redirecter user-info))
+          ;; If an invalid date is provided, we redirect to the user's first favs page.
+          date   (if-let [date (parse-yyyy-mm-dd-date date)]
+                   (func session user-info date nil)
+                   (redirecter user-info))
+          :else (func session user-info nil nil))
+    (unknown)))
+
+;; User log
+
+(defn build-mini-profile [user-info]
+  (let [st    (fetch-template-fragment "mini_profile")
+        nick  (user-info :nick)
+        score (lookup-score nick)]
+    (doseq [a [:nick :avatar :contact :bio]]
+      (let [v (user-info a)]
+        (.setAttribute st (name a)
+                       (if (non-empty-string? v) (escape-html v)))))
+    (doto st
+      (.setAttribute "score" (comma-format score))
+      (.setAttribute "score_ent" (score-to-entity score))
+      (.toString))))
+
+;; The next-page link is generated by retrieving one additional dump,
+;; and creating a link from its date and message id.
+(defn log-next-page-link [last-msg]
+  (format "/%s/%s/%s"
+          (:nick last-msg)
+          (format-yyyy-mm-dd (:created_on last-msg))
+          (:message_id last-msg)))
+
+(defn user-log [session user-info date msg-id]
+  (let [st            (fetch-template "userlog" session)
+        logger        (make-time-logger)
+        raw-dumps     (tags/fetch-dumps
+                       :nick (:nick user-info)
+                       :user-tag-id (:user_id session)
+                       :msg-id msg-id
+                       :date (if msg-id nil date)
+                       :limit (inc *dumps-per-page*))
+        back-dumps    (if (or date msg-id)
+                        (tags/fetch-dumps
+                         :nick (:nick user-info)
+                         :msg-id msg-id
+                         :date (if msg-id nil date)
+                         :limit (inc *dumps-per-page*)
+                         :direction :forward))
+        dumps         (map process-message-for-output (take *dumps-per-page* raw-dumps))]
+    (.setAttribute st "nick" (:nick user-info))
+    (.setAttribute st "is_home" (= (:nick user-info) (:nick session)))
+    (.setAttribute st "mini_profile" (build-mini-profile user-info))
+    (if (> (count dumps) 0)
+      (.setAttribute st "dumps" dumps))
+    (.setAttribute st "prev"
+                   (if back-dumps
+                     (cond
+                      (> (count back-dumps) *dumps-per-page*) (log-next-page-link (last back-dumps))
+                      (> (count back-dumps) 1) (format "/%s/log" (:nick user-info))
+                      :else nil)))
+    (if (> (count raw-dumps) *dumps-per-page*)
+      (.setAttribute st "next" (log-next-page-link (last raw-dumps))))
+    (.setAttribute st "debug_log_items" (logger))
+    (.toString st)))
+
+(defn user-log-handler [session nick date msg-id]
+  (generic-profile-handler session nick date msg-id
+                           user-log
+                           (fn [u] (redirect-to (str "/" (:nick u))))
+                           #(resp-error "NO_USER")))
+
+;; Who faved me
+
+(def popular-dumps-qry "
+select u.nick, u.avatar, r.key, m.message_id, m.content, m.created_on, count(*) as count,
+               array_agg(u2.nick) as user_nicks,
+               array_agg(u2.avatar) as user_avs,
+               array_agg(t.created_on) as favtime,
+               (select exists (select 1 from tags
+                        where tag = 'favorite' and user_id = ? and message_id = m.message_id)) as favorited
+from users u, messages m, rooms r, tags t, users u2
+where lower(u.nick) = lower(?)
+and u.user_id = m.user_id and m.message_id = t.message_id
+and m.room_id = r.room_id and m.is_image = true and r.admin_only = false
+and t.tag = 'favorite' and t.user_id != u.user_id
+and t.user_id = u2.user_id
+group by u.nick, u.avatar, r.key, m.message_id, m.content, m.created_on
+order by count desc limit ? offset ?")
+
+(def num-popular-dumps 40)
+
+(defn get-popular-dumps [nick user-id]
+  (for [d (do-select [popular-dumps-qry user-id nick 40 0])]
+    (let [fav-nicks (.getArray (:user_nicks d))]
+      (assoc d
+	:favers (sort-by :t (comp #(* -1 %) compare)
+			 (map (fn [n a t] (if (non-empty-string? a)
+					    {:nick n :avatar a :t t}
+					    {:nick n :t t}))
+			      fav-nicks
+			      (.getArray (:user_avs d))
+			      (.getArray (:favtime d))))
+	:user_nicks nil :user_avs nil :favtime nil))))
+
+(defn popular [session profile-nick]
+  (if-let [user-info (fetch-nick profile-nick)]
+    (let [st            (fetch-template "popular" session)
+	  profile-nick  (:nick user-info)
+	  raw-dumps     (get-popular-dumps profile-nick (or (:user_id session) -1))
+	  dumps         (map process-message-for-output raw-dumps)]
+      (.setAttribute st "nick" profile-nick)
+      (.setAttribute st "mini_profile" (build-mini-profile user-info))
+      (.setAttribute st "dumps" dumps)
+      (.toString st))
+    (resp-error "NO_USER")))
+
+;; Directory
+
+(def *per-directory-page* 25)
+
+(defn process-directory-entry [entry]
+  (let [score (lookup-score (:nick entry))]
+    (assoc (stringify-and-escape entry)
+      "score_ent" (score-to-entity score)
+      "score"     score)))
+
+(defn recent-posts-query [user-id]
+  (format "
+SELECT    u.user_id, u.nick, u.avatar,
+          m.content, m.message_id%s
+FROM      users u
+LEFT JOIN messages m on m.message_id =
+           (SELECT message_id FROM messages
+            WHERE user_id = u.user_id
+            AND is_image
+            AND room_id IN (SELECT room_id from rooms where admin_only = false)
+            ORDER BY created_on desc LIMIT 1)
+WHERE  u.user_id = ANY(?)"
+          (if user-id
+            (format
+             ",
+          EXISTS (SELECT 1 FROM tags
+                  WHERE tag = 'favorite' AND user_id = %s AND message_id = m.message_id) AS favorited"
+             user-id)
+            ", false AS favorited")))
+
+(defn lookup-recent-posts [user-tag-id user-ids]
+  (do-select [(recent-posts-query user-tag-id)
+              (sql-array "int" user-ids)]))
+
+(defn lookup-recent-posts-tagless [user-tag-id user-ids]
+  (do-select [(recent-posts-query nil)
+              (sql-array "int" user-ids)]))
+
+(def directory-cache-ttl (minutes 10))
+(def memoized-lookup-recent-posts-tagless
+     (ttl-memoize lookup-recent-posts-tagless directory-cache-ttl))
+  
+
+(defn add-recent-posts [user-id users]
+  (if-not (empty? users)
+    (let [f    (if user-id lookup-recent-posts lookup-recent-posts-tagless)
+          res  (f user-id (map :user_id users))]
+      (for [u users]
+        (merge u (find-first #(= (:user_id u) (:user_id %)) res))))))
+
+(defn get-directory-info [user-id offset]
+  (map process-directory-entry
+       (add-recent-posts user-id
+        (get-user-ranking offset *per-directory-page*))))
+    
+(defn directory [session offset]
+  (let [st     (fetch-template "directory" session)
+        users  (get-directory-info (:user_id session) offset)]
+    (.setAttribute st "users" users)
+    (cond (= offset 0) (.setAttribute st "prev" false)
+          (= offset 1) (.setAttribute st "prev" "")
+          :else (.setAttribute st "prev" (str "/" (dec offset))))
+    (if (> offset 0)
+      (.setAttribute st "cur" offset))
+    (.setAttribute st "next" (str "/" (inc offset)))
+    (.toString st)))
+
+;; Single posts
+
+(defn single-message [session nick-from-url id-from-url]
+  (if-let [user-info (fetch-nick nick-from-url)]
+    (if-let [message (fetch-public-message-by-id id-from-url)]
+      ; error if nick in url doesn't match the nick who posted the message from the id in url 
+      ; this prevents people from scraping all the content by incrementing the id in the url
+      (if (= (user-info :user_id) (message :user_id))
+        (let [st (fetch-template "single_message" session)
+              message (tags/add-favorited-flag message session)
+              message (tags/remove-tags-for-output message)]
+          (.setAttribute st "dump" (process-message-for-output message))
+          (.toString st))
+        (resp-error "NO_MESSAGE"))
+      (resp-error "NO_MESSAGE"))
+    (resp-error "NO_USER")))
+
+
+;; Chat
+
+(defn validate-room-access [room-key session]
+  (if-let [room (lookup-room room-key)]
+    (or (not (room :admin_only))
+	(is-vip? session))))
+
+(def default-room-template "chat")
+
+(defn lookup-room-template [session room-key template]
+  (or (fetch-template (str "rooms/" (or template room-key)) session)
+      (fetch-template (str "rooms/" default-room-template) session)))
+
+(defn chat [session room template]
+  (if-let [st (lookup-room-template session (:key room) template)]
+    (let [now              (System/currentTimeMillis)
+	  nick             (session :nick)
+	  raw-msgs         (reverse (tags/fetch-dumps :room (:key room)
+                                                      :image-only false
+                                                      :user-tag-id (:user_id session)
+                                                      :hide-vip false
+                                                      :limit (:history_size room)))
+	  message-list     (to-array (map process-message-for-output raw-msgs))]
+      (if nick
+	(dosync
+	 (login-user (user-struct-from-session session) room)))
+      (doto st
+	(.setAttribute "users" (prepare-user-list room true))
+	(.setAttribute "messages" message-list)
+	(.setAttribute "roomkey" (room :key))
+	(.setAttribute "isadminroom" (room :admin_only))
+	(.setAttribute "json_room_key" (json-str (room :key)))
+	(.setAttribute "json_user_nick" (if nick (json-str nick) "null"))
+	(.setAttribute "roomname" (room :name))
+	(.setAttribute "dis" (= (room :name) "dis"))
+	(.setAttribute "timestamp" now))
+      (.toString st))
+    [404 "UNKNOWN PAGE"]))
+
+(defn validated-chat
+  ([session room-key] (validated-chat session room-key nil))
+  ([session room-key template]
+     (let [room-key   (if (= (lower-case room-key) "www") *default-room* room-key)]
+       (if (validate-room-access room-key session)
+	 (chat session (lookup-room room-key) template)
+	 (resp-error "UNKNOWN_ROOM")))))
+
+(defn refresh [session params room]
+  (dosync
+   (let [now      (System/currentTimeMillis)
+         old-ts   (new Date (maybe-parse-long (params :since) now))
+         nick     (session :nick)
+         users    (room :users)]
+     (if nick
+       (if-let [user-info (@users nick)]
+         ; Incorporate avatar updates
+	 (commute users assoc nick (merge user-info {:last-seen now
+						     :avatar    (session :avatar)}))
+	 (commute users assoc nick (user-struct-from-session session))))
+     (resp-success (assoc (updates nick room old-ts)
+		          :timestamp now)))))
+
+(defn validated-refresh [session params]
+  (let [room-key (params :room)
+        room (lookup-room room-key)]
+    (if (validate-room-access room-key session)
+      (refresh session params room)
+      (resp-error "UNKNOWN_ROOM"))))
+
+;; admins can post arbitrary html if wrapped in <safe>
+;; this is temporary so that i can test generating html messages
+(defn validated-content [content session]
+  (if (.startsWith content "<safe>")
+      (if (is-vip? session)
+          (str content)
+          (str "<unsafe>" content "</unsafe>"))
+      (str content)))
+
+(defn msg-db [user-id room-id content]
+  (let [msg-type (classify-msg content)
+        is-image (boolean (#{:image :mixed} msg-type))
+        is-text  (boolean (#{:mixed :text} msg-type))
+	qry      (str "INSERT INTO messages (user_id, room_id, content, is_image, is_text) "
+		      "VALUES (?, ?, ?, ?, ?) RETURNING message_id")]
+    (with-connection *db*
+      ((first (do-select [qry user-id room-id content is-image is-text]))
+       :message_id))))
+
+(defn msg [session params]
+   (let [user-id      (session :user_id)
+         mute         (get (poll *active-mutes*) user-id)
+         nick         (session :nick)
+         room-key     (params :room)
+         room         (lookup-room room-key)
+         content      (.trim (params :content))]
+     (cond (not room) (resp-error "BAD_ROOM")
+           (not nick) (resp-error "NOT_LOGGED_IN")
+           mute       (resp-error (format-mute mute))
+           :else
+	   (let [content  (validated-content content session)
+	         msg-id (msg-db user-id (room :room_id) content)]
+	     (dosync
+              (if (not (contains? (ensure (room :users)) nick))
+                (login-user (user-struct-from-session session) room))
+              (add-message (build-msg nick content msg-id) room))
+	     (resp-success msg-id)))))
+
+
+(defn validated-msg [session params request]
+  (cond
+   (not (validate-room-access (params :room) session)) (resp-error "UNKNOWN_ROOM")
+   :else (msg session params)))
+
+;; Browser
+
+;; TODO: make work for all rooms
+(defn browser [session]
+  (let [room  (lookup-room *default-room*)
+        now   (System/currentTimeMillis)
+        nick  (session :nick)
+        st    (fetch-template "browser" session)]
+    (if nick
+      (dosync
+       (login-user (user-struct-from-session session) room)))
+    (let [user-list (prepare-user-list room false)]
+      (.setAttribute st "users" user-list))
+    (.setAttribute st "roomkey" (room :key))
+    (.setAttribute st "isadminroom" (room :admin_only))
+    (.setAttribute st "json_room_key" (json-str (room :key)))
+    (.setAttribute st "json_user_nick" (if nick (json-str nick) "null"))
+    (.setAttribute st "roomname" (room :name))
+    (.setAttribute st "timestamp" now)
+    (.toString st)))
+
+
+;; Chat Log
+
+(defn log [session room offset params]
+  (let [roomkey     (room :key)
+        st          (fetch-template "log" session)
+        logger      (make-time-logger)
+	offset      (maybe-parse-int offset 0)
+        dump-offset (* offset *dumps-per-page*)
+        image-only  (and (not (room :admin_only))
+                         (not= (params :show) "all"))
+        raw-dumps   (logger tags/fetch-dumps-by-room :room-id (room :room_id)
+                            :image-only image-only
+                            :amount (+ 1 *dumps-per-page*)
+                            :offset dump-offset)
+        dumps       (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session))
+        ;;   json-tags (for [dump dumps :when (not (empty? (dump :tags)))] 
+        ;;               (json-str {"id" (dump :message_id) "tags" (dump :tags) }))
+        dumps       (map tags/remove-tags-for-output dumps)
+        dumps       (logger doall (map process-message-for-output dumps))]
+    (if (> (count raw-dumps) *dumps-per-page*)
+      (.setAttribute st "next" (inc offset)))
+    (if (not= offset 0)
+      (.setAttribute st "prev" (max (dec offset) 0)))
+    (.setAttribute st "dumps" dumps)
+    (if (default-room? roomkey)
+      (.setAttribute st "roomkey" "")
+      (.setAttribute st "roomkey" (str roomkey ".")))
+    (.setAttribute st "roomname" (room :name))
+    (.setAttribute st "debug_log_items" (logger))
+    (.toString st)))
+
+(defn validated-log [session room-key offset params]
+  (if-vip
+   (let [room-key (if (= (lower-case room-key) "www") "dumpfm" room-key)]
+     (if (validate-room-access room-key session)
+       (log session (lookup-room room-key) offset params)
+       (resp-error "UNKNOWN_ROOM")))
+   (redirect-to "http://dump.fm")))
+
+;; Hiscore test... redis test...
+
+(defn redis-ids-test [period]
+  (let [reddis-server  {:host "127.0.0.1" :port 6379 :db 0}
+        ids            (redis/with-server reddis-server 
+                         (redis/zrevrange (str "hiscore:" period) 0 -1))
+        ids            (map maybe-parse-int ids)]
+    ids))
+
+(defn hiscore-test [session params period]
+  (let [st     (fetch-template "hiscore_test" session)
+        dumps  (tags/fetch-dumps-by-ids (redis-ids-test period))
+        dumps  (map tags/add-favorited-flag dumps (repeat session))
+        dumps  (map tags/add-fav-count dumps)
+        dumps  (reverse (sort-by :favcount dumps))
+        dumps  (map tags/remove-tags-for-output dumps)
+        dumps  (map process-message-for-output dumps)]
+    (.setAttribute st "dumps" dumps)
+    (.toString st)))
+        
+
+
+;; Altars
+
+;; if :nick is in params, will fetch only altars by that nick
+;; next page links look like /altars/message-id and select <= message_id order desc
+;; prev page links look like /altars/-message-id and select > message_id order asc
+(defn altar-log [session params]
+  (let [id         (params :id)
+        nick       (params :nick)
+        user-id    (if nick (user-id-from-nick nick) nil)
+        template   (if user-id "altar_user_log" "altar_log")
+        st         (fetch-template template session)
+        raw-dumps  (tags/fetch-altars :message-id id :amount (+ 1 *dumps-per-page*) :user-id user-id)
+        dumps      (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session))
+        dumps      (map tags/remove-tags-for-output dumps)
+        dumps      (map process-message-for-output dumps)]
+    (.setAttribute st "dumps" dumps)
+    (.setAttribute st "nick" nick)
+    (if (> (count raw-dumps) *dumps-per-page*)
+      (.setAttribute st "next" ((last raw-dumps) :message_id)))
+    (if id
+      (.setAttribute st "prev" ((first raw-dumps) :message_id)))
+    (.toString st)))
+
+;; Tags 
+
+(defn undecoded-url-piece [url position]
+  "Get nth thing out of a url path.
+  For example, (undecoded-url-piece 'http://example.com/a/b/c?foo' 2) will return 'c'"
+  (let [path-without-domain (nth (re-find #"//[^/]+/(.+)" url) 1)]
+    (nth (re-split #"/|\?" path-without-domain) position)))
+
+(defn add-tag [user msg tag]
+  (try
+   (do-insert "tags" 
+              ["user_id" "message_id" "tag"]
+              [(:user_id user) (msg :message_id) tag])
+   (if (and (= tag "favorite")
+            (not (= (msg :nick) (user :nick))))
+     (insert-fav-notification! (msg :nick)
+                               (user :nick)
+                               (user :avatar)
+                               (msg :content)))
+   true
+    ; catch error when inserting duplicate tags
+   (catch Exception e false)))
+
+
+(defn validated-add-tag [session params]
+  (if (session :nick)
+    (let [nick          (session :nick)
+          user-id       (session :user_id)
+          user-admin?   (session :admin-only)
+          msg-id        (params :message_id)
+          tag           (validate-tag (params :tag))
+          msg           (fetch-message-by-id msg-id)
+          access        (or (is-vip? session)
+                            (not (:admin-only msg)))]
+      (cond (not msg)      (resp-error "NO_MSG")
+            (not access)   (resp-error "NO_MSG")
+            (not tag)      (resp-error "NO_TAG")
+            :else (if (add-tag session msg tag)
+                    (resp-success "OK")
+                    (resp-error "TAG_EXISTS_ALREADY_OR_SOMETHING_ELSE_IS_FUCKED"))))
+    (resp-error "NO_USER")))
+
+(defn remove-tag [user-id message-id tag]
+  (let [query "user_id = ? AND message_id = ? AND lower(tag) = ?"]
+       (do-delete "tags" [query user-id (maybe-parse-int message-id) (normalize-tag-for-db (.toLowerCase tag))])
+       (resp-success "OK")))
+
+(defn validated-remove-tag [session params]
+  (if (session :nick)
+     (remove-tag (session :user_id) (params :message_id) (params :tag))
+     (resp-error "NO_USER")))
+
+;; message-user-id: get messages posted by this user
+;; tag-user-id: get messages tagged by this user
+(defnk tagged-dumps-template [session params tags url page-title info-bar
+                              :message-user-id false
+                              :tag-user-id false
+                              :logger (make-time-logger)
+                              :include-vip false]
+  (let [st (fetch-template "tagged_dumps" session)
+	      offset (maybe-parse-int (params :offset) 0)
+        dump-offset (* offset *dumps-per-page*)
+        raw-dumps (logger tags/fetch-dumps-by-tag :tags tags 
+                                                  :image-only false 
+                                                  :amount (+ 1 *dumps-per-page*)
+                                                  :offset dump-offset
+                                                  :message-user-id message-user-id
+                                                  :tag-user-id tag-user-id
+                                                  :include-vip include-vip)
+        dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session))
+        dumps (map tags/remove-tags-for-output dumps)
+        dumps (logger doall (map process-message-for-output dumps))]
+    (.setAttribute st "dumps" dumps)
+    (.setAttribute st "infobar" info-bar)
+    (.setAttribute st "page_title" page-title)
+    (.setAttribute st "page_url" url)
+    (if (not= offset 0)
+      (.setAttribute st "prev" (format "/%s/%s" url (max 0 (dec offset)))))
+    (if (> (count raw-dumps) *dumps-per-page*)
+      (.setAttribute st "next" (format "/%s/%s" url (inc offset))))
+    (.setAttribute st "debug_log_items" (logger))
+    (.toString st)))
+
+;; gotta parse tag intersections myself because +'s get decoded into spaces
+;; there's probably a less hacky way to do this
+(defn tagged-dumps-by-nick [session params url]
+  (let [nick (params :nick)
+	user-id (user-id-from-nick nick)
+	user-info (fetch-nick nick)
+	info-bar (build-mini-profile user-info)
+        tags (map url-decode (re-split #"\+" (undecoded-url-piece url 2)))
+        url (str nick "/tag/" (str-join "+" (map url-encode tags)))
+        page-title (str "dumps " nick " tagged as '" (escape-html (str-join "' and '" tags)) "'")]
+    (tagged-dumps-template session params tags url page-title info-bar :tag-user-id user-id)))
+
+(defn tagged-dumps [session params url]
+  (let [tags (map url-decode (re-split #"\+" (undecoded-url-piece url 1)))
+        url (str "tag/" (str-join "+" (map url-encode tags)))
+        page-title (str "dumps tagged as '" (escape-html (str-join "' and '" tags)) "'")]
+    (tagged-dumps-template session params tags url page-title "")))
+
+(defn favorites-next-page-link [nick last-msg]
+  (format "/%s/favorites/%s/%s"
+          nick
+          (format-yyyy-mm-dd (:tagged_on last-msg))
+          (:message_id last-msg)))
+
+(defn favorites [session user-info date msg-id]
+  (let [st            (fetch-template "tagged_dumps" session)
+        logger        (make-time-logger)
+        raw-dumps     (tags/fetch-tagged-dumps
+                       :nick (:nick user-info)
+                       :user-tag-id (:user_id session)
+                       :msg-id msg-id
+                       :date (if msg-id nil date)
+                       :limit (inc *dumps-per-page*))
+        back-dumps    (if (or date msg-id)
+                        (tags/fetch-tagged-dumps
+                         :nick (:nick user-info)
+                         :msg-id msg-id
+                         :date (if msg-id nil date)
+                         :limit (inc *dumps-per-page*)
+                         :direction :forward))
+        dumps         (map process-message-for-output (butlast raw-dumps))]
+    (.setAttribute st "prev"
+                   (if back-dumps
+                     (cond
+                      (> (count back-dumps) *dumps-per-page*) (favorites-next-page-link (:nick user-info)
+                                                                                        (last back-dumps))
+                      (> (count back-dumps) 1) (format "/%s/favorites" (:nick user-info))
+                      :else nil)))
+    (if (> (count raw-dumps) *dumps-per-page*)
+      (.setAttribute st "next" (favorites-next-page-link (:nick user-info) (last raw-dumps))))
+    (.setAttribute st "dumps" dumps)
+    (.setAttribute st "infobar" (build-mini-profile user-info))
+    (.setAttribute st "page_title" (format "%s'S FAVS" (:nick user-info)))
+    (.setAttribute st "debug_log_items" (logger))
+    (.toString st)))
+
+(defn favorites-handler [session nick date msg-id]
+  (generic-profile-handler session nick date msg-id
+                           favorites
+                           (fn [u] (redirect-to (format "/%s/favorites" (:nick u))))
+                           #(resp-error "NO_USER")))                       
+
+(defn json-favorites [session params]
+  (let [nick (params :nick)
+        user-id (user-id-from-nick nick)
+        raw-favs (tags/fetch-tagged-dumps :nick nick
+                                          :limit 50)
+        favs (reduce (fn [m fav] (assoc m (str (fav :message_id)) (fav :content))) {} raw-favs)]
+    (str "RawFavs=" (json-str favs))))
+
+(defn search-query [num-tokens]
+  (str "select 
+  url from image_urls
+  where url ilike " (str-join " and url ilike " (take num-tokens (repeat "?"))) "
+  order by last_posted desc 
+  limit 200;"))
+
+;; note: _ is a wildcard in a postgres 'like' query... 
+(defn search-replace-weird-chars [token]
+  (str (.replaceAll token "[^A-Za-z0-9\\-.=+]" "_"))
+)
+
+;; timb: this can be called with a callback or not...
+;; 
+;; dump.fm/cmd/search/foo -> [result, result]
+;; cons: can only be ajax get'd from the same domain
+;; 
+;; dump.fm/cmd/search/foo?callback=someFunc -> someFunc([result, result])
+;; cons: has to use a <script> tag. seems to freeze browser until results returned
+;; 
+(defn json-search [undecoded-url-searchterms params]
+   (let [tokens (map url-decode (re-split #"\+" undecoded-url-searchterms))
+         tokens (map search-replace-weird-chars tokens)
+	       tokens (map #(str "%" %1 "%") tokens)
+	       query (search-query (count tokens))
+	       rows (do-select (vec (concat [query] tokens)))]
+	    (if (:callback params) 
+	      (str (:callback params) "(" (json-str rows) ")")
+	      (json-str rows))))
+
+
+;; Local testing
+
+(def random-posts
+     ["http://24.media.tumblr.com/tumblr_l41x4eLWZm1qzon5ko1_400.png hi"
+      "lol http://29.media.tumblr.com/tumblr_l3o3wuRFpM1qawuaao1_500.jpg"
+      "http://dump.fm/images/20100819/1282199186063-dumpfm-timb-dump.stone.logo.gif http://teamassignment.com/images/getmesomemore.jpg http://26.media.tumblr.com/tumblr_l7kro0os531qaajkio1_500.gif"])
+
+(defn make-random-post! []
+  (msg {:user_id 1
+        :nick "scottbot"
+        :avatar "http://i.imgur.com/isKqZ.gif"}
+       {:room "dumpfm"
+        :content (rand-elt random-posts)}))
+
+(def random-poster
+     (scheduled-agent make-random-post! 5 nil))
+  
+;; Account resets
+
+(defn reset-request-page [session]
+  (.toString (fetch-template "req_reset" session)))
+
+(defn reset-request! [session {nick :nick}]
+  (if-let [info   (fetch-nick nick)]
+    (let [nick   (info :nick) ; get correct casing
+	  email  (info :email)
+          hash   (info :hash)
+          ts     (System/currentTimeMillis)
+          token  (reset-token nick hash ts)
+          link   (reset-link nick token ts)]
+      (do (send-reset-email nick email link)
+          (resp-success "OK")))
+    (resp-error "NO_NICK")))
+
+(defn reset-page [session params]
+  (let [st    (fetch-template "reset" session)
+        nick  (params :nick)
+        ts    (maybe-parse-long (params :ts) 0)
+        token (params :token)
+        valid (valid-reset-link? nick token ts)]
+    (if (and (zero? ts)
+             (nil? nick)
+             (nil? token))
+      (reset-request-page session)
+      (do
+        (.setAttribute st "valid_request" valid)
+        (.setAttribute st "nick" nick)
+        (when valid
+          (.setAttribute st "link" (reset-link nick token ts)))
+        (.toString st)))))
+
+(defn reset-account! [session params]
+  (let [nick   (params :nick)
+        ts     (maybe-parse-long (params :ts) 0)
+        token  (params :token)
+        hash   (params :hash)]
+    (if (and (valid-reset-link? nick token ts) hash)
+      (let [info (fetch-nick nick)]
+        (update-nick-hash nick hash)
+        [(session-assoc-from-db info)
+         (redirect-to "http://dump.fm/")])
+      [200 "BAD_REQUEST"])))
+
+;; Upload
+
+(def max-avatar-dimensions [800 800])
+(def max-avatar-size (kbytes 500))
+
+(defn is-file-too-big? [f limit]
+  (if (> (.length f) limit)
+    (str "FILE_TOO_BIG " limit)))
+
+(defn invalid-image-dimensions? [f [max-width max-height]]
+  (try
+    (let [i (ImageIO/read f)
+          height (.getHeight i)
+          width (.getWidth i)]
+      (if (or (> width max-width)
+              (> height max-height))
+        (str "INVALID_RESOLUTION "  max-width " " max-height)))
+    (catch Exception _ "INVALID_IMAGE")))
+
+(defn format-filename [s nick]
+  (let [spaceless (.replace s \space \-)
+        nick-clean (re-gsub #"[^A-Za-z0-9]" "" nick)
+        subbed (re-gsub #"[^\w.-]" "" spaceless)]
+    (str-join "-" [(System/currentTimeMillis) "dumpfm" nick-clean subbed])))
+
+(defn image-url-from-file [dir date file]
+  (str-join "/" [*server-url* dir date (.getName file)]))
+
+(defn validate-upload-file [f room]
+  (or (is-file-too-big? f (:max_file_size room))
+      (invalid-image-dimensions? f [(:max_image_width room)
+                                    (:max_image_height room)])))
+
+(defn validate-avatar-file [f]
+  (or (is-file-too-big? f max-avatar-size)
+      (invalid-image-dimensions? f max-avatar-dimensions)))
+
+
+; Upload notes:
+; The webcam code doesn't feature an error handler,
+; so all upload responses not equal to "OK" are considered
+; errors.
+; The upload code doesn't use jQuery.ajax, and doesn't JSON-eval
+; responses. Therefore, return strings should not be JSON-encoded.
+
+(defn do-upload [session image room]
+  (if-let [err (validate-upload-file (image :tempfile) room)]
+    (resp-error err)
+    (let [filename (format-filename (:filename image) (session :nick))
+          date (today)
+          dest (open-file [*image-directory* date] filename)
+          url (image-url-from-file "images" date dest)
+          msg-id (msg-db (session :user_id) (room :room_id) url)
+          msg (struct message-struct (session :nick) url (new Date) msg-id)]
+      (do 
+        (dosync
+         (add-message msg room))
+        (copy (:tempfile image) dest)
+        [200 "OK"]))))
+
+(defn upload [session params request]
+  (let [room-key   (params :room)
+        nick       (session :nick)
+        user-id    (session :user_id)
+        image      (params :image)
+        mute       (get (poll *active-mutes*) user-id)
+        has-access (validate-room-access room-key session)]
+    (cond (not nick)       [200 "NOT_LOGGED_IN"]
+          (not image)      [200 "INVALID_REQUEST"]
+          mute             [200 (format-mute mute)]
+          (not has-access) [200 "UNKNOWN_ROOM"]
+          :else (do-upload session image (lookup-room room-key)))))
+
+(defn upload-photo [session params]
+  (let [room-key   (params :room)
+        nick       "~photobot"
+        user-id    (rooms/fetch-or-create-bot-id! nick)
+        image      (params :image)]
+    (do-upload {:is_admin true :nick nick :user_id user-id} image (lookup-room room-key))))
+
+;; N.B. -- Upload responses aren't JSON-evaluated
+(defn do-upload-avatar [session image]
+  (let [filename (format-filename (:filename image) (session :nick))
+        date (today)
+        dest (open-file [*avatar-directory* date] filename)
+        url (image-url-from-file "avatars" date dest)]
+    (do
+      (copy (:tempfile image) dest)
+      (update-user-db (session :user_id) "avatar" url)
+      [(session-assoc :avatar url)
+       [200 url]])))
+
+(defn upload-avatar [session params]
+  (let [image (params :image)]
+    (cond (not image)           [200 "INVALID_REQUEST"]
+          (not (session :nick)) [200 "NOT_LOGGED_IN"]
+          :else (if-let [err (validate-avatar-file (:tempfile image))]
+		  [200 err]
+		  (do-upload-avatar session image)))))
+
+(defn serve-meme [session meme]
+  (if-let [st   (fetch-template meme session)]
+    (let [now  (System/currentTimeMillis)]
+      (.setAttribute st "timestamp" now)
+      (.toString st))
+    (unknown-page)))
+
+(defn hall-of-fame [session]
+  (let [st   (fetch-template "fame" session)
+	msgs (add-user-favs-to-msgs (poll hall-results)
+				    (session :user_id))]
+    (.setAttribute st "dumps" (map process-message-for-output msgs))
+    (.toString st)))
+
+;; MGMT logic
+
+(def mgmt-pw "idontgetit")
+
+(defn mgmt [session pw]
+  (if (= (and pw (lower-case pw)) mgmt-pw)
+    (validated-chat session "mgmt" "chat")
+    (validated-chat session "mgmt")))
+
+;; Compojure Routes
+
+(defn serve-static [dir path]
+  (if (= path "")
+    (redirect-to "http://dump.fm")
+    (serve-file dir path)))
+
+(defroutes static
+  (GET "/static/*"  (serve-static "static" (params :*)))
+  (GET "/images/*"  (serve-static *image-directory* (params :*)))
+  (GET "/avatars/*" (serve-static *avatar-directory* (params :*)))
+;; irl
+  (GET "/irl"      (redirect-to "/irl/"))
+  (GET "/irl/"     (serve-static "static/319"  "index.html"))
+  (GET "/irl/*"    (serve-static "static/319"  (params :*)))
+  (GET "/irl2"     (redirect-to "/irl2/"))
+  (GET "/irl2/"    (serve-static "static/319"  "res.html"))
+  (GET "/irl2/*"   (serve-static "static/319" (params :*)))
+  (GET "/irlhell"  (redirect-to "/irhell/"))
+  (GET "/irhell"   (redirect-to "/irhell/"))
+  (GET "/irhell/"  (serve-static "static/319"  "irhell.html"))
+  (GET "/irhell/*" (serve-static "static/319"  (params :*))))
+
+
+
+(defroutes pichat
+  (GET "http://:sub.dump.fm/"     (validated-chat session (params :sub)))
+  (GET "http://:sub.dump.fm/chat" (validated-chat session (params :sub)))
+  (GET "http://:sub.dump.fm/chat" (validated-chat session (params :sub) (params :t)))
+  (GET "/:room/chat"              (validated-chat session (params :room)))
+  (GET "/chat"                    (validated-chat session *default-room*))
+  (GET "/chat/:t"                 (validated-chat session *default-room* (params :t)))
+
+  (GET "http://:sub.dump.fm/log"         (validated-log session (params :sub) "0" params))
+  (GET "http://:sub.dump.fm/log/:offset" (validated-log session (params :sub) (params :offset) params))
+  (GET "/log"                            (validated-log session *default-room* "0" params))
+  (GET "/log/:offset"                    (validated-log session *default-room* (params :offset) params))
+  (GET "/r/:room/log"                      (validated-log session (params :room) "0" params))
+  (GET "/r/:room/log/:offset"              (validated-log session (params :room) (params :offset) params))
+
+  (GET "/favicon.ico" (serve-static "static" "favicon.ico"))
+  (GET "/u/:nick"  (redirect-to (str "/" (params :nick))))
+  (GET "/u/:nick/" (redirect-to (str "/" (params :nick))))
+  (GET "/u/:nick/tag/:tag" (tagged-dumps-by-nick session params (request-url request)))
+  (GET "/u/:nick/tag/:tag/:offset" (tagged-dumps-by-nick session params (request-url request)))
+  (GET "/u/:nick/favorites" (redirect-to (format "/%s/favorites" (params :nick))))
+  (GET "/u/:nick/favorites/:offset" (redirect-to (format "/%s/favorites" (params :nick))))
+  (GET "/json/:nick/favorites" (json-favorites session params))
+  
+  ; have to put this route after favs
+  (GET "/u/:nick/:offset" (redirect-to (str "/" (params :nick))))
+  
+  (GET "/p/:nick/:postid" (single-message session (params :nick) (params :postid)))
+
+  ;; TODO: delete GET routes very shortly
+  (GET "/login" (login session params cookies request))
+  (POST "/login" (login session params cookies request))
+  (GET "/logout" (logout session))
+  (POST "/logout" (logout session))
+  (GET "/register" (serve-static "static" "register.html"))
+  (GET "/registerdis" (serve-static "static" "registerdis.html"))
+  (GET "/browser" (browser session))
+  (GET "/refresh" (validated-refresh session params))
+  (GET "/tag/:tag" (tagged-dumps session params (request-url request)))
+  (GET "/tag/:tag/:offset" (tagged-dumps session params (request-url request)))
+  (POST "/cmd/tag/add" (validated-add-tag session params))
+  (POST "/cmd/tag/rm" (validated-remove-tag session params))
+
+  ;; Altars
+  (GET "/altars" (altar-log session params))
+  (GET "/altars/" (altar-log session params))
+  (GET "/altars/:id" (if (maybe-parse-int (params :id) false)
+                         (altar-log session params)
+                         (redirect-to (str "/" (params :id) "/altars")))) ;; redirect /altars/timb to /timb/altars
+
+  ;; testing
+  (GET "/test/hiscores" (hiscore-test session params "week"))
+  (GET "/test/hiscores/alltime" (hiscore-test session params "all"))
+  (GET "/test/hiscores/day" (hiscore-test session params "day"))
+  (GET "/test/hiscores/week" (hiscore-test session params "week"))
+  (GET "/test/hiscores/month" (hiscore-test session params "month"))
+  
+  (GET "/mgmt" (mgmt session nil))
+  (GET "/mgmt/:pw" (mgmt session (:pw params)))
+
+  ;; Events
+;  (GET "/event" (event-page session))
+;  (GET "/event/proxy" (image-proxy session params request))
+;  (POST "/event/submit" (submit! session params request))
+
+       ;; Fullscreen
+  (GET "/fullscreen" (serve-meme session "fullscreen"))
+
+  ;; TODO: add form tokens for all destructive actions
+  (POST "/msg" (validated-msg session params request))
+  (POST "/submit-registration" (register session params request))
+  (POST "/update-profile" (update-profile session params))
+  (GET "/directory" (directory session 0))
+  (GET "/directory/:offset"
+       (directory session (maybe-parse-int (params :offset) 0)))
+  (GET "/reset-request" (reset-request-page session))
+  (POST "/reset-request" (reset-request! session params))
+  (GET  "/reset" (reset-page session params))
+  (POST "/reset" (reset-account! session params))
+
+  ;; Admin stuff (should be own route?)
+  (GET  "/debug" (debug-page session flash))
+  (POST "/debug" (debug-commmand! session params))
+  (GET  "/mutes" (show-mutes session))
+  (GET  "/roomlist" (show-rooms session))
+  (POST "/mute" (mute! session params))
+  (POST "/cancel-mute" (handle-cancel-mute! session params))
+  (GET  "/profile-test/:t" (profile session "ryder" (params :t)))
+  (GET  "/reports"       (list-reports-dir session))
+  (GET  "/reports/:file" (show-report session (params :file)))
+
+  (GET "/cmd/search/:searchterm" (json-search (undecoded-url-piece (request-url request) 2) params))
+  (GET "/search" (serve-template "search_files" session))
+
+  ;; Memes
+  (GET "/m/:m" (serve-meme session (params :m)))
+  (GET "/hall" (hall-of-fame session))
+
+  ;; Store
+  (GET "/stickers" (serve-static "static" "sticker.html"))
+  
+  ;; Footer pages
+  (GET "/about_us" (serve-template "about_us" session))
+  (GET "/goodies" (serve-template "goodies" session))
+  (GET "/help" (serve-template "help" session))
+  (GET "/privacy" (serve-template "privacy" session))
+  (GET "/terms" (serve-template "terms" session))
+  (GET "/error/ie" (serve-template "error_ie" session))
+
+  ;; Put username routes below all others in priority
+  (GET "/:nick"           (profile session (params :nick)))
+  (GET "/:nick/"          (profile session (params :nick)))
+  (GET "/:nick/altars"     (altar-log session params))
+  (GET "/:nick/altars/"    (altar-log session params))
+  (GET "/:nick/altars/:id" (altar-log session params))
+  (GET "/:nick/tag/:tag" (tagged-dumps-by-nick session params (request-url request)))
+  (GET "/:nick/tag/:tag/:offset" (tagged-dumps-by-nick session params (request-url request)))
+  (GET "/:nick/favorites" (favorites-handler session (params :nick) nil nil))
+  (GET "/:nick/favorites/" (favorites-handler session (params :nick) nil nil))
+  (GET "/:nick/favorites/:date" (favorites-handler session (params :nick) (params :date) nil))
+  (GET "/:nick/favorites/:date/" (favorites-handler session (params :nick) (params :date) nil))
+  (GET "/:nick/favorites/:date/:msg" (favorites-handler session (params :nick) (params :date) (params :msg)))
+  (GET "/:nick/favs" (favorites-handler session (params :nick) nil nil))
+  (GET "/:nick/favs/:date" (favorites-handler session (params :nick) (params :date) nil))
+  (GET "/:nick/favs/:date/:msg" (favorites-handler session (params :nick) (params :date) (params :msg)))
+  (GET "/:nick/popular" (popular session (params :nick)))
+  (GET "/:nick/log"        (user-log-handler session (params :nick) nil nil))
+  (GET "/:nick/log/"        (user-log-handler session (params :nick) nil nil))
+  (GET "/:nick/:date"      (user-log-handler session (params :nick) (params :date) nil))
+  (GET "/:nick/:date/"      (user-log-handler session (params :nick) (params :date) nil))
+  (GET "/:nick/:date/:msg" (user-log-handler session (params :nick) (params :date) (params :msg)))
+
+  (GET "/" (landing session))
+  (ANY "*" (unknown-page)))
+
+(defroutes multipart
+  (POST "/upload/message" (upload session params request))
+  (POST "/upload/photo" (upload-photo session params))
+  (POST "/upload/avatar" (upload-avatar session params)))
+
+;; Add jpeg to list
+(def mimetypes
+  {"css"  "text/css"
+   "gif"  "image/gif"
+   "gz"   "application/gzip"
+   "htm"  "text/html"
+   "html" "text/html"
+   "jpg"  "image/jpeg"
+   "jpeg" "image/jpeg"
+   "js"   "text/javascript"
+   "pdf"  "application/pdf"
+   "png"  "image/png"
+   "svg"  "image/svg+xml"
+   "swf"  "application/x-shockwave-flash"
+   "txt"  "text/plain"
+   "xml"  "text/xml"
+   "zip"  "application/zip"})
+
+(decorate static
+  (with-mimetypes {:mimetypes mimetypes}))
+
+(def *session-cookie-params* {:type :memory
+                              :expires (* 60 60)
+                              :domain *cookie-domain*})
+
+(decorate pichat
+  (with-mimetypes {:mimetypes mimetypes})
+  (with-cookie-login (comp not logged-in?) make-login-token read-login-token)
+  (with-session *session-cookie-params*))
+
+(decorate multipart
+  (with-mimetypes {:mimetypes mimetypes})
+  (with-cookie-login (comp not logged-in?) make-login-token read-login-token)
+  (with-session *session-cookie-params*)
+  (with-multipart))
+
+
+;;; Startup Code
+
+(defn start-server [port] 
+  (run-server {:port port
+               :nio  true}
+              "/static/*" (servlet static)
+              "/images/*" (servlet static)
+              "/avatars/*" (servlet static)
+              "/irl" (servlet static)
+              "/irl2" (servlet static)
+              "/irl/*" (servlet static)
+              "/irl2/*" (servlet static)
+              "/irhell" (servlet static)
+              "/irhell/*" (servlet static)
+              "/upload/*" (servlet multipart)
+              "/*" (servlet pichat)))
+
+(defn parse-command-args
+  "Parses command-line arguments. First arg is script name,
+  second arg is port number (defaults to 8080)."
+  ([script] {:port 8080})
+  ([script port] {:port (Integer/parseInt port)}))
+
+(def options 
+     (apply parse-command-args *command-line-args*))
+
+(load-rooms!)
+(start! reserved-nicks)
+(def server (start-server (options :port)))
+(start! *active-mutes*)
+
+; Delay the following to reduce start-load
+(Thread/sleep 15000)
+(start! *user-scores*)
+
+(start-user-flusher!)
+(start-session-pruner!)
+(start! hall-results)
+
+;(if (not= *server-url* "http://dump.fm")
+;  (start! random-poster))
diff --git a/src/utils.clj b/src/utils.clj
index 8ed801e..9d7fd3a 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -431,10 +431,13 @@
 (defn is-super-vip? [session]
   (contains? super-vips (:nick session)))
 
-(defmacro if-vip [e]
+(defmacro if-vip
   "Evaluates expr if user is super-vip otherwise returns 404. Can only be used
    where session is defined."
-  `(if (is-vip? ~'session) ~e (unknown-page)))
+  ([e]
+     `(if (is-vip? ~'session) ~e (unknown-page)))
+  ([e alt]
+     `(if (is-vip? ~'session) ~e ~alt)))
 
 (defmacro if-super-vip [e]
   "Evaluates expr if user is super-vip otherwise returns 404. Can only be used
@@ -475,4 +478,4 @@
   (for [[idx elt] (indexed coll) :when (pred elt)] idx))
 
 (defn index-of [pred coll]
-  (first (index-filter pred coll)))
\ No newline at end of file
+  (first (index-filter pred coll)))