setstats.pl
Copying Source is Forbidden
328 lines of code
1
#!/usr/local/bin/perl
2
3
#/
4
# to update user stats
5
# not meant to be used in administrative sections!
6
#/
7
8
use strict;
9
use warnings;
10
use CGI::Carp qw(fatalsToBrowser);
11
use HTML::Restrict;
12
use URI::Escape;
13
use Crypt::PBKDF2;
14
my $pb = Crypt::PBKDF2->new;
15
16
use lib "/var/www/html/Pm";
17
18
use Bc_chef qw(cookie_get);
19
use Bc_misc qw(get_param referrer get_salt shorten_str add_param);
20
use Bc_sql qw(
21
get_constant
22
sql_execute
23
user_exists
24
$QUERY_PAGE
25
$QUERY_UID
26
$LOGGEDIN
27
$SITE_NAME
28
get_theme_purchases
29
validate_new_user_data
30
get_theme_data
31
32
$DB
33
);
34
35
use Redir qw(error_redir notice_redir);
36
use Security qw(password_correct banned);
37
use User qw(isUserAdmin get_user_stats $USER_DATA);
38
use Html qw(pre_html_header header);
39
use Html2 qw(tag);
40
########################
41
42
43
my $DEBUG = 0;
44
45
my $deniedurl = "/";
46
my $url = "/?$QUERY_PAGE=" . get_constant("STATS_PAGE");
47
my $retryurl = $url;
48
49
if (not user_exists($LOGGEDIN) or banned($LOGGEDIN)) {
50
my $msg = "Access Denied";
51
if ($DEBUG) { $msg .= " (setstats.pl)"; }
52
print error_redir($deniedurl, $msg);
53
54
exit 1;
55
}
56
57
# a special var which allows extra data to be
58
# updated (such as email addresses, and gender, etc)
59
# must ensure loggedin user is admin
60
my $admin = get_param("admin");
61
62
if ($admin eq 1 and not isUserAdmin($LOGGEDIN)) {
63
print error_redir($deniedurl, "Access Denied!");
64
exit 1;
65
}
66
67
# ID, nickname, email, dob, showbday, lastip, password, race, gender, location, orientation, drugs, wheels, can_host, drinker, smoker, seeking, seeking_gender
68
# erection, bust, eye_clr, hair_clr, weight, height, body, enrolled, subscriber, subscription_date, subscription_type, CCID, TID, security, description, banned
69
70
my $stats_page = get_param(get_constant("QUERY_STATS_PAGE"));
71
if (not $stats_page) { $stats_page = get_constant("STATS_BIO_PAGE"); }
72
73
# now that we have all the changes, grab a copy of the supplied uid's stats
74
my %stats = %$USER_DATA;
75
my %orig = %stats;
76
77
# ID, nickname, email, dob, showbday, lastip, password, race, gender, location, orientation, drugs, wheels, can_host, drinker, smoker, seeking, seeking_gender
78
# erection, bust, eye_clr, hair_clr, weight, height, body, enrolled, subscriber, subscription_date, subscription_type, CCID, TID, security, description, banned
79
80
# and update the appropriate keys
81
# ID is already in $LOGGEDIN
82
# nickname will be left unchanged
83
# email will be left unchanged
84
# dob will be left unchanged
85
$stats{showbday} = get_param("show_bday");
86
if ($stats{showbday} eq "on") { $stats{showbday} = 2; } else { $stats{showbday} = 1; }
87
# lastip will be left unchanged
88
# password is handled differently
89
# race will be left unchanged
90
# gender will be left unchanged
91
$stats{location} = get_param("user_country") . "-" . get_param("user_city");
92
my ($country, $city, $extra) = split("-", $stats{location});
93
if ($extra) { $stats{location} = "$city-$extra"; }
94
$stats{orientation} = get_param("orientation");
95
$stats{drugs} = get_param("drugs");
96
$stats{wheels} = get_param("wheels");
97
$stats{can_host} = get_param("can_host");
98
$stats{drinker} = get_param("drinker");
99
$stats{smoker} = get_param("smoker");
100
$stats{seeking} = get_param("seeking");
101
$stats{seeking_gender} = get_param("seeking_gender");
102
$stats{erection} = get_param("erection");
103
if (not $stats{erection}) { $stats{erection} = 1; }
104
$stats{bust} = get_param("bust");
105
if (not $stats{bust}) { $stats{bust} = 1; }
106
# eye_clr will be left unchanged
107
# hair_clr will be left unchanged
108
$stats{weight} = get_param("weight");
109
$stats{height} = get_param("height");
110
$stats{body} = get_param("body");
111
# enrolled will be left unchanged
112
# subscriber will be left unchanged
113
# subscription_date will be left unchanged
114
# subscription_type will be left unchanged
115
# CCID will be left unchanged
116
$stats{TID} = get_param("TID");
117
118
# i guess we should make sure TID is valid and the user has actually purchased a premium theme ID (when applicable, of course)
119
{
120
if (not $stats{TID}) { $stats{TID} = "203537B0FF"; } # everyone gets a default theme of white.
121
my @themes = get_theme_purchases($LOGGEDIN);
122
my $utd = get_theme_data($stats{TID});
123
if ($utd->{premium} eq 2 and not isUserAdmin($LOGGEDIN)) {
124
my $validTID = 0;
125
126
foreach my $tid (@themes) { if ($stats{TID} eq $tid) { $validTID = 1; } }
127
128
if ($validTID ne 1) { $stats{TID} = "203537B0FF"; }
129
}
130
}
131
132
# security will be left unchanged
133
134
# description will be left unchanged
135
$stats{description} = get_param("desc");
136
# sanitize description
137
my $nohtml = HTML::Restrict->new();
138
my $desc_processed = $nohtml->process($stats{description});
139
if ($desc_processed ne $stats{description}) { $stats{description} = $desc_processed; }
140
141
# banned status will be left unchanged
142
143
my $currpw = get_param("currentpw");
144
my $newpw = get_param("newpw");
145
my $retypedpw = get_param("retypedpw");
146
147
my $rv = "";
148
149
if ($DEBUG) {
150
$rv = pre_html_header();
151
$rv .= header("Set Stats - " . $SITE_NAME);
152
}
153
154
# create the SQL command
155
my $update = "";
156
#$update .= " ID=" . $DB->quote($stats{ID}) . ", ";
157
#$update .= " nickname=" . $DB->quote($stats{nickname}) . ", ";
158
#$update .= " email=" . $DB->quote($stats{email}) . ", ";
159
#$update .= " dob=" . $DB->quote($stats{dob}) . ", ";
160
if ($orig{showbday} ne $stats{showbday}) { $update .= "showbday=" . $DB->quote($stats{showbday}) . ", "; }
161
#$update .= " lastip=" . $DB->quote($stats{lastip}) . ", ";
162
if ($orig{password} ne $stats{password}) { $update .= "password=" . $DB->quote($stats{password}) . ", "; }
163
#$update .= " race=" . $DB->quote($stats{race}) . ", ";
164
#$update .= " gender=" . $DB->quote($stats{gender}) . ", ";
165
if ($orig{location} ne $stats{location}) { $update .= "location=" . $DB->quote($stats{location}) . ", "; }
166
if ($orig{orientation} ne $stats{orientation}) { $update .= "orientation=" . $DB->quote($stats{orientation}) . ", "; }
167
if ($orig{drugs} ne $stats{drugs}) { $update .= "drugs=" . $DB->quote($stats{drugs}) . ", "; }
168
if ($orig{wheels} ne $stats{wheels}) { $update .= "wheels=" . $DB->quote($stats{wheels}) . ", "; }
169
if ($orig{can_host} ne $stats{can_host}) { $update .= "can_host=" . $DB->quote($stats{can_host}) . ", "; }
170
if ($orig{drinker} ne $stats{drinker}) { $update .= "drinker=" . $DB->quote($stats{drinker}) . ", "; }
171
if ($orig{smoker} ne $stats{smoker}) { $update .= "smoker=" . $DB->quote($stats{smoker}) . ", "; }
172
if ($orig{seeking} ne $stats{seeking}) { $update .= "seeking=" . $DB->quote($stats{seeking}) . ", "; }
173
if ($orig{seeking_gender} ne $stats{seeking_gender}) { $update .= " seeking_gender=" . $DB->quote($stats{seeking_gender}) . ", "; }
174
if ($orig{erection} ne $stats{erection}) { $update .= "erection=" . $DB->quote($stats{erection}) . ", "; }
175
if ($orig{bust} ne $stats{bust}) { $update .= "bust=" . $DB->quote($stats{bust}) . ", "; }
176
#$update .= " eye_clr=" . $DB->quote($stats{eye_clr}) . ", ";
177
#$update .= " hair_clr=" . $DB->quote($stats{hair_clr}) . ", ";
178
if ($orig{weight} ne $stats{weight}) { $update .= "weight=" . $DB->quote($stats{weight}) . ", "; }
179
if ($orig{height} ne $stats{height}) { $update .= "height=" . $DB->quote($stats{height}) . ", "; }
180
if ($orig{body} ne $stats{body}) { $update .= "body=" . $DB->quote($stats{body}) . ", "; }
181
#$update .= " enrolled=" . $DB->quote($stats{enrolled}) . ", ";
182
#$update .= " subscriber=" . $DB->quote($stats{subscriber}) . ", ";
183
#$update .= " subscription_date=" . $DB->quote($stats{subscription_date}) . ", ";
184
#$update .= " subscription_type=" . $DB->quote($stats{subscription_type}) . ", ";
185
#$update .= " CCID=" . $DB->quote($stats{CCID}) . ", ";
186
if ($orig{TID} ne $stats{TID}) { $update .= "TID=" . $DB->quote($stats{TID}) . ", "; }
187
#$update .= " security=" . $DB->quote($stats{security}) . ", ";
188
if ($orig{description} ne $stats{description}) { $update .= "description=" . $DB->quote($stats{description}) . " "; }
189
#$update .= " banned=" . $DB->quote($stats{banned}) . " ";
190
$update =~ s/, $//;
191
if ($update) {
192
$update = "update users set " . $update;
193
$update .= " where ID=" . $DB->quote($stats{ID});
194
}
195
196
if ($currpw) {
197
if ($DEBUG) {
198
$rv .= "password change detected...<br>\n";
199
$rv .= " current db pw=$orig{password}<br>\n";
200
$rv .= " provided pw=$currpw<br>\n";
201
}
202
203
# first, check to make sure it's the right pw!
204
# if so, then compare newpw with retypedpw to ensure they match exactly
205
# if they do, then update the SQL in $update
206
207
if (password_correct($LOGGEDIN, $currpw)) {
208
my $pwupdate;
209
my $newdbpw = $pb->generate($newpw);
210
$stats{password} = $newdbpw;
211
212
if ($newpw eq $retypedpw) {
213
if ($DEBUG) {
214
$rv .= " newpw=$newpw<br>\n";
215
$rv .= " retyped pw=$retypedpw<br>\n";
216
$rv .= " new db pw: $newdbpw<br>\n";
217
$rv .= " sql: $update<br>\n";
218
}
219
220
$pwupdate = "password=" . $DB->quote($newdbpw);
221
$update =~ s/password=(.)*,( )*location/$pwupdate, location/;
222
} else {
223
print error_redir($retryurl, "Password mismatch");
224
225
exit 1;
226
}
227
} else {
228
if ($DEBUG) {
229
$rv .= "------------<br><br>\n";
230
$rv .= "pw error. no updates to your account were made<br>\n";
231
$rv .= "script halted<br>\n";
232
233
print $rv;
234
} else {
235
print error_redir($retryurl, "Password incorrect");
236
}
237
238
exit 1;
239
}
240
} elsif ($DEBUG) {
241
$rv .= "no password change detected ($currpw)<br>\n";
242
}
243
244
if ($DEBUG) {
245
$rv .= "<table border=0 class=translucent><tr><td align=center colspan=3>\n";
246
$rv .= " <b>Original Stats</b>\n";
247
$rv .= "</td><td width=100></td><td align=center colspan=3>\n";
248
$rv .= " <b>New Stats</b>\n";
249
$rv .= "</td></tr><tr><td height=8 colspan=7>\n";
250
$rv .= "</td></tr><tr class=translucent-fadein><td>\n";
251
foreach my $stat (sort keys %orig) {
252
$rv .= " $stat</td><td width=12></td><td>" . shorten_str($orig{$stat}, 50) . "\n";
253
$rv .= "</td><td align=center>";
254
{ my %div;
255
$div{tag} = "div";
256
257
if ($orig{$stat} ne $stats{$stat}) {
258
$div{innerHTML} = " ";
259
$div{class} = "red-panel";
260
} else {
261
$div{innerHTML} = " ";
262
$div{class} = "green-panel";
263
}
264
265
$rv .= tag(\%div);
266
}
267
$rv .= "</td><td>\n";
268
$rv .= " $stat</td><td width=12></td><td>" . shorten_str($stats{$stat}, 50) . "\n";
269
$rv .= "</td></tr><tr class=translucent-fadein><td>\n";
270
}
271
$rv =~ s/\<\/td>\<\/tr>\<tr class\=translucent\-fadein>\<td>\n$/<\/td><\/tr><tr><td align=center colspan=7><br>/;
272
$rv .= "<small>for display purposes {description} has been truncated<br>\n";
273
$rv .= "actual data entered will not be affected</small><br>\n";
274
$rv .= "</td></tr></table>\n";
275
$rv .= "------------------------------------<br>\n";
276
if ($update) {
277
$rv .= "<div>SQL: <b>$update</b><br></div>\n";
278
} else {
279
$rv .= "<div class='yellow-panel min-content nowrap'>no changes detected!</div><br>\n";
280
}
281
$rv .= "\n-------------<br>\n";
282
my $ignore_nn = 1;
283
if ($orig{nickname} ne $stats{nickname}) { $ignore_nn = 0; }
284
my $valid = validate_new_user_data(\%stats, $ignore_nn);
285
$rv .= "<div>New User Data Validity: <b>$valid</b><br></div>\n";
286
$rv .= "\n-------------<br>\n";
287
$rv .= "<div>debug mode enabled: <b>no changes were made</b><br></div>\n";
288
$rv .= "\n-------------<br>\n";
289
$rv .= "<div>denied url: <b>$deniedurl</b><br></div>\n";
290
$rv .= "<div>retry url: <b>$retryurl</b><br></div>\n";
291
$rv .= "<div>success url: <b>$url</b><br></div>\n";
292
{ my %button;
293
$button{tag} = "button";
294
$button{type} = "button";
295
$button{innerHTML} = "Reload";
296
$button{class} = "yellow min-content";
297
$button{onclick} = "reload();";
298
299
$rv .= tag(\%button);
300
} # end reload button
301
} else {
302
if ($update) {
303
my $ignore_nn = 1;
304
if ($orig{nickname} ne $stats{nickname}) { $ignore_nn = 0; }
305
my $valid = validate_new_user_data(\%stats, $ignore_nn);
306
if ($valid eq 1) {
307
my $sql = sql_execute($update, "setstats.pl - updating stats");
308
309
if ($sql)
310
{ $rv = notice_redir($url, "Settings Updated"); } else
311
{ $rv = error_redir($retryurl, "Settings NOT Updated: ") . $DB->errstr; }
312
} else {
313
$rv = error_redir($retryurl, "Settings NOT Updated: Given info is invalid (error code = $valid and given data = $stats{email})");
314
}
315
} else {
316
if ($DEBUG) {
317
$rv .= "no changes detected!";
318
} else {
319
$rv = notice_redir($retryurl, "No Changes Detected");
320
}
321
}
322
}
323
324
$rv .= "<br><br>";
325
326
print $rv;
327
328
exit 1;