1 files changed, 71 insertions, 16 deletions

diff --git a/src/site.clj b/src/site.clj
index 972da44..1d55ac7 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -2,10 +2,13 @@
   (:import java.lang.System
            java.text.SimpleDateFormat
            java.util.Date
+           java.io.File
            org.apache.commons.codec.digest.DigestUtils
            javax.servlet.http.Cookie
            org.antlr.stringtemplate.StringTemplateGroup)
   (:use compojure
+        clojure.contrib.str-utils
+        clojure.contrib.duck-streams
         clojure.contrib.json.write
         clojure.contrib.sql))
 
@@ -49,20 +52,36 @@
   (. Thread (sleep flusher-sleep-ms))
   x)
 
+;; Configuration
+
+(def *server-url*
+  (if (= (System/getProperty "user.name") "dumpfmprod")
+    "http://dump.fm"
+    "http://localhost:8080"))
+
+(def *image-directory* "images")
+
+; Create image directory if it doesn't exist.
+(.mkdir (new File *image-directory*))
+
 ;; Utils
 
-(defn encode-html-entities [s]
+(defn replace-in-str [s table]
   (loop [ret s
-         [[char replacement] & rest] [["&" "&"]
-                                      ["'" "'"]
-                                      ["\"" """]
-                                      ["<" "&lt;"]
-                                      [">" "&gt;"]]]
+         [[char replacement] & rest] table]
     (if (nil? char)
       ret
       (recur (.replaceAll ret char replacement)
              rest))))
 
+(defn encode-html-entities [s]
+  (replace-in-str s [["&" "&amp;"]
+                     ["'" "&apos;"]
+                     ["\"" "&quot;"]
+                     ["<" "&lt;"]
+                     [">" "&gt;"]]))
+
+
 (defn swap [f]
   (fn [& more] (apply f (reverse more))))
 
@@ -77,6 +96,11 @@
 (defn non-empty-string? [s]
   (and s (> (count s) 0)))
 
+(defn rel-join [& more]
+  (str-join (System/getProperty "file.separator")
+            (cons (System/getProperty "user.dir")
+                  more)))
+
 ;; Database
 
 (defn do-select [query]
@@ -220,7 +244,7 @@
 (defn login [session params]
   (let [nick (params :nick)
         hash (params :hash)
-        db-user (authorize-nick-hash nick hash)]    
+        db-user (authorize-nick-hash nick hash)]
     (if db-user
       [(populate-session-from-db db-user)
        (resp-success "OK")]
@@ -447,9 +471,31 @@
 
 ;; Upload
 
-; TODO
+(defn format-filename [s]
+  (let [spaceless (.replace s \space \-)
+        subbed (re-gsub #"[^\w.-]" "" spaceless)]
+    (str (System/currentTimeMillis) "-" subbed)))
+
 (defn upload [session params]
-    nil)
+  (if (not (session :nick))
+    [404 "NOT_LOGGED_IN"]
+    (let [image (:image params)
+          filename (format-filename (:filename image))
+          dest (File. (rel-join *image-directory* filename))
+          image-url (str-join "/" [*server-url* "images" (.getName dest )])]
+      (copy (:tempfile image) dest)
+      (let [room (@rooms (params :room))
+            msg-id (msg-db (session :user_id) (room :room_id) image-url)
+            now (new Date)
+            msg (struct message-struct (session :nick) image-url now msg-id)]
+        (dosync
+         (add-message msg room)))
+      [200 image-url])))
+
+;; 404
+
+(defn unknown-page [params]
+  [404 "Page not Found"])
 
 ;; Compojure Routes
 
@@ -457,19 +503,20 @@
   [{:headers {"Cache-Control" "no-cache, no-store, max-age=0, must-revalidate"}}
    resp])
 
-(defn serve-static [path]
+(defn serve-static [dir path]
   ; TODO: cache policy for other static files (js, css, etc.)
   (let [cache-header (if (re-find pic-regex path)
                        {:headers {"Cache-Control"
                                   "post-check=3600,pre-check=43200"}}
                        {})]
     [cache-header
-     (serve-file "static" path)]))
+     (serve-file dir path)]))
 
 (defroutes pichat
   (GET "/" (no-cache (landing session)))
-  (GET "/static/*" (serve-static (params :*)))
-  (GET "/favicon.ico" (serve-static "favicon.ico"))
+  (GET "/static/*" (serve-static "static" (params :*)))
+  (GET "/images/*" (serve-static *image-directory* (params :*)))
+  (GET "/favicon.ico" (serve-static "static" "favicon.ico"))
   (GET "/u/:nick" (profile session (params :nick) "0"))
   (GET "/u/:nick/" (profile session (params :nick) "0"))
   (GET "/u/:nick/:offset" (profile session
@@ -478,7 +525,7 @@
   (GET "/update-profile" (update-profile session params))
   (GET "/login" (login session params))
   (GET "/logout" (logout session))
-  (GET "/register" (serve-file "static" "register.html"))
+  (GET "/register" (serve-static "static" "register.html"))
   (GET "/submit-registration" (register session params))
   (GET "/:room/chat" (no-cache (validated-chat session (-> request :route-params :room))))
   (GET "/chat" (no-cache (validated-chat session "RoomA")))
@@ -493,13 +540,20 @@
                                            (-> request :route-params :room)
                                            (-> request :route-params :offset)
                                            params))
-  (GET "/upload" (upload session))
-  (ANY "*" [404 "Page not found"]))
+  (ANY "*" (unknown-page params)))
 
 (decorate pichat 
   (with-mimetypes)
   (with-session {:type :memory, :expires (* 60 60)}))
 
+; All uploading-related actions use the with-multipart decoration.
+(defroutes multipart
+  (POST "/upload" (upload session params)))
+
+(decorate multipart
+  (with-mimetypes)
+  (with-session {:type :memory, :expires (* 60 60)})
+  (with-multipart))
 
 ;; Load messages from database
 
@@ -515,6 +569,7 @@
            :messages (ref (fetch-messages-by-room (room-db :room_id) false))})))
   
 (run-server {:port 8080}
+  "/upload" (servlet multipart)
   "/*" (servlet pichat))
 
 (send-off flusher flush!)
\ No newline at end of file