blob: 7641bd8f46b4007040d072b1c2bbfce938a0995a (
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
|
(ns user
(:use compojure
utils))
(defstruct user-struct :nick :user_id :avatar :last-seen)
(defn user-struct-from-session [session]
(struct user-struct (session :nick) (session :user_id) (session :avatar)
(System/currentTimeMillis)))
(def *nick-regex* #"^[A-Za-z0-9\-_âˆb˚†]*$")
(defn is-invalid-nick? [n]
(cond
(< (count n) 3) "NICK_TOO_SHORT"
(> (count n) 16) "NICK_TOO_LONG"
(not (re-matches *nick-regex* n)) "NICK_INVALID_CHARS"))
;;; User info cache
(def user-cache-size 500)
(def user-nick-cache (ref {}))
(def user-id-cache (ref {}))
(defn update-cache! [uid attr val]
(dosync
(if-let [info (get @user-id-cache uid)]
(let [nick (lower-case (:nick info))
new-info (assoc info attr val)]
(alter user-id-cache assoc uid new-info)
(alter user-nick-cache assoc nick new-info)))))
(defn fetch-nick [nick]
(let [lcnick (lower-case nick)]
(if (contains? user-nick-cache lcnick)
(get user-nick-cache lcnick)
(let [info (first
(do-select ["SELECT * FROM users WHERE lower(nick) = ? LIMIT 1"
lcnick]))
user-id (:user_id info)]
(dosync
(alter user-nick-cache assoc lcnick info)
(if (and info user-id)
(alter user-id-cache assoc user-id info)))
info))))
(defn fetch-nicks [nicks]
(let [lcnicks (map lower-case nicks)
cache @user-nick-cache
to-fetch (filter #(not (contains? cache %)) lcnicks)
fetched-info (do-select ["SELECT * FROM users WHERE lower(nick) = ANY(?)"
(sql-array "text" to-fetch)])
info-map (zipmap (map (comp lower-case :nick) fetched-info)
fetched-info)]
(doseq [nick to-fetch]
(let [info (get info-map nick)]
(dosync
(alter user-nick-cache assoc nick info)
(if info
(alter user-id-cache assoc (:user_id info) info)))))
(filter
boolean
(for [nick lcnicks]
(get @user-nick-cache nick)))))
(defn fetch-user-id [uid]
(if (contains? @user-id-cache uid)
(get @user-id-cache uid)
(if-let [info (first
(do-select ["SELECT * FROM users WHERE user_id = ? LIMIT 1" uid]))]
(dosync
(alter user-nick-cache assoc (lower-case (:nick info)) info)
(alter user-id-cache assoc uid info)))))
(defn authorize-nick-hash [nick hash]
(let [db-user (fetch-nick nick)]
(and db-user (= (db-user :hash) hash) db-user)))
(defn update-nick-hash [nick hash]
(if (not (assert-update
(do-update :users ["nick=?" nick]
{:hash hash})))
; TODO: logging
(println (format "Error updating hash for %s" nick))))
(defn reset-token [nick hash ts]
(sha1-hash nick hash ts))
(defn reset-link [nick token ts]
(url-params "http://dump.fm/reset" {"nick" nick
"ts" ts
"token" token}))
(defn valid-reset-link? [nick token ts]
(if-let [info (and nick (fetch-nick nick))]
(and (= token (reset-token (info :nick) (info :hash) ts))
(>= ts (ms-ago (days 2))))))
|