path: root/src/site.clj

(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
        datalayer
        email
        fame
        message
        utils
        cookie-login
        session-sweeper
        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 (default-room? (:key m *default-room*))
    "http://dump.fm/"
    (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 viewer-nick]
  (if-let [msg (tags/fetch-dump-by-id m-id viewer-nick)]
    (if-not (:admin_only msg)
      msg)))

;; 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 front-page [session]
  (let [st        (fetch-template "frontpage" session)
        date-str  (format-yyyymmdd (Date.))
        dumps     (map process-message-for-output
                       (fetch-redis-daily-hall date-str 0 20 (:user_id session)))]
    (.setAttribute st "dumps" dumps)
    (.toString st)))

(defn landing [session]
  (front-page session))

(defn log-login [user_id ip]
  ;; i'm using do-cmds here because update-values can't deal with stuff like 'last_login = now()'
  (try
    (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))
    (catch Exception e nil)))

(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 "/")])

;; 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")])))))

;; Profile

(defn pull-random-dump-images [dumps num]
  (take num
        (shuffle
         (set (apply concat
                     (map
                      (comp take-images :content)
                      dumps))))))

(defn pull-recips [dumps]
  (set (apply concat (map #(get % "recips" []) 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          (:nick session)
             logger        (make-time-logger)
             is-home       (and nick (= nick profile-nick))
             score         (fetch-redis-favscore profile-nick)
	     dumps         (logger tags/fetch-dumps
                                   :user-tag-id (:user_id session)
				   :nick profile-nick
				   :limit 10)
             dms           (fetch-direct-messages (:user_id user-info))
             recips        (pull-recips dms)
             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))
           (when-not (empty? dms)
             (.setAttribute st "dms" dms)
             (.setAttribute st "recips" (json-str recips)))
           (if (not (empty? imgs))
	     (.setAttribute st "imgs" imgs))
	   (.setAttribute st "debug_log_items" (logger))
	   (.toString st)))
       (resp-error "NO_USER"))))

(defn update-profile [session params]
  (let [user-id   (session :user_id)
        attr      (params :attr)
        val       (params :val)
        attr-set  #{"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")
          :else (do (update-user-info! (:nick session) 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 (fetch-redis-favscore 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] (user-log session user-info date msg-id "userlog"))
  ([session user-info date msg-id template]
     (let [st            (fetch-template template 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*))
           recips        (map :nick (get-recips-from-msgs raw-dumps))
           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))
       (when (> (count dumps) 0)
         (.setAttribute st "dumps" dumps))
       (.setAttribute st "recips" (json-str recips))
       (.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

(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     (fetch-popular-dumps-redis profile-nick (:nick session))
          raw-dumps     (filter #(> (:count %) 0) raw-dumps)
          recips        (map :nick (get-recips-from-msgs raw-dumps))
	  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)
      (.setAttribute st "recips" (json-str recips))
      (.toString st))
    (resp-error "NO_USER")))

;; Directory

(def *per-directory-page* 25)

(defn process-directory-entry [entry]
  (assoc (stringify-and-escape entry)
    "score_ent" (score-to-entity (:score entry))))


(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 [res  (if user-id
                 (lookup-recent-posts user-id (map :user_id users))
                 (lookup-recent-posts-tagless (map :user_id users)))]
      (for [u users]
        (merge u (find-first #(= (:user_id u) (:user_id %)) res))))))

(defn add-recent-posts-nick [user-id users]
  (if-not (empty? users)
    (let [nicks (map :nick users)
          res   (if user-id
                  (lookup-recent-posts-by-nicks user-id nicks)
                  (lookup-recent-posts-tagless-by-nicks nicks))]
      (for [u users]
        (merge u (find-first #(= (:nick u) (:nick %)) res))))))

(defn try-execute [f n]
  (try
    (f)
    (catch Exception e
      (if (> n 0)
        (try-execute f (dec n))
        (throw e)))))

(def redis-directory-attempts 3)

(defn get-directory-info [user-id offset]
  (let [res (try-execute #(fetch-redis-directory offset *per-directory-page*)
                         redis-directory-attempts)]
    (map process-directory-entry
         (add-recent-posts-nick user-id res))))
    
(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 [message (fetch-public-message-by-id id-from-url (:nick session))]
    ; 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 (= nick-from-url (:nick message))
      (let [st (fetch-template "single_message" session)]
        (.setAttribute st "dump" (process-message-for-output message))
        (.setAttribute st "recips" (json-str (map :nick (get-recips (:content message)))))
        (.toString st))
      (resp-error "NO_MESSAGE"))
    (resp-error "NO_MESSAGE")))


;; 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)))
          recips           (map :nick (get-recips-from-msgs raw-msgs))
	  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 "recips" (json-str recips))
	(.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 [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))
         content-too-long?       (> (count content)
                                    max-content-size)]
     (cond (not room)          (resp-error "BAD_ROOM")
           (not nick)          (resp-error "NOT_LOGGED_IN")
           content-too-long?   (resp-error "TOO_LONG")
           mute                (resp-error (format-mute mute))
           :else
	   (let [content    (validated-content content session)
	         msg-info   (insert-message! user-id nick (:avatar session) room content)
                 msg-id     (:msg-id msg-info)]
	     (dosync
              (let [msg-struct (build-msg nick content msg-id (:recips msg-info))]
                (if (not (contains? (ensure (room :users)) nick))
                  (login-user (user-struct-from-session session) room))
                (add-message msg-struct room)))
             (resp-success {:msgid msg-id
                            :recips (:recips msg-info)})))))

(defn validated-msg [session params request]
  (cond
   (not (validate-room-access (params :room) session)) (resp-error "UNKNOWN_ROOM")
   :else (msg session params)))

;; Browser

(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)))


;; Topics

(defn topic [session topic]
  (let [topic  (lower-case topic)
        msgs   (map
                process-message-for-output
                (fetch-topic (:user_id session) topic))
        recips (pull-recips msgs)
        st     (fetch-template "topic" session)]
    (.setAttribute st "recips" (json-str recips))
    (.setAttribute st "topic" topic)
    (if-not (empty? msgs)
      (.setAttribute st "dumps" msgs))
    (.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 (is-vip? session)
    (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 "/")))

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

(defn redis-ids-test [period]
  (let [ids            (redis/with-server redis-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) (:message_id msg) tag])
   (when (and (= tag "favorite")
              (not (= (msg :nick) (:nick user))))
     (if-not (or (:admin_only msg) (= (:user_id user) (:user_id msg)))
       (incrby-redis-favscore! msg 1))
     (insert-fav-notification! (msg :nick)
                               (user :nick)
                               (user :avatar)
                               (msg :content)))
   true
    ; catch error when inserting duplicate tags
   (catch Exception e
     (do (println e)
         false))))


(defn validated-add-tag [session params]
  (if (session :nick)
    (let [nick          (session :nick)
          user-id       (session :user_id)
          msg-id        (params  :message_id)
          msg           (fetch-message-by-id msg-id)
          tag           (validate-tag (params :tag))
          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 msg-id tag]
  (let [query       "user_id = ? AND message_id = ? AND lower(tag) = ?"
        msg-id      (maybe-parse-int msg-id)
        tag         (normalize-tag-for-db tag)
        msg         (fetch-message-by-id msg-id)]
    (let [rows-deleted (first (do-delete "tags" [query user-id msg-id tag]))]
      (if-not (zero? rows-deleted)
        (do
          (if-not (or (:admin_only msg) (= user-id (:user_id msg)))
            (incrby-redis-favscore! msg -1))
          (resp-success "OK"))
        (resp-error "NO_TAG")))))

(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
                       :hide-vip (not (:is_admin session))
                       :date (if msg-id nil date)
                       :limit (inc *dumps-per-page*))
        recips        (map :nick (get-recips-from-msgs raw-dumps))
        back-dumps    (if (or date msg-id)
                        (tags/fetch-tagged-dumps
                         :nick (:nick user-info)
                         :msg-id msg-id
                         :hide-vip (not (:is_admin session))
                         :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 "recips" (json-str recips))
    (.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-info   (insert-message! (:user_id session)
                                      (:nick session)
                                      (:avatar session)
                                      room
                                      url)]
      (copy (:tempfile image) dest)
      (dosync
       (let [msg (build-msg (:nick session)
                            url
                            (:msg-id msg-info)
                            (:recips msg-info))]
         (add-message msg room)))
      [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-info! (:nick session) (:user_id session) "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  (fetch-redis-hall (:nick session))]
    (.setAttribute st "dumps" (map process-message-for-output msgs))
    (.toString st)))

;; MGMT

(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 :*)))
  (ANY "*" (unknown-page)))



(defroutes pichat
  (GET "http://www.dump.fm/*"     (redirect-to "http://dump.fm"))
  (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 "/t/:topic" (topic session (params :topic)))
  
  (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 "/log-test/:t" (user-log session (fetch-nick "ryder") nil nil (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))
  (ANY "*" (unknown-page)))

;; 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*)
(start-user-flusher!)
(start-session-pruner!)

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