Correct [log type=error|debug] final newline behavior
[interchange.git] / lib / Vend / Payment / PayflowPro.pm
1 # Vend::Payment::PayflowPro - Interchange support for PayPal Payflow Pro HTTPS POST
2 #
3 # $Id: PayflowPro.pm,v 1.2 2009-03-20 15:44:59 markj Exp $
4 #
5 # Copyright (C) 2002-2009 Interchange Development Group and others
6 # Copyright (C) 1999-2002 Red Hat, Inc.
7 #
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
12 #
13 # You should have received a copy of the GNU General Public
14 # License along with this program; if not, write to the Free
15 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
16 # MA  02110-1301  USA.
17
18 package Vend::Payment::PayflowPro;
19
20 =head1 NAME
21
22 Vend::Payment::PayflowPro - Interchange support for PayPal Payflow Pro HTTPS POST
23
24 =head1 SYNOPSIS
25
26     &charge=payflowpro
27
28         or
29
30     [charge mode=payflowpro param1=value1 param2=value2]
31
32 =head1 PREREQUISITES
33
34     The following Perl modules:
35        LWP
36        Crypt::SSLeay
37        HTTP::Request
38        HTTP::Headers
39
40     OpenSSL
41
42 PayPal's Payflow Pro HTTPS POST does NOT require the proprietary binary-only
43 shared library that was used for the Verisign Payflow Pro service.
44
45 =head1 DESCRIPTION
46
47 The Vend::Payment::PayflowPro module implements the payflowpro() payment routine
48 for use with Interchange. It is compatible on a call level with the other
49 Interchange payment modules -- in theory (and even usually in practice) you
50 could switch from a different payment module to PayflowPro with a few
51 configuration file changes.
52
53 To enable this module, place this directive in F<interchange.cfg>:
54
55     Require module Vend::Payment::PayflowPro
56
57 This I<must> be in interchange.cfg or a file included from it.
58
59 NOTE: Make sure CreditCardAuto is off (default in Interchange demos).
60
61 The mode can be named anything, but the C<gateway> parameter must be set
62 to C<payflowpro>. To make it the default payment gateway for all credit
63 card transactions in a specific catalog, you can set in F<catalog.cfg>:
64
65     Variable  MV_PAYMENT_MODE  payflowpro
66
67 It uses several of the standard settings from Interchange payment. Any time
68 we speak of a setting, it is obtained either first from the tag/call options,
69 then from an Interchange order Route named for the mode, then finally a
70 default global payment variable. For example, the C<id> parameter would
71 be specified by:
72
73     [charge mode=payflowpro id=YourPayflowProID]
74
75 or
76
77     Route payflowpro id YourPayflowProID
78
79 or with only Payflow Pro as a payment provider
80
81     Variable MV_PAYMENT_ID YourPayflowProID
82
83 The active settings are:
84
85 =over 4
86
87 =item id
88
89 Your account ID, supplied by PayPal when you sign up.
90 Global parameter is MV_PAYMENT_ID.
91
92 =item secret
93
94 Your account password, selected by you or provided by PayPal when you sign up.
95 Global parameter is MV_PAYMENT_SECRET.
96
97 =item partner
98
99 Your account partner, selected by you or provided by PayPal when you
100 sign up. Global parameter is MV_PAYMENT_PARTNER.
101
102 =item vendor
103
104 Your account vendor, selected by you or provided by PayPal when you
105 sign up. Global parameter is MV_PAYMENT_VENDOR.
106
107 =item transaction
108
109 The type of transaction to be run. Valid values are:
110
111     Interchange         Payflow Pro
112     ----------------    -----------------
113     sale                S
114     auth                A
115     credit              C
116     void                V
117     settle              D (from previous A trans)
118
119 Default is C<auth>.
120
121 =back
122
123 The following should rarely be used, as the supplied defaults are
124 usually correct.
125
126 =over 4
127
128 =item remap
129
130 This remaps the form variable names to the ones needed by PayPal. See
131 the C<Payment Settings> heading in the Interchange documentation for use.
132
133 =item host
134
135 The payment gateway host to use, to override the default.
136
137 =item check_sub
138
139 Name of a Sub or GlobalSub to be called after the result hash has been
140 received from PayPal. A reference to the modifiable result hash is
141 passed into the subroutine, and it should return true (in the Perl truth
142 sense) if its checks were successful, or false if not. The transaction type
143 is passed in as a second arg, if needed.
144
145 This can come in handy since, strangely, PayPal has no option to decline
146 a charge when AVS or CSC data come back negative.
147
148 If you want to fail based on a bad AVS check, make sure you're only
149 doing an auth -- B<not a sale>, or your customers would get charged on
150 orders that fail the AVS check and never get logged in your system!
151
152 Add the parameters like this:
153
154     Route  payflowpro  check_sub  avs_check
155
156 This is a matching sample subroutine you could put in interchange.cfg:
157
158     GlobalSub <<EOR
159     sub avs_check {
160         my ($result) = @_;
161         my ($addr, $zip) = @{$result}{qw( AVSADDR AVSZIP )};
162         return 1 if $addr eq 'Y' or $zip eq 'Y';
163         return 1 if $addr eq 'X' and $zip eq 'X';
164         return 1 if $addr !~ /\S/ and $zip !~ /\S/;
165         $result->{RESULT} = 112;
166         $result->{RESPMSG} = "The billing address you entered does not match the cardholder's billing address";
167         return 0;
168     }
169     EOR
170
171 That would work equally well as a Sub in catalog.cfg. It will succeed if
172 either the address or zip is 'Y', or if both are unknown. If it fails,
173 it sets the result code and error message in the result hash using
174 PayPal's own (otherwise unused) 112 result code, meaning "Failed AVS
175 check".
176
177 Of course you can use this sub to do any other post-processing you
178 want as well.
179
180 =back
181
182 =head2 Troubleshooting
183
184 Try the instructions above, then enable test mode. A test order should
185 complete.
186
187 Then move to live mode and try a sale with the card number C<4111 1111
188 1111 1111> and a valid future expiration date. The sale should be denied,
189 and the reason should be in [data session payment_error].
190
191 If it doesn't work:
192
193 =over 4
194
195 =item *
196
197 Make sure you "Require"d the module in interchange.cfg:
198
199     Require module Vend::Payment::PayflowPro
200
201 =item *
202
203 Check the error logs, both catalog and global.
204
205 =item *
206
207 Make sure you set your account ID and secret properly.
208
209 =item *
210
211 Try an order, then put this code in a page:
212
213     <pre>
214     [calcn]
215         my $string = $Tag->uneval( { ref => $Session->{payment_result} });
216         $string =~ s/{/{\n/;
217         $string =~ s/,/,\n/g;
218         return $string;
219     [/calcn]
220     </pre>
221
222 That should show what happened.
223
224 =item *
225
226 If all else fails, consultants are available to help with
227 integration for a fee. You can find consultants by asking on the
228 C<interchange-biz@icdevgroup.org> mailing list.
229
230 =back
231
232 =head1 NOTE
233
234 There is actually nothing in the package Vend::Payment::PayflowPro.
235 It changes packages to Vend::Payment and places things there.
236
237 =head1 AUTHORS
238
239     Tom Tucker <tom@ttucker.com>
240     Mark Johnson <mark@endpoint.com>
241     Jordan Adler
242     David Christensen <david@endpoint.com>
243     Cameron Prince <cameronbprince@yahoo.com>
244     Mike Heins <mike@perusion.com>
245     Jon Jensen <jon@endpoint.com>
246
247 =cut
248
249 package Vend::Payment;
250
251 use Config;
252 use Time::HiRes;
253
254 BEGIN {
255     eval {
256         require LWP;
257         require HTTP::Request;
258         require HTTP::Headers;
259         require Crypt::SSLeay;
260     };
261     if ($@) {
262         die "Required modules for PayPal Payflow Pro HTTPS NOT found. $@\n";
263     }
264 }
265
266 sub payflowpro {
267     my ($user, $amount) = @_;
268 # Uncomment all the following lines to use the debug statement. It strips
269 # the arg of any sensitive credit card information and is safe
270 # (and recommended) to enable in production.
271 #
272 #    my $debug_user = ::uneval($user);
273 #    $debug_user =~ s{('mv_credit_card_[^']+' => ')((?:\\'|\\|[^\\']*)*)(')}{$1 . ('X' x length($2)) . $3}ge;
274 #::logDebug("payflowpro called\n" . $debug_user);
275
276     my ($opt, $secret);
277     if (ref $user) {
278         $opt = $user;
279         $user = $opt->{id} || undef;
280         $secret = $opt->{secret} || undef;
281     }
282     else {
283         $opt = {};
284     }
285     my %actual;
286     if ($opt->{actual}) {
287         %actual = %{$opt->{actual}};
288     }
289     else {
290         %actual = map_actual();
291     }
292
293     if (! $user) {
294         $user = charge_param('id')
295             or return (
296                 MStatus => 'failure-hard',
297                 MErrMsg => errmsg('No account id'),
298             );
299     }
300 #::logDebug("payflowpro user $user");
301
302     if (! $secret) {
303         $secret = charge_param('secret')
304             or return (
305                 MStatus => 'failure-hard',
306                 MErrMsg => errmsg('No account password'),
307             );
308     }
309
310 #::logDebug("payflowpro OrderID: |$opt->{order_id}|");
311
312     my ($server, $port);
313     if (! $opt->{host} and charge_param('test')) {
314 #::logDebug("payflowpro: setting server to pilot/test mode");
315         $server = 'pilot-payflowpro.paypal.com';
316         $port = '443';
317     }
318     else {
319 #::logDebug("payflowpro: setting server based on options");
320         $server = $opt->{host} || 'payflowpro.paypal.com';
321         $port = $opt->{port} || '443';
322     }
323
324     my $uri = "https://$server:$port/transaction";
325 #::logDebug("payflowpro: using uri: $uri");
326
327     $actual{mv_credit_card_exp_month} =~ s/\D//g;
328     $actual{mv_credit_card_exp_month} =~ s/^0+//;
329     $actual{mv_credit_card_exp_year}  =~ s/\D//g;
330     $actual{mv_credit_card_exp_year}  =~ s/\d\d(\d\d)/$1/;
331     $actual{mv_credit_card_number}    =~ s/\D//g;
332
333     my $exp = sprintf '%02d%02d',
334         $actual{mv_credit_card_exp_month},
335         $actual{mv_credit_card_exp_year};
336
337     my %type_map = (qw/
338         sale          S
339         auth          A
340         authorize     A
341         void          V
342         settle        D
343         settle_prior  D
344         credit        C
345         mauthcapture  S
346         mauthonly     A
347         mauthdelay    D
348         mauthreturn   C
349         S             S
350         C             C
351         D             D
352         V             V
353         A             A
354     /);
355
356     my $transtype = $opt->{transaction} || charge_param('transaction') || 'A';
357
358     $transtype = $type_map{$transtype}
359         or return (
360                 MStatus => 'failure-hard',
361                 MErrMsg => errmsg('Unrecognized transaction: %s', $transtype),
362             );
363
364
365     my $orderID = $opt->{order_id};
366     $amount = $opt->{total_cost} if ! $amount;
367
368     if (! $amount) {
369         my $precision = $opt->{precision} || charge_param('precision') || 2;
370         my $cost = Vend::Interpolate::total_cost();
371         $amount = Vend::Util::round_to_frac_digits($cost, $precision);
372     }
373
374     my %varmap = (qw/
375         ACCT        mv_credit_card_number
376         CVV2        mv_credit_card_cvv2
377         ZIP         b_zip
378         STREET      b_address
379         SHIPTOZIP   zip
380         EMAIL       email
381         COMMENT1    comment1
382         COMMENT2    comment2
383     /);
384
385     my %query = (
386         AMT         => $amount,
387         EXPDATE     => $exp,
388         TENDER      => 'C',
389         PWD         => $secret,
390         USER        => $user,
391         TRXTYPE     => $transtype,
392     );
393
394     $query{PARTNER} = $opt->{partner} || charge_param('partner');
395     $query{VENDOR}  = $opt->{vendor}  || charge_param('vendor');
396     $query{ORIGID} = $orderID if $orderID;
397
398     # We want a unique orderID for each call, to better than second granularity
399     ( $opt->{order_id} = Time::HiRes::clock_gettime() ) =~ s/\D//g;
400     $orderID = gen_order_id($opt);
401 #::logDebug("payflowpro AUTH gen_order_id: " . $orderID);
402
403     for (keys %varmap) {
404         $query{$_} = $actual{$varmap{$_}} if defined $actual{$varmap{$_}};
405     }
406
407 # Uncomment all the following block to use the debug statement. It strips
408 # the arg of any sensitive credit card information and is safe
409 # (and recommended) to enable in production.
410 #
411 #    {
412 #        my %munged_query = %query;
413 #        $munged_query{PWD} = 'X';
414 #        $munged_query{ACCT} =~ s/^(\d{4})(.*)/$1 . ('X' x length($2))/e;
415 #        $munged_query{CVV2} =~ s/./X/g;
416 #        $munged_query{EXPDATE} =~ s/./X/g;
417 #::logDebug("payflowpro query: " . ::uneval(\%munged_query));
418 #    }
419
420     my $timeout = $opt->{timeout} || 10;
421     die "Bad timeout value, security violation." unless $timeout && $timeout !~ /\D/;
422     die "Bad port value, security violation." unless $port && $port !~ /\D/;
423     die "Bad server value, security violation." unless $server && $server !~ /[^-\w.]/;
424
425     my $result = {};
426
427     my (@query, @debug_query);
428     for my $key (keys %query) {
429         my $val = $query{$key};
430         $val =~ s/["\$\n\r]//g;
431         my $len = length($val);
432         $key .= "[$len]";
433         push @query, "$key=$val";
434         $val =~ s/./X/g
435             if $key =~ /^(?:PWD|ACCT|CVV2|EXPDATE)\b/;
436         push @debug_query, "$key=$val";
437     }
438     my $string = join '&', @query;
439     my $debug_string = join '&', @debug_query;
440
441     my %headers = (
442         'Content-Type'                    => 'text/namevalue',
443         'X-VPS-Request-Id'                => $orderID,
444         'X-VPS-Timeout'                   => $timeout,
445         'X-VPS-VIT-Client-Architecture'   => $Config{archname},
446         'X-VPS-VIT-Client-Type'           => 'Perl',
447         'X-VPS-VIT-Client-Version'        => $VERSION,
448         'X-VPS-VIT-Integration-Product'   => 'Interchange',
449         'X-VPS-VIT-Integration-Version'   => $::VERSION,
450         'X-VPS-VIT-OS-Name'               => $Config{osname},
451         'X-VPS-VIT-OS-Version'            => $Config{osvers},
452     );
453 # Debug statement is stripped of any sensitive card data and is safe (and
454 # recommended) to enable in production.
455 #
456 #::logDebug(qq{--------------------\nPosting to PayflowPro: \n\t$orderID\n\t$uri "$debug_string"});
457
458     my $headers = HTTP::Headers->new(%headers);
459     my $request = HTTP::Request->new('POST', $uri, $headers, $string);
460     my $ua = LWP::UserAgent->new(timeout => $timeout);
461     $ua->agent('Vend::Payment::PayflowPro');
462     my $response = $ua->request($request);
463     my $resultstr = $response->content;
464 #::logDebug(qq{PayflowPro response:\n\t$resultstr\n--------------------});
465
466     unless ( $response->is_success ) {
467         return (
468             RESULT => -1,
469             RESPMSG => 'System Error',
470             MStatus => 'failure-hard',
471             MErrMsg => 'System Error',
472             lwp_response => $resultstr,
473         );
474     }
475
476     %$result = split /[&=]/, $resultstr;
477     my $decline = $result->{RESULT};
478
479     if (
480         $result->{RESULT} == 0
481             and
482         my $check_sub_name = $opt->{check_sub} || charge_param('check_sub')
483     ) {
484         my $check_sub = $Vend::Cfg->{Sub}{$check_sub_name}
485             || $Global::GlobalSub->{$check_sub_name};
486         if (ref $check_sub eq 'CODE') {
487             $decline =
488                 !$check_sub->(
489                     $result,
490                     $transtype,
491                 );
492 #::logDebug(qq{payflowpro called check_sub sub=$check_sub_name decline=$decline});
493         }
494         else {
495             logError("payflowpro: non-existent check_sub routine %s.", $check_sub_name);
496         }
497     }
498
499     my %result_map = (qw/
500         MStatus        ICSTATUS
501         pop.status     ICSTATUS
502         order-id       PNREF
503         pop.order-id   PNREF
504         pop.auth-code  AUTHCODE
505         pop.avs_code   AVSZIP
506         pop.avs_zip    AVSZIP
507         pop.avs_addr   AVSADDR
508     /);
509
510     if ($decline) {
511         $result->{ICSTATUS} = 'failed';
512         my $msg = errmsg("Charge error: %s Reason: %s. Please call in your order or try again.",
513             $result->{RESULT} || 'no details available',
514             $result->{RESPMSG} || 'unknown error',
515         );
516         $result->{MErrMsg} = $result{'pop.error-message'} = $msg;
517     }
518     else {
519         $result->{ICSTATUS} = 'success';
520     }
521
522     for (keys %result_map) {
523         $result->{$_} = $result->{$result_map{$_}}
524             if defined $result->{$result_map{$_}};
525     }
526
527 #::logDebug('payflowpro result: ' . ::uneval($result));
528     return %$result;
529 }
530
531 package Vend::Payment::PayflowPro;
532
533 1;