blob: 417130ee2cc1a08438e3b8d1db1ddf8672bda8b6 (
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
|
; site.clj
(ns pichat
(:import java.lang.System
org.apache.commons.codec.digest.DigestUtils)
(: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 :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 retrieve-nick [nick]
(let [query (str "SELECT * FROM users WHERE nick = '" nick "'")]
(first (do-select query))))
(defn authorize-nick-hash [nick hash]
(let [db-user (retrieve-nick nick)]
(and db-user (= (db-user :hash) hash))))
(defn register [session params]
(let [nick (params :nick)
email (params :email)
hash (params :hash)]
(if (retrieve-nick nick)
(resp-error "NICK_TAKEN")
(with-connection db
(insert-values :users
[:nick :hash :email]
[nick hash email])
(resp-success "OK")))))
(defn renamed-user-struct [old-nick nick]
(let [old-struct (@users old-nick)]
(if old-struct
(assoc old-struct :nick nick)
(struct user-struct nick (System/currentTimeMillis)))))
(defn login [session params]
(let [old-nick (session :nick)
nick (params :nick)
hash (params :hash)
ts (params :ts)]
(if (authorize-nick-hash nick hash)
(dosync
(set-session {:nick nick :logged-in true})
(let [user-struct (renamed-user-struct old-nick nick)]
(alter users dissoc old-nick)
(alter users assoc nick user-struct)
[(session-assoc :nick nick :logged-in true)
(resp-success "OK")]))
(resp-error "BAD_LOGIN"))))
(defn init [session]
(let [new-nick (make-random-nick)]
(dosync
(alter users assoc new-nick
(struct user-struct new-nick (System/currentTimeMillis)))
[(session-assoc :nick new-nick)
(resp-success (assoc (updates) :nick new-nick :loggedin false))])))
(defn refresh [nick]
(dosync
(if (contains? @users nick)
(let [last-seen (get-in @users [nick :last-seen])]
(alter users assoc-in [nick :last-seen] (System/currentTimeMillis))
(resp-success (updates last-seen)))
(resp-error "UNKNOWN_USER"))))
(defn msg [session params]
(dosync
(let [nick (session :nick)
content (params :content)
msg (struct message-struct nick content (System/currentTimeMillis))]
(if (contains? @users nick)
(do (alter messages (swap cons) msg)
(resp-success "OK"))
(resp-error "UNKNOWN_USER")))))
(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 "/init" (init (session :nick)))
(GET "/login" (login session params))
(GET "/refresh" (refresh (session :nick)))
(GET "/msg" (msg session params))
(ANY "*" [404 "Page not found"]))
(decorate pichat
(with-mimetypes)
(with-session {:type :memory, :expires (* 60 60)}))
(run-server {:port 8080}
"/*" (servlet pichat))
(send-off flusher flush!)
|
