blob: 63e2c2a35d6343196af2da58743b3f25125a84a1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
; site.clj
(ns pichat
(:import java.lang.System
clojure.lang.PersistentQueue
org.apache.commons.codec.digest.DigestUtils
javax.servlet.http.Cookie)
(:use compojure
clojure.contrib.json.write
clojure.contrib.sql))
(let [db-host "localhost"
db-port 5432
db-name "dumpfm"]
(def db {:classname "org.postgresql.Driver"
:subprotocol "postgresql"
:subname (str "//" db-host ":" db-port "/" db-name)
:user "postgres"
:password "root"}))
(defstruct user-struct :user-id :nick :last-seen)
(defstruct message-struct :nick :content :timestamp)
(def users (ref {}))
(def messages (ref []))
(def run-flusher true)
(def flusher-sleep-ms 4000)
(def user-timeout-ms 5000)
(defn swap [f]
(fn [& more] (apply f (reverse more))))
(def flusher (agent nil))
(defn flush! [x]
(when run-flusher
(send-off *agent* #'flush!))
(dosync
(let [now (System/currentTimeMillis)
alive? (fn [[n u]] (> (u :last-seen) (- now user-timeout-ms)))]
(ref-set users
(into {} (filter alive? @users)))))
(. Thread (sleep flusher-sleep-ms))
x)
(defn resp-error [message]
{:status 400 :headers {} :body message})
(defn resp-success [message]
{:status 200 :headers {} :body (json-str message)})
(defn new-messages
([since] (reverse (take-while (fn [m] (> (m :timestamp) since)) @messages)))
([] (reverse (take 25 @messages))))
(def random (java.util.Random.))
(def max-user-int 1000000)
(defn make-random-nick []
(let [nick (str "user-" (.nextInt random max-user-int))]
(if (contains? @users nick)
(make-random-nick)
nick)))
(defn updates
([] {"users" (sort (keys @users)) "messages" (new-messages)})
([since] {"users" (sort (keys @users)) "messages" (new-messages since)}))
(defn do-select [query]
(with-connection db
(with-query-results rs query
(doall rs))))
(defn fetch-messages [room_id]
(let [query (str "SELECT m.content, m.created_on, u.nick FROM messages m, users u "
"WHERE room_id = ? AND m.user_id = u.user_id")
res (do-select [query room_id])]
(map (fn [r] (struct message-struct (r :nick) (r :content) (.getTime (r :created_on))))
res)))
(defn fetch-nick [nick]
(let [query "SELECT * FROM users WHERE nick = ?"]
(first (do-select [query nick]))))
(defn authorize-nick-hash [nick hash]
(let [db-user (fetch-nick nick)]
(if (and db-user (= (db-user :hash) hash))
(db-user :user_id)
false)))
(defn register [session params]
(let [nick (params :nick)
email (params :email)
hash (params :hash)]
(if (fetch-nick nick)
(resp-error "NICK_TAKEN")
(with-connection db
(insert-values :users
[:nick :hash :email]
[nick hash email])
(resp-success "OK")))))
(defn init [session]
(let [now (System/currentTimeMillis)
user-id (session :user-id)
nick (session :nick)
resp (updates)]
(dosync
(if (and user-id nick)
(let [user-struct (struct user-struct user-id nick now)]
(alter users assoc nick user-struct)
(resp-success (merge resp {"nick" nick})))
[(session-assoc :last-seen now)
(resp-success resp)]))))
(defn login [session params]
(let [old-nick (session :nick)
nick (params :nick)
hash (params :hash)
user-id (authorize-nick-hash nick hash)]
(if user-id
(dosync
(set-session {:user-id user-id :nick nick})
(let [user-struct (struct user-struct user-id nick (System/currentTimeMillis))]
(alter users dissoc old-nick)
(alter users assoc nick user-struct)
[(session-assoc :user-id user-id :nick nick)
(resp-success "OK")]))
(resp-error "BAD_LOGIN"))))
(defn refresh [session]
(let [nick (session :nick)
now (System/currentTimeMillis)]
(dosync
(if (contains? (ensure users) nick)
(let [last-seen (get-in @users [nick :last-seen])]
(alter users assoc-in [nick :last-seen] now)
(resp-success (updates last-seen)))
(let [last-seen (max (or (session :last-seen) 0) (- now (* 60 20)))]
[(session-assoc :last-seen now)
(updates last-seen)])))))
(defn msg-transaction [nick msg]
(dosync
(if (contains? (ensure users) nick)
(do (alter messages (swap cons) msg)
true)
false)))
(defn msg-db [user-id room-id msg]
(with-connection db
(insert-values :messages
[:user_id :room_id :content]
[user-id room-id (msg :content)])))
(defn msg [session params]
(let [user-id (session :user-id)
nick (session :nick)
content (params :content)
msg (struct message-struct nick content (System/currentTimeMillis))]
(if (msg-transaction nick msg)
(do
(msg-db user-id 1 msg)
(resp-success "OK"))
(resp-error "MUST_LOGIN"))))
(defroutes pichat
(GET "/" (serve-file "static" "index.html"))
(GET "/static/*" (or (serve-file "static" (params :*))
:next))
(GET "/favicon.ico" (serve-file "static" "favicon.ico"))
(GET "/register" (serve-file "static" "register.html"))
(GET "/submit-registration" (register session params))
(GET "/login" (login session params))
(GET "/init" (init session))
(GET "/refresh" (refresh session))
(GET "/msg" (msg session params))
(ANY "*" [404 "Page not found"]))
(decorate pichat
(with-mimetypes)
(with-session {:type :memory, :expires (* 60 60)}))
; Load messages from database
(dosync
(ref-set messages (fetch-messages 1)))
(run-server {:port 8080}
"/*" (servlet pichat))
(send-off flusher flush!)
|
