[Catalyst] Catalyst and PayPal
Matt Rosin
telebody at gmail.com
Mon Apr 21 19:45:58 BST 2008
Hello,
I used the IPN service and it worked well in Catalyst. I used a
product database to generate a catalog with PayPal buttons set to 1
year subscriptions. Unfortunately I did the no-no and built it into a
controller so I don't suppose I should share it. So here anyway.
Maybe it is bad form to do this for a Controller based module
(encourages use) but I release this under GPL2 or higher, or Perl
Artistic License.
In my setup I allowed unregistered users to sign up, and PayPal IPN
contacted an url to activate the account in a second. Then their click
in PayPal would redirect them back to the newly activated customer
portal where they logged in.
It doesn't use those fancy modules but it _does_ do verification which
you should do too. Caveat this is an old archive and might not be
final. At least it shows what kind of thinking I distilled from all
their PDF guides. I stored all transactions and return values in a
Transaction table but have the client use PayPal's portal. Note that
PayPal sends double notifications (at least did for me).
Regards,
Matt Rosin
package CatMgr::Controller::Notify;
use strict;
use warnings;
use base 'Catalyst::Controller';
=head1 NAME
CatMgr::Controller::Notify - Catalyst Controller
=head1 DESCRIPTION
Catalyst Controller to receive notifications from payment gateways and
other services
Copyright (c) 2007-2008 Matt Rosin
I hereby make this module is available for use under GPL v2 or later,
or the Perl Artistic License.
=head1 METHODS
=cut
=head2 index
Unused. Paypal etc have their own subroutines.
=cut
sub default : Local {
my ( $self, $c, @args ) = @_;
my $msg = "Access Denied.";
$c->response->body("Notify: $msg");
}
=head2 paypal
Processes an Instant Payment Notification. PayPal sends a POST to this
url (/notify/paypal) and then we validate it.
It sends the notification back to PayPal to make sure it is not being
spoofed. PayPal responds with "VERIFIED" or "INVALID" and we post back
a 200 OK response to prevent additional attempts by PayPal to post the
transaction data. If PayPal does not receive the 200 OK response from
your server, PayPal will resend the notification for up to four days.
INVALID should be treated as suspicious and be investigated.
If you receive a VERIFIED response, following checks should be done:
Confirm payment_status is Completed (not Pending or Failed)
Check that the txn_id is unique, to prevent a fraudster from reusing
an old, completed transaction
They only send a txn_id with a payment_status update it seems. My
own txn id is the same if you click on a button twice, so while it is
good to keep lots of dupe notifications together, it is not useful for
checking fraud. So make sure I only fulfill once per their txn_id.
Check item number and price using the custom field. (custom: 255 chars max)
Skipping check of my own txn id, since no longer recording ordinary
dupe notifications.
After doing a post-back and getting VERIFIED, we record it, if it has
a payment_status field.
If we recorded everything we would get a lot of duplicates that are
just notifications that a payment was initiated but not yet cleared,
and those notifications are also a pain because they use different
fields or have missing fields anyway.
When success is determined (payment_status = Completed and unique
txn_id in the database), a purchased product is instantiated (a
Package) and the user account is changed from provisional to enabled.
When a new listing is made, the category is set to 25.
This is an unused category intentionally left empty, so the
listing.category relation works.
Otherwise Catalyst seems to want to autovivify a category no. 0 but
that insert fails for some reason and a crash.
With this change it still won't display (because it is a disabled
category) but the customer portal will let me edit it without
crashing. (If we didn't set it it would be 0, but there is no category
#0 and I think I used that fact in the past.)
Note: listings were changed 2007-0624 to be live when created by
Notify, so that people will not complain if they forget to change it
from Preparing to Live. It still won't be displayed until they set the
category from 25 to a different one, and the listing editor will not
let them get away without setting the category.
=cut
sub paypal : Local {
my ( $self, $c, @args ) = @_;
my $msg = "";
use Data::Dumper;
use FreezeThaw qw(freeze thaw cmpStr safeFreeze cmpStrHard);
my $failed = 0;
my $money = 0;
my $paystatus = "";
## VALIDATION ##
# Check which url to use, test or live
my $pi = $c->config->{paymentinfo}->{paypal};
my $ppmode = $pi->{mode}; # test or live
my $verifyurl = $pi->{$ppmode}->{verifyurl}; # sandbox or not webscr url
# my $verifyurl = 'https://www.paypal.com/cgi-bin/webscr';
# $verifyurl = 'https://www.sandbox.paypal.com/cgi-bin/webscr' if
$ppmode eq 'test';
# Have user agent $ua send a validation request to paypal, and get
back a response ($ures)
use LWP::UserAgent;
my $ua = new LWP::UserAgent;
use HTTP::Request::Common; # add POST url, hash syntax to HTTP::Request
my $p = $c->request->parameters; # save parameter hash to check later
$p->{cmd} = '_notify-validate'; # add to parameter hash
my $ures = $ua->request(POST $verifyurl, $p); # content_type is
application/x-www-form-urlencoded
# Analyze the terse response (VERIFIED means PayPal did indeed send that IPN)
my $errstr = ""; # error info
my $result = ""; # failed or success, what's the bottom line
my $answer = $ures->content;
if ( $ures->is_error) { # HTTP error
$errstr = "HTTP error. " . $ures->error_as_HTML;
$result = "failed";
} elsif ( $answer eq 'INVALID' ) {
$errstr = "Couldn't validate the transaction. Response: " . $answer;
$result = "failed";
} elsif ( $answer eq 'VERIFIED' ) {
$result = "success";
} else { # if we came this far, something is really wrong here.
Maybe logged out of sandbox..
$errstr = "Vague response: " . substr($answer,0,4095);
$result = "failed";
}
# Process IPN
my $completed = 0; # is it completed?
my $txnisuniq = 0; # is the txn_id a new unused one?
my $amountok = 0; # does amount match db? LATER
my $emailok = 0; # does email match site email? LATER
my $cust;
my $payment_status = "";
my $payment_gross = $p->{payment_gross} || $p->{amount3} || "?";
my $shortname = $p->{item_number} || "?";
my $recemail = $p->{receiver_email};
my $fullname = $p->{first_name} . " " . $p->{last_name};
if ($result eq 'failed') { # if failed verification log it and quit
$msg .= "PayPal: Failed to verify their IPN! Suspicious. $errstr";
} else { # We want to record this IPN if it has a payment_status
(and a txn_id)
$payment_status = $p->{payment_status} if defined $p->{payment_status};
my %custom = $self->unpackCustomFormField($c,$p->{custom}); #
hashref: buttontxn,custid,company,name
if (length($payment_status)) { # record IPN since is status
update. Use old rec with txn_id if avail.
use Data::Dumper; # needed here
my $tdata = { type => 'payment',
customer => $custom{custid},
amount => $payment_gross,
title => $custom{company} . " (". $custom{name} ."): " .
$p->{item_name},
summary => $p->{custom},
vendordata => Dumper($p),
vndtxnid => $p->{txn_id},
buttontxn => $custom{buttontxn},
status => $payment_status,
flagged => 1,
};
my $txn = $self->finduniqtxn($c,$p->{txn_id}); # undef if new,
or first matching Transaction
if (defined $txn) { # if existing transaction, overwrite its
data with some of the new info.
# if it is completed, then and we get another completed, then say it
is SUSPICIOUS!
if ((lc($txn->status) eq "completed") && (lc($payment_status) eq
"completed")) {
$txn->title($txn->title . "<BR>\nSUSPICIOUS: Another Completed
notification arrived for this existing transaction!");
$txn->flagged(1);
my $sustr = " SUSPICIOUS: Another Completed notification arrived
for this existing transaction!";
$txn->summary($txn->summary . $sustr);
$msg .= $sustr;
} else { # a legitimate update of status, not trying to win a
freebie, so update it.
$txn->type($tdata->{type});
$txn->vendordata($tdata->{vendordata});
$txn->amount($tdata->{amount});
$txn->status($tdata->{status});
$msg .= " Updated transaction id " . $txn->id . " ";
}
} else { # make a new transaction if we do not have one yet.
$txn = $c->model('CatMgrDB::Transaction')->create($tdata);
$txn->update;
$msg .= "<P>\n** Created a new transaction: " . $txn->id ."\n<P>";
}
# So we have already done the update of the transaction object.
But now should we fulfill?
$completed++ if ($payment_status eq 'Completed');
if ($completed) { # if completed, check data and do fullfillment if okay
$amountok++; #LATER check db price. $amountok++ if (0+$payment_gross
== &productprice($shortname))
$emailok++; #LATER check catmgr.yml email $emailok++ if $recemail eq
$pi->{$ppmode}->{selleremail};
# If completed and all okay, then fulfill by making new package and
enabling portal.
if ($amountok && $emailok) { # fulfillment here MORK
$txn->status('completed'); # set transaction status
# make a new package
my $pkg = $c->model('CatMgrDB::Package')
->create({
statusmsg => 'preparing',
product => $p->{item_number},
customer => $custom{custid},
transaction => $txn->id,
available => 1,
});
$pkg->update;
$txn->package($pkg->id);
# get customer record now. but don't die if we can't find it, we've
gone this far after all
$cust = $c->model('CatMgrDB::Customer')->find($custom{custid});
if (!defined $cust) {
$msg .= "\nERROR: Cannot find customer from PayPal custom
form field (wanted id ". $custom{custid} .")\n";
}
# make new listings as required by product definitions.
# NOTE used to be you could buy many at once. now just boolean 1
listing or none.
my $shouldmakelisting = $pkg->product->listings; # 1 if yes
my @newlistings = ();
if ($shouldmakelisting) {
# note category 25 is an unused category intentionally left
empty, so the listing.category relation works.
# (If we didn't set it it would be 0, but there is no category #0
and I think I used that fact in the past.)
#CHANGED 2007-0624: listing is created with disabled = 0, not -1.
my $listing = $c->model('CatMgrDB::Listing')
->create({
customer => $custom{custid},
package => $pkg->id,
category => 25,
disabled => 0,
});
# fill from customer record
if (defined $cust) { # well it ought to be there!
$listing->name($cust->b_company);
$listing->address($cust->b_address);
$listing->address2($cust->b_address2);
$listing->city($cust->b_city);
$listing->state($cust->b_state);
$listing->zip($cust->b_zip);
$listing->phone($cust->b_phone);
}
# update listing. (not visible to public yet, customer can make
it go live though)
$listing->update;
$msg .= "\nCreated new listing id ". $listing->id;
#OUT push(@newlistings,$listing); # so we can log it if created
}
# other fulfillment here (banners, websites, registration of
auction credits/classified ad credits, etc.
#SKIP MORK
# enable full account
if (defined $cust) {
$cust->acctopen(1); # let user log in MORK
$cust->update;
}
$msg .= "PayPal successful payment: $fullname bought product
$shortname for $payment_gross";
$msg .= "\nCreated new package ". $pkg->id . "\n";
$msg .= "Enabled account for customer ". $cust->id . " ".
$cust->b_company . "\n";
}
} # if completed
# save transaction info i.e. payment status, txn id, etc.
$txn->update;
} # if length payment_status
# log it
my $dp = Dumper($p); #DEBUG my $du = Dumper($ures); #DEBUG my $dp
= Dumper($c);
my $log = $c->model('CatMgrDB::Log')
->create({ priority => 1,
description => "PayPal IPN: $result" . "\nMSG: $msg",
object => safeFreeze($p),
});
$log->update;
}
$c->stash->{msg} = "Thank you, robot for your validation.";
$c->stash->{template} = 'msghtml.tt2';
return 1;
}
=head2 finduniqtxn
Given a vndtxnid (the txn_id used by the vendor for a unique
transaction), checks the Transaction table vndtxnid field for matching
records.
Returns undef if not found, or the Transaction object of the first
matching record if found.
Does not check in reverse chronological order! Assumes there is only
one or zero matching records.
But display in admin should show if there is more than one.
This determines whether fulfillment is done, and is used to ensure
that a fraudster is not reusing an old transaction. Also it find the
transaction to be updated if a status other than Completed is
returned.
Usable for different vendors. (Assumes no overlap of codes used by
different vendors)
Usage: my $id = $self->finduniqtxn($c,$p->{txn_id}); # form parameter
from a PayPal IPN. Returns transaction.id
=cut
sub finduniqtxn : Private {
my ( $self, $c, $id ) = @_;
my $rs = $c->model('CatMgrDB::Transaction')
->search( {
'vndtxnid' => {'=',$id},
},
{
}
); # SKIP order_by id DESC.
my $numfound = $rs->count; # number of ids with that vendor transaction id
return $rs->next if $numfound;
return undef;
}
=head2 unpackCustomFormField
Given the value of the pass-through variables form field, unpack it
and return as a hashref.
Usage: my %custom = $self->unpackCustomFormField($p->{custom});
=cut
sub unpackCustomFormField : Private {
my ( $self, $c, $str ) = @_;
my %customh = ();
return %customh unless defined $str;
# 'custom' => 'buttontxn:8692556436444|custid:242|company:Telebody
Inc.|name:Matt Rosin',
my @custom = split(/\|/, $str);
my ($cik,$civ);
for my $ci (@custom) {
($cik,$civ) = split(/:/,$ci);
next unless defined $cik;
$civ="" unless defined $civ;
$customh{$cik} = $civ;
}
return %customh;
}
=head2 paypalreturn
By enabling auto return in Paypal seller account Profile > Website
Payment Preferences, the customer is given a button to return them to
this site.
Instead of just showing them the customer portal, which still is
logged in if the cookie has not expired, we should show them the
information on their payment which is sent to us by PDT (which must be
enabled in the preferences).
It is not guaranteed that the return will be made since the user may
close the window or choose not click it.
However if we do show a page, we should say Thank You and provide
details of the transaction. Another setting of the preferences will
allow PDT variables to be sent here so we can say what they purchased.
We are already using IPN but can use this as well to make a
notification if we wish.
=cut
sub paypalreturn : Local {
my ( $self, $c, @args ) = @_;
my $msg ="";
# $msg .= join(",", at args) . "<BR>\n";
# use Data::Dumper;
# $msg .= Dumper($c->req->parameters);
$c->stash->{msg} = $msg;
$c->stash->{template} =
"customer/customer_portal_paypalreturn.tt2"; # TT2 template
}
=head1 AUTHOR
Matt Rosin <mattr at telebody.net>
=head1 LICENSE
For use on a single site per LICENSE file in project root directory.
=cut
1;
More information about the Catalyst
mailing list