pp_ipn.pl
Copying Source is Forbidden
382 lines of code
1
#!/usr/local/bin/perl
2
3
use strict;
4
use CGI::Carp qw(fatalsToBrowser);
5
6
my $DEBUG = get_constant("DEBUG_PAYPAL");
7
8
my $PP_server = 'ipnpb.paypal.com'; # production IP:173.0.88.40
9
my $PP_server_ip = '173.0.88.40';
10
11
if ($DEBUG) {
12
$PP_server = 'ipnpb.sandbox.paypal.com'; # sandbox IP:173.0.82.66
13
$PP_server_ip = '173.0.82.66';
14
}
15
16
# It is highly recommended that you use version 6 upwards of
17
# the UserAgent module since it provides for tighter server
18
# certificate validation
19
use LWP::UserAgent 6;
20
21
use lib "/var/www/html/Pm";
22
23
use Bc_misc qw(pluralize referrer);
24
use Bc_sql qw(
25
get_constant
26
sql_execute
27
user_exists
28
$QUERY_PAGE
29
$QUERY_UID
30
ipn_exists
31
gift_exists
32
$LOGGEDIN
33
34
$DB
35
);
36
37
use User qw(get_user_stats isUserSubscriber set_user_stats $USER_DATA);
38
use Date qw(add_date get_today);
39
use Redir qw(error_redir);
40
41
sub debug($;$);
42
sub post_back($);
43
sub continueScript($$$);
44
45
debug("PayPal is calling..." . referrer(), 1);
46
47
# read post from PayPal system and add 'cmd'
48
use CGI qw(:standard);
49
my $cgi = CGI->new();
50
my $query = 'cmd=_notify-validate&';
51
$query .= join('&', map { $_ . '=' . $cgi->param($_) } $cgi->param());
52
53
debug("and we reply with: $query", 1);
54
55
# send the reply, and wait for their reply...
56
my $res = post_back($query); # ask paypal if what we got is right
57
58
# HTTP error?
59
if ($res->is_error) {
60
debug("post back handshake with paypal failed: it was all icky and gooey", 1);
61
} elsif ($res->content eq 'VERIFIED') {
62
debug("post back handshake with paypal verified", 1);
63
# split the data, into a hash...
64
my @pairs = split(/&/, $query);
65
my %variable = {};
66
foreach my $pair (@pairs) {
67
my ($name, $value) = split(/=/, $pair);
68
$value =~ tr/+/ /;
69
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
70
$variable{$name} = $value;
71
}
72
73
my $cs = continueScript($variable{txn_id}, $query, $variable{custom});
74
if ($cs eq 1) {
75
debug("continueScript said go @ " . time . "!", 1);
76
# check if $payment_status=Completed
77
# check if $txn_id has not been previously processed
78
# check if $receiver_email is your Primary PayPal email
79
# check if $payment_amount/$payment_currency are correct
80
# process payment
81
debug("paypal transaction ID ($variable{txn_id}) VERIFIED", 1);
82
if ($variable{payment_status} eq "Completed" or $variable{status} eq "Completed") {
83
debug("paypal transaction COMPLETED for uid: $variable{custom}", 1);
84
if (user_exists($variable{custom})) {
85
debug("user ($variable{custom}) exists!", 1);
86
if ($variable{option_selection1}) {
87
# premium membership purchase
88
debug("premium membership purchase ($variable{item_number})", 1);
89
doSubscribePurchase();
90
} else {
91
if (length($variable{item_number}) == 10) {
92
# it's a theme purchase!
93
# theme ID's are 10 digit hexidecimal characters
94
debug("theme purchase", 1);
95
doThemePurchase();
96
} else {
97
debug("invalid purchase! txn:$variable{txn_id} - tid:$variable{item_number}", 1);
98
}
99
}
100
# end if (user_exists($variable{custom}))
101
} else {
102
# this will cause the system to retain all data sent to night-stand by paypal
103
# as it's a bit of an issue...money was spent, and night-stand now has it, but,
104
# the user gets nothing because the UID is either missing or invalid.
105
if ($variable{custom}) {
106
debug("uh oh! user $variable{custom} does not exist! (txn: $variable{txn_id})", 1);
107
} else {
108
debug("uh oh! no uid provided! (txn: $variable{txn_id})", 1);
109
}
110
}
111
# end if ($variable{payment_status} eq "Completed")
112
} else {
113
debug("transaction not complete: $variable{payment_status} (txn: $variable{txn_id})", 1);
114
}
115
# end of if ($cs eq 1)
116
} else {
117
debug("continueScript said no ($cs) @ " . time . "!", 1);
118
}
119
}
120
elsif ($res->content eq 'INVALID') {
121
# log for manual investigation
122
debug("paypal said transaction is invalid @ " . time . "!", 1);
123
}
124
else {
125
# error
126
debug("seems the transaction failed: $res->content (txn: $variable{txn_id})", 1);
127
}
128
129
print "status: 200 Ok\n\n";
130
131
exit 1;
132
133
134
135
##########################################################################################################################
136
##########################################################################################################################
137
##########################################################################################################################
138
139
140
141
##############
142
sub debug($;$) {
143
my ($msg, $debug_override) = @_;
144
if ($DEBUG or $debug_override) {
145
if ($variable{txn_id}) { $msg = "txn_id:$variable{txn_id} - " . $msg; }
146
sql_execute("insert into paypal_debug values (NULL, " . $DB->quote($msg) . ")", "pp_ipn.pl");
147
}
148
149
return 1;
150
}
151
152
##############
153
sub continueScript($$$) {
154
# to insert the txn data if it doesn't exist already
155
# this function will do very little error checking, per se
156
# for instance, i'm not going to validate the txn id
157
# i'm just going to assume it's valid
158
159
# db table format:
160
# - txn_id, scalar
161
# - ipn_data, scalar
162
# - doc - Date Of Completion, scalar
163
# - uid - user ID related to txn
164
165
# or, if txn id is already in the db, then check to
166
# make sure the txn's not yet "Completed"
167
# if the txn is marked as "Completed", cancel the
168
# "call" from paypal (return 0)
169
# if the txn is not marked as "Completed", allow the
170
# "call" to continue, and update things as we go
171
# (return 1)
172
my ($txn_id, $txn_data, $uid) = @_; # just because it's easier to code...gitter done, y'know?
173
my $rv = 1;
174
175
# so, first, check the db if txn exists
176
if (ipn_exists($txn_id)) {
177
# ok. so it exists!
178
# let's grab the data
179
my $tsql = "select * from paypal where txn_id = " . $DB->quote($txn_id);
180
my $ref = sql_execute($tsql, "pp_ipn.pl - tsql");
181
# this should only return a hash reference
182
if (ref $ref eq "HASH") {
183
# now, let's see if the txn is "Completed" or not
184
# well, we gotta split up the data into something manageable
185
my @data = split("&", $ref->{ipn_data});
186
foreach my $datum (@data) {
187
my ($name, $value) = split("=", $datum);
188
if ($name eq "payment_status" and $value eq "Completed") { $rv = 0; last; }
189
}
190
} else {
191
debug("continueScript: transaction ID $txn_id does not exist?", 1);
192
$rv = -1;
193
}
194
} else {
195
# ok, so it doesn't exist.
196
if (not user_exists($uid)) {
197
debug("continueScript: user ID $uid does not exist?", 1);
198
$rv = -2;
199
} else {
200
# let's insert the data into the db.
201
202
# now, there's crap in this paypal txn we DO NOT want to keep on this server!
203
# and so, for the interests of security, let's get rid of it
204
# besides, paypal has all this shit on their servers, so why and what
205
# would night stand want it for?
206
# this data is in $txn_data
207
# we're gonna cheap out and just change the data to ""
208
$txn_data =~ s/address_zip\=(.)*&//;
209
$txn_data =~ s/first_name\=(.)*&//;
210
$txn_data =~ s/address_country_code\=(.)*&//;
211
$txn_data =~ s/address_name\=(.)*&//;
212
$txn_data =~ s/address_country\=(.)*&//;
213
$txn_data =~ s/address_city\=(.)*&//;
214
$txn_data =~ s/payer_email\=(.)*&//;
215
$txn_data =~ s/last_name\=(.)*&//;
216
$txn_data =~ s/address_state\=(.)*&//;
217
$txn_data =~ s/residence_country\=(.)*&//; # i dunno wtf it is or why, so gone it is
218
# that should cover it....if i missed something, i will fix it.
219
220
my $tsql = "insert into paypal values (";
221
$tsql .= $DB->quote($txn_id) . ",";
222
$tsql .= $DB->quote($txn_data) . ",";
223
$tsql .= " '1901-01-01',";
224
$tsql .= $DB->quote($uid);
225
$tsql .= ")";
226
227
my $ref = sql_execute($tsql, "pp_ipn.pl, tsql2");
228
# did it work?
229
if (not $ref) {
230
# nope, it didn't insert! oh dear...this would be BAD.
231
# this will cause the system store ALL the data paypal
232
# sent. this is done to ensure night stand and paypal
233
# are able to resolve the issue; this data will be
234
# purged once resolved.
235
debug("continueScript: adding data to db failed!", 1);
236
$rv = -3;
237
}
238
}
239
}
240
241
return $rv;
242
}
243
244
sub post_back($) {
245
my ($query) = @_;
246
# post back to PayPal system to validate
247
my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 });
248
my $req = HTTP::Request->new('POST', 'https://' . $PP_server . '/cgi-bin/webscr');
249
$req->content_type('application/x-www-form-urlencoded');
250
$req->header(Host => $PP_server);
251
$req->content($query);
252
$res = $ua->request($req);
253
254
return $res;
255
}
256
257
##################################################################################
258
##################################################################################
259
##################################################################################
260
261
##################
262
sub doSubscribePurchase {
263
my $valid_subtype = 1;
264
debug("upgrading to a <b>$variable{option_selection1}</b> premium membership", 1);
265
266
# now get the user's data...
267
my %ustats;
268
if ($variable{custom} eq $LOGGEDIN and ref $USER_DATA eq "HASH") {
269
%ustats = %$USER_DATA;
270
} else {
271
%ustats = get_user_stats($variable{custom});
272
}
273
debug("retrieved data for <b>$ustats{nickname}</b> ($ustats{ID})", 1);
274
275
if ($ustats{subscription_type} ne 4) {
276
if ($variable{option_selection1} eq "monthly") { $variable{option_selection1} = 2; }
277
elsif ($variable{option_selection1} eq "6months") { $variable{option_selection1} = 5; }
278
elsif ($variable{option_selection1} eq "yearly") { $variable{option_selection1} = 3; }
279
else {
280
$valid_subtype = 0;
281
debug("invalid subscription type: $variable{option_selection1} (txn: $variable{txn_id})", 1);
282
}
283
}
284
285
# is the user a subscriber? if yes:
286
# add to the CURRENT subscription date 1, 6 or 12 months, dependent on the CURRENT subscription type
287
# if the user is NOT a subscriber
288
# then simply grab today's date, and change the user's subsciption date to that date
289
# then, either way, set subscriber to 2, set the user's subscription type to reflect the PURCHASED subscription type
290
if ($ustats{subscriber} eq 2) {
291
debug("user is already a subscriber, adding more time!", 1);
292
if ($variable{option_selection1} eq 2) { $ustats{subscription_date} = add_date($ustats{subscription_date}, 1, "m"); }
293
elsif ($variable{option_selection1} eq 5) { $ustats{subscription_date} = add_date($ustats{subscription_date}, 6, "m"); }
294
elsif ($variable{option_selection1} eq 3) { $ustats{subscription_date} = add_date($ustats{subscription_date}, 12, "m"); }
295
debug("subscription expiration to be updated to: $ustats{subscription_date}", 1);
296
} else {
297
debug("user is not a subscriber", 1);
298
$ustats{subscriber} = 2;
299
$ustats{subscription_date} = get_today("db", 1);
300
debug("subscription expiration to be set to: $ustats{subscription_date}", 1);
301
}
302
303
if ($valid_subtype) {
304
$ustats{subscription_type} = $variable{option_selection1};
305
my $t = set_user_stats(\%ustats);
306
if ($t eq 1) {
307
debug("user subscription update success! (txn: $variable{txn_id} - subtype: $ustats{subscription_type}) \@ " . time, 1);
308
} else {
309
debug("user subscription update failed! (txn: $variable{txn_id} - subtype: $ustats{subscription_type}) \@ " . time, 1);
310
}
311
} else {
312
debug("invalid subscription type: $variable{option_selection1} (txn: $variable{txn_id}) \@ " . time, 1);
313
}
314
}
315
316
##################
317
sub doThemePurchase {
318
# $item_name is a theme ID (eg: A0F1237AC1)
319
debug("purchasing theme id: $variable{item_number}, $variable{item_name1}", 1);
320
321
my $tsql = "select ID from themes where ID=" . $DB->quote($variable{item_number});
322
my $t = sql_execute($tsql, "pp_ipn.pl, tsql3");
323
if (ref $t eq "HASH") {
324
debug("theme exists!", 1);
325
326
# we got the theme.
327
debug("theme id ($variable{item_number}) data retrieved", 1);
328
my $sql_inv = "select * from theme_purchases where UID = " . $DB->quote($variable{custom});
329
my $invRef = sql_execute($sql_inv, "pp_ipn.pl, sql_inv");
330
my @themes = ();
331
if (ref $invRef eq "HASH") {
332
push @themes, $invRef;
333
} else {
334
@themes = @$invRef;
335
}
336
337
if (@themes) {
338
debug("user has premium themes", 1);
339
} else {
340
debug("user has no premium themes", 1);
341
}
342
343
# now, insert the purchase into the db...
344
# but before we do that, we need to make
345
# sure it isn't already purchased!
346
# and if it does exist, we should NOT acknowledge
347
# the transaction
348
# so, to simplify coding, i'm just gonna manually
349
# check if the theme has already been purchased
350
# instead of writing a function
351
my $purchased_sql = "select * from theme_purchases where UID = " . $DB->quote($variable{custom}) . " and TID = " . $DB->quote($variable{item_number});
352
my $result = sql_execute($purchased_sql, "pp_ipn.pl, purchased_sql");
353
debug("checking if user already has TID purchased", 1);
354
if (ref $result eq "HASH") {
355
# theme has already been purchased
356
debug("theme already purchased!", 1);
357
# instead of refunding actual money,
358
# we can refund coins, instead. 25,000 coins, actually
359
add_points($variable{custom}, 25000);
360
} else {
361
# insert the TID into the themes_purchased table...
362
my $add = "insert into theme_purchases values (";
363
$add .= "NULL, ";
364
$add .= $DB->quote($variable{custom}) . ", ";
365
$add .= $DB->quote($variable{item_number});
366
$add .= ")";
367
my $success = sql_execute($add, "pp_ipn.pl, insert purchase");
368
debug("theme NOT already purchased!", 1);
369
if ($success) {
370
# insert succeeded
371
debug("theme id ($variable{item_number}) added to purchases!", 1);
372
} else {
373
# insert failed
374
debug("theme id ($variable{item_number}) NOT added to purchases!", 1);
375
}
376
}
377
# end if (theme_exists($item_name))
378
} else {
379
debug("theme does NOT exist!", 1);
380
# end else of if (theme_exists($item_name))
381
}
382
}