|
|
|
Rank: Starting Member
Groups: Registered
Joined: 6/11/2003
Posts: 3
Location: ,
|
I really had a problem with that Perl ipn script. After much trial and error, the following system works. I've added a lot of comments (to help me better understand what is going on). As provided by PayPal, it was a mystery to me because my knowledge of Perl is intermediate or less.
Also, I was trying to do the whole job in ipn.cgi. Then, I found it is better to use another script to provide access to my ebook. The PayPal button includes a "return" value of a success page specific to the product ordered. This page has a link to a "registration" page (also specific to product) that allows the buyer to register for login. The action of that form is to call another script that controls access.
The buyer then uses email as username, enters a password, then registers. After registration, a login page gives immediate access to my ebook (a Flash movie). This was my purpose --- to give immediate access to the buyer to my ebook, How To Build Your Internet Business: Design.
Here is the ipn.cgi:
#!/usr/bin/perl
# This path is specific to my unix server.
# read post from PayPal system and add 'cmd'
read (STDIN, $query, $ENV{'CONTENT_LENGTH'});
$query .= '&cmd=_notify-validate';
# post back to PayPal system to validate
# Use this module
use LWP::UserAgent;
# Create new UserAgent object '$ua'
$ua = new LWP::UserAgent;
# Create new Request object '$req' with Method
# and URL
$req = new HTTP::Request 'POST','http://www.paypal.com/cgi-bin/webscr';
# Assign this 'content_type' method to request object '$req'
$req->content_type('application/x-www-form-urlencoded');
# Assign this 'content' method to request object '$req'
$req->content($query);
# Tell the agent to make the request
# It returns the response object '$res'
$res = $ua->request($req);
# split posted variables into pairs on "&" (space)
@pairs = split(/&/, $query);
$count = 0;
# cycle through pairs in the array @pairs
foreach $pair (@pairs)
{
# Split each pair into $name=$value
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$variable{$name} = $value;
$count++;
}
# assign posted variables to local variables
$item_name = $variable{'item_name'};
$item_number = $variable{'item_number'};
$payment_status = $variable{'payment_status'};
$payment_gross = $variable{'payment_gross'};
$txn_id = $variable{'txn_id'};
$receiver_email = $variable{'receiver_email'};
$payer_email = $variable{'payer_email'};
# Variable used to see if txn_id exits in file.
$processed = 0;
# If response is PENDING, nothing happens.
# Otherwise, it will be either: (an http error); VERIFIED; Completed;
# Invalid; or (some other error).
if ($res->is_error)
{
# HTTP error
$msg = "HTTP error\n";
&log_error;
} # end if ($res->is_error)
elsif ($res->content eq 'VERIFIED')
{
# Check the payment_status=Completed
if ($payment_status eq "Completed")
{
# Check that txn_id has not been previously processed
# and recorded in the file created with
# sub transaction_log. Return value for $processed.
&check_txn;
if ($processed == 0)
{
# check that receiver_email is your Primary PayPal email
if ($receiver_email eq "j.jimdturner\@verizon.net")
{
# process payment
&transaction_log;
} # end email OK
} # end ($processed == 0) (not previous process)
else
{
$msg = "Prior transaction\n";
&log_error;
} # end else !$processed == 0
} # end if ($payment_status eq "Completed")
} # end ($res->content eq 'VERIFIED')
elsif ($res->content eq 'INVALID')
{
# log for manual investigation
$msg = "Response is Invalid\n";
&log_error;
}
else
{
# error$msg = "Other error\n";
&log_error;
}
print "content-type: text/plain";
#######################################################################
# sub log_error #
#######################################################################
# This routine will open and write $msg to an error log.
sub log_error
{
open(LOGFILE, '>>./Data_files/error.log.cgi') or die 'Unable to open error.log.cgi\n';
print LOGFILE $msg;
close(LOGFILE);
} # End &log_error
#######################################################################
# sub check_txn #
#######################################################################
# This routine will open an order file and check to see if this
# transaction number has already been entered. If not, $processed will
# stay as 0. If so, it will return 1.
sub check_txn
{
$processed = 0;
open(ORDERFILE, '<./Data_files/order.data.cgi') or die 'Unable to open order.data.cgi\n';
while(($line = <ORDERFILE>))
{
chop($line); # Chop off extraneous newline
@fields = split(/\|/, $line);
# The first field, index[0], is the txn_id.
if ($fields[0] eq $txn_id)
{
$processed = 1;
} # end of if ($fields[0] eq $txn_id)
} # end of while
} # end &check_txn
#######################################################################
# sub transaction_log #
#######################################################################
# This routine is called when the ipn response is Verified, Completed
# and passes the other checks.
# It records the variables passed from PayPal in a datafile.
sub transaction_log
{
# Get buy_when date
($second, $minute, $hour, $dayofmonth, $month, $year, $weekday, $dayofyear, $IsDST) = localtime(time);
$RealMonth = $month + 1;
$RealYear = $year + 1900;
$buy_when = "$RealMonth/$dayofmonth/$RealYear";
# Record the registration in a datafile in pipe delimited format
open(ORDERFILE, '>>./Data_files/order.data.cgi') or die 'Unable to open order.data.cgi\n';
flock(ORDERFILE, 2);
print ORDERFILE "$txn_id|$item_name|$item_number|$payment_status|$payment_gross|$receiver_email|$payer_email|$buy_when\n";
flock(ORDERFILE, 8);
close ORDERFILE;
} # end &transaction_log
------------------------
My file "order.data.cgi" will include a valid $payer_email for a buyer. When registering, another script tests for this field. If found, the script records username and password in another file, used for login.
If these ideas are of value to you, feel free to use them. If you can see a more efficient way to do the same things, I will appreciate the feedback.
Jim
Jim Turner
cgis-creative.com
|
|
|
|
|
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 10/28/2003
Posts: 3
Location: ,
|
Hello.
If you read these JimT, thanks for the code you posted. It helped alot.
I changed a few things in order to fit my needs and wanted to post it back here to give credit where it is due. Also wanted to ask what may be wrong.
Everything tests out fine on eliteweaver ipn test page except I receive an HTTP 500 error. I have the script CHMOD correctly and uploaded in ASCII. The weird thing that I cannot figure out is this: Whenever I add the code
BEGIN {
$| = 1;
open (STDERR, '>>/path/to/cgi-bin/error2.log');
print qq~Content-type: text/plain\n\n~;
}
to any placee in the script, I no longer receive the 500 error. Now this is suppose to be a code for logging what happens when the 500 error occurs. Or at least, that is what I read from the post where I got the code. I'm not all that PERL savvy so I'm not sure what it is doing. From what I understand, you are suppose to place it in different areas to ascertain the error causing the HTTP 500.
So, if someone can take a look at the code I have and tell me why this error is happening, I'd appreciate it greatly. BTW, the code above never logs anything in the file. To me it is strange but maybe somebody out there who has a clue can give me one. Thanks.
#!/usr/bin/perl
# This path is specific to my unix server.
##################################
#Use DBI Module and set error count to zero
use DBI;
my $err=0;
##################################
#Catching errors during testing
use CGI::Carp 'carpout';
BEGIN {
open(LOG, '>>/path/to/cgi-bin/error.log') && carpout(\*LOG);
}
##################################
# read post from PayPal system and add 'cmd'
read (STDIN, $query, $ENV{'CONTENT_LENGTH'});
$query .= '&cmd=_notify-validate';
# post back to PayPal system to validate
# Use this module
use LWP::UserAgent;
# Create new UserAgent object '$ua'
$ua = new LWP::UserAgent;
# Create new Request object '$req' with Method
# and URL
#Set for testing with eliteweaver
$req = new HTTP::Request 'POST','http://www.eliteweaver.co.uk/testing/ipntest.php';
# Assign this 'content_type' method to request object '$req'
$req->content_type('application/x-www-form-urlencoded');
# Assign this 'content' method to request object '$req'
$req->content($query);
# Tell the agent to make the request
# It returns the response object '$res'
$res = $ua->request($req);
# split posted variables into pairs on "&" (space)
@pairs = split(/&/, $query);
$count = 0;
# cycle through pairs in the array @pairs
foreach $pair (@pairs)
{
# Split each pair into $name=$value
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$variable{$name} = $value;
$count++;
}
# assign posted variables to local variables
#
$business = $variable{'business'};
$item_name = $variable{'item_name'};
$item_number = $variable{'item_number'};
$payment_status = $variable{'payment_status'};
$mc_gross = $variable{'mc_gross'};
$mc_fee = $variable{'mc_fee'};
$txn_id = $variable{'txn_id'};
$first_name = $variable{'first_name'};
$last_name = $variable{'last_name'};
$receiver_email = $variable{'receiver_email'};
$payer_email = $variable{'payer_email'};
#####################################################
# Response will be either: (an http error); VERIFIED;INVALID;
# or (some other error); If Verified, validate Completed, Pending, or Failed
#This is changed from previous script because I wanted email response for Pending
#and using mySQL database
#####################################################
# HTTP error
if ($res->is_error) {
$msg = "HTTP error\n";
&log_error;
} # end if ($res->is_error)
elsif ($res->content eq 'VERIFIED') {
# Check the payment_status=Completed
if ($payment_status eq "Completed") {
# check that receiver_email is your Primary PayPal email
if ($receiver_email eq "youremail\@xxxx.com") {
#Open Database in subroutine and check txn_id.
&database;
} # end email OK.
else {#Begin email false.
$msg = "Wrong receiver_email!!\n";
&log_error;
}
} # end if ($payment_status eq "Completed")
#If payment is Pending
elsif ($payment_status eq "Pending") {
#Subroutine sends email saying order Pending.
&pending;
} #end if ($payment_status eq "Pending")
#If payment Failed
elsif ($payment_status eq "Failed") {
#Sends Email saying the order Failed.
&failed;
}#end if ($payment_status eq "Failed")
} # end ($res->content eq 'VERIFIED')
elsif ($res->content eq 'INVALID') {
# log for manual investigation
#Sends an email to receiver_email
$msg = "Response is Invalid\n";
&log_error;
&invalid;
}
else {
# error$msg = "Other error\n";
&log_error;
}
print "content-type: text/plain";
#######################################################################
#Routine for mysql
#######################################################################
sub database {
$dbh = DBI->connect("DBI:mysql:database name:localhost","username","password");
################
#Check the txn_id
################
$statement = "select txn_id from paypalorders where txn_id =\"$txn_id\"";
$sth = $dbh->prepare($statement) or print "Can't prepare the txnid SQL\n";
$rv = $sth->execute or print "Can't execute the txnid query: $sth->errstr";
#If it finds previous txn_id
if ($rv == 1) {
$msg = "Prior transaction\n";
&log_error;
#Send email to warn you.
&spoof;
$sth->finish;
}#Transaction ID already exists. Investigate!!
#If there is not a previous txn_id.
elsif ($rv == '0E0') {
################
#Insert the Transaction
################
$statement = "insert into paypalorders (business, item_name, item_number, mc_gross, mc_fee, txn_id, first_name, last_name, payer_email )";
$statement .= "values (\"$business\", \"$item_name\", \"$item_number\", \"$mc_gross\", \"$mc_fee\", \"$txn_id\", \"$first_name\", \"$last_name\", \"$payer_email\")";
$sth = $dbh->prepare($statement) or print "Can't prepare the SQL\n";
$rv = $sth->execute or print "Can't execute the query: $sth->errstr";
print $rv, " rows inserted\n";
###################################
# Get the product password from the DB
###################################
$statement = "select password from products where prod_id =\"$item_number\"";
$sth = $dbh->prepare($statement) or print "Can't prepare the SQL\n";
$rv = $sth->execute or print "Can't execute the query: $sth->errstr";
if ($rv == '0E0') { $err_txt[$err++]="Product not found\n"; }
@row = $sth->fetchrow_array;
$sth->finish;
#Go to mail list subroutine to add email.
&mailist;
}
#####################################
# If any errors...from database statements. Also only sends if there is a $payer_email
#####################################
if ($err) {
if ($payer_email) {
&send_mail ($payer_email, "Error in Order!", "Dear $first_name,\nThe following errors occurred while processing your order:\n\n@err_txt\n\nPlease send an email to sales\@yourdomain.com in order facilitate your order. We apologize for the delay.\n\nThank you\n\n");
}
print "$err errors!: \n@err_txt";
}
# Success! Send password etc. to customer.
#-------------------------------------------
else {
&send_mail($payer_email, "Your Script Key...", "Dear $first_name,\nThankyou for your order. \n\nYour script key is: $row[0].\nIf you have any problems, please contact us:\n\nsales\@yourdomain.com");
}
$dbh->disconnect;
}
######################
#Pending transaction
######################
sub pending {
if ($payer_email) {
&send_mail ($payer_email, "Order Pending", "Dear $first_name,\nYour order is pending. As soon as the payment clears, you will be sent an email with the appropriate scriptkey.\nIf there is a problem please send an email to sales\@yourdomain.com.\n\nThank you\n\n");
}
}
######################
#Transaction Failed. Do not use $receiver_email
######################
sub invalid {
if ($payer_email) {
&send_mail ("youremail\@xxxx.com", "Invalid Response", "There has been an invalid IPN response logged in the error log.\n\n");
}
}
######################
#Transaction Failed
######################
sub failed {
if ($payer_email) {
&send_mail ($payer_email, "Order Failed", "Dear $first_name,\nYour order has failed. You may wish to email sales\@yourdomain.com or message through yahoo messenger in order to ascertain why.\n\nThank you\n\n");
}
}
######################
#Somebody spoofing? Do not use $receiver_email
######################
sub spoof {
if ($payer_email) {
&send_mail ("youremail\@xxxx.com", "Possible Spoof", "Check the log file. Someone may be trying to spoof the IPN script on the site.\n\n");
}
}
##########################
#Flat File email list. $business used to separate different business mail list
##########################
sub mailist {
$databasefile = "/path/to/mailist/file/$business.txt";
$seconds = 0;
while($seconds < 12) # check if lock exists
{last unless -e "${databasefile}.lock";
$seconds++;
sleep 1;
}
open FILE,">${databasefile}.lock"; # lock file
close FILE;
open FILE,"<$databasefile"; # read the file
@lines = <FILE>;
close FILE;
chomp @lines;
my $match = 0;
for(@lines) {if($_ eq $payer_email)
{$match = 1;
last;
}
}
unless($match) # write the file unless matched
{open FILE,">$databasefile";
for(@lines) { print FILE "$_\n";}
print FILE $payer_email;
close FILE;
}
unlink "${databasefile}.lock"; # unlock file
}
####################
# sub log_error #
####################
# This routine will open and write $msg to an error log.
sub log_error {
open(LOGFILE, '>>/path/to/cgi-bin/error.log.cgi') or die 'Unable to open error.log.cgi';
print LOGFILE $msg, $payer_email;
close(LOGFILE);
} # End &log_error
#######################
# Subroutine: send_mail
#######################
sub send_mail {
open(MAIL, "|/usr/sbin/sendmail -t") || die ("FATAL: Failed open mail!: $!\n");
print MAIL <<"EOM";
To: $_[0]
Subject: $_[1]
From: Whoever <sales\@yourdomain.com>
Sender: sales\@yourdomain.com
Reply-To: sales\@yourdomain.com
$_[2]
\n\n
EOM
close (MAIL)
}
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 10/28/2003
Posts: 3
Location: ,
|
Never mind. I found a solution. By adding the code
print "Content-type: text/plain\n\n";
print "Done.";
in place of
print "content-type: text/plain";
in the section:
# error$msg = "Other error\n";
&log_error;
}
print "content-type: text/plain";
#######################################################################
#Routine for mysql
#######################################################################
Hope this stuff helps people out there.
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 2/11/2004
Posts: 5
Location: ,
|
I am kind of confused. HOW did you folks DEBUG this script? How do you post/repost/test it? Call me an idiot but do you create a 'paypal emulator'? or do you have someone buy a bunch of 50 cent items while you get it to work?
mega-confused.
eduhosting.org
free websites for teachers
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 2/11/2004
Posts: 5
Location: ,
|
My script is finally working after 4 years! YEAH. Nice test utility... ...almost. For the first time I am getting SOME output but it dies at this little section: elsif ($res->content eq 'INVALID') { # log for manual investigation $msg = "Response is Invalid\n"; and does it's job. I put a bunch of stepper lines in the code and recorded them to a log and here's the steps it gets through: <li> read payer_email=paypal@runawaytechs.com&receiver_email=paypal@eduhosting.org&item_name=Monthly+Health+Club-Basic&txn_type=subscr_signup&payment_type=instant&payment_status=COMPLETED&pending_reason=NA¬ify_version=1.4&verify_sign=11111111111111111111&ipn_demo=1&txn_id=YYMMDD-S100TODAY&last_name=Windows&first_name=Ellie&period1=26+D&period3=1+M&mc_amount1=10.00&payer_id=JUSTSMEMADEUPVALUE&amount1=10.00&subscr_date=FILLIN&mc_amount3=10.00&amount3=10.00&item_number=Monthly+Health+Club-Basic&verify_sign=ABCDEFGHIJKLMNOPQRSTUVWXYZ&txn_type=subscr_signup&mc_currency=USD&reattempt=1&subscr_id=S-1234567890&recurring=1&usr_manage=1&username=dave&password=abcdefg&submit=Submit+Demo+Transaction&cmd=_notify-validate <li> ua LWP::UserAgent=HASH(0x15d50dc) <li> req HTTP::Request=HASH(0x1953580) <li> res HTTP::Response=HASH(0x1b69c3c) <li> item name Monthly Health Club-Basic paypal@eduhosting.org paypal@runawaytechs.com<li> LOGGING ERROR Response is Invalid eduhosting.org free websites for teachers
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 2/11/2004
Posts: 5
Location: ,
|
quick question: does the cgi have to be on a secure server?
eduhosting.org
free websites for teachers
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 4/13/2004
Posts: 6
Location: ,
|
No, the cgi script should work fine without a secure server.
Also, you guys are programming a bunch of stuff that is to me not 'safe'.
Try implementing the 'strict' command, to me someone can post dangerous variables to your script which you don't want happening.
Cheers
Thank you,
Anthony
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 12/23/2008
Posts: 4
Location: ,
|
hi all,
i am using following line of codes but i am unable to get post back from paypal i have taken these line of code from first post, my server is ssl
#!/usr/bin/perl
#print "Content-type: text/html\n\n"; before this line was in use
print "Content-type: text/plain\n\n";
# read post from PayPal system and add 'cmd'
read (STDIN, $query, $ENV{'CONTENT_LENGTH'});
$query .= '&cmd=_notify-validate';
# post back to PayPal system to validate
# Use this module
use LWP::UserAgent;
# Create new UserAgent object '$ua'
$ua = new LWP::UserAgent;
# Create new Request object '$req' with Method
# and URL
$req = new HTTP::Request 'POST','https://www.sandbox.paypal.com/cgi-bin/webscr';
# Assign this 'content_type' method to request object '$req'
$req->content_type('application/x-www-form-urlencoded');
# Assign this 'content' method to request object '$req'
$req->content($query);
# Tell the agent to make the request
# It returns the response object '$res'
$res = $ua->request($req);
# split posted variables into pairs on "&" (space)
@pairs = split(/&/, $query);
$count = 0;
# cycle through pairs in the array @pairs
foreach $pair (@pairs)
{
# Split each pair into $name=$value
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$variable{$name} = $value;
$count++;
}
nothing
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 12/23/2008
Posts: 4
Location: ,
|
Any body please i am near to cry
nothing
|
|
|
|
Rank: Starting Member
Groups: Registered
Joined: 12/23/2008
Posts: 4
Location: ,
|
Any help PLZ
i am getting these things
Original Post from PayPal:
&cmd=_notify-validate
Length of Post From PayPal = //i am unable to count the post length
PayPal Post Back Response:
Post Back Query = HTTP::Request=HASH(0x95e73dc)
----------------- HTTP::Response=HASH(0x98fffa0) --------------------------
HTTP/1.1 200 OK
Connection: close
Date: Mon, 29 Dec 2008 05:14:34 GMT
Server: Apache/1.3.33 (Unix) mod_fastcgi/2.4.2 mod_gzip/1.3.26.1a mod_ssl/2.8.22 OpenSSL/0.9.7e
Content-Type: text/html; charset=UTF-8
Client-Date: Mon, 29 Dec 2008 05:14:37 GMT
Client-Peer: 216.113.191.82:80
Client-Response-Num: 1
Client-Transfer-Encoding: chunked
Set-Cookie: c9MWDuvPtT9GIMyPc3jwol1VSlO=iuJ1_dd56OYiFIukgtqgUsP5ZYCbejy2p4qaXXzDRbJ5AWiMXLPDZvan0_EsoAlq580gsnV8NJm1D6kLb_tGwUU9JqDrA1R13LKZmSeWOebs3p9a9tzbDxADx_uBmMT9Ggb-H0%7cxoam6tPtjoD5JlMRgCgdp5DQJ8NJ43Xa654cvQqii-lxgl4Pzia2BJEoi8XqwRiU1o6H-0%7c5xd8aESf4FXztZEPLZCZVVDzdrl-_sYuIrl_3L3j76DpMifXA0D1qSKoTw1CKl5tLpjXuG%7c1230527675; domain=.paypal.com; path=/
Set-Cookie: cookie_check=yes; expires=Thu, 27-Dec-2018 05:14:35 GMT; domain=.paypal.com; path=/
Set-Cookie: navcmd=_notify-validate; domain=.paypal.com; path=/
Set-Cookie: navlns=0; expires=Sun, 24-Dec-2028 05:14:35 GMT; domain=.paypal.com; path=/
Set-Cookie: Apache=10.191.196.11.235641230527674621; path=/; expires=Sat, 15-Nov-02 22:46:18 GMT
INVALID
nothing
|
|
|
|
Guest
|
