package Business::OnlinePayment::vSecureProcessing; use strict; use URI::Escape; use Carp; use Template; use XML::Simple; use Data::Dumper; use MIME::Entity; use Business::OnlinePayment; use Business::OnlinePayment::HTTPS; use Net::SSLeay qw(post_http post_https make_headers make_form); use vars qw($VERSION $DEBUG @ISA $me); @ISA = qw(Business::OnlinePayment::HTTPS); $DEBUG = 3; $VERSION = '0.01'; $me = 'Business::OnlinePayment::vSecureProcessing'; # $server: http://dvrotsos2.kattare.com # mapping out all possible endpoints # but this version will only be building out "charge", "void", & "credit" my %payment_actions = ( 'charge' => { path => '/vsg2/processpayment', }, 'void' => { path => '/vsg2/processvoid', }, 'refund' => { path => '/vsg2/processrefund', }, 'authorize' => { path => '/vsg2/processauth', }, 'authorize_cancel' => { path => '/vsg2/processauthcancel', }, 'capture' => { path => '/vsg2/processcaptureonly', }, 'create_token' => { path => '/vsg2/createtoken', }, 'delete_token' => { path => '/vsg2/deletetoken', }, 'query_token' => { path => '/vsg2/querytoken', }, 'update_exp_date' => { path => '/vsg2/updateexpiration', }, 'update_token' => { path => '/vsg2/updatetoken', }, ); my %action_mapping = ( 'normal authorization' => 'charge', 'credit' => 'refund', 'authorization only' => 'authorize', 'post authorization' => 'capture', 'reverse authorization' => 'authorize_cancel' # void => void ); BEGIN{ eval 'use bytes; sub blength ($) { length $_[0] }'; $@ and eval ' sub blength ($) { length $_[0] }' ; } sub Net::SSLeay::do_httpx3 { my ($method, $usessl, $site, $port, $path, $headers, $content, $mime_type, $crt_path, $key_path) = @_; my ($response, $page, $h,$v); my $CRLF = "\x0d\x0a"; # because \r\n is not fully portable if ($content) { $mime_type = "";#application/x-www-form-urlencoded" unless $mime_type; my $len = blength($content); #$content = "$mime_type${CRLF}Content-Length: $len$CRLF$CRLF$content"; $content = "Cache-Control: no-cache$CRLF" . "Content-Type: multipart/form-data; boundary=----FormBoundaryE19zNvXGzXaLvS5C$CRLF" . "Accept: */*$CRLF" . "Content-Length: $len$CRLF$CRLF$content"; } else { $content = "$CRLF$CRLF"; } my $req = "$method $path HTTP/1.1$CRLF"; unless (defined $headers && $headers =~ /^Host:/m) { $req .= "Host: $site"; unless (($port == 80 && !$usessl) || ($port == 443 && $usessl)) { $req .= ":$port"; } $req .= $CRLF; } $req .= (defined $headers ? $headers : '') . "$content"; warn "do_httpx3($method,$usessl,$site:$port)" if $DEBUG; my ($http, $errs, $server_cert) = Net::SSLeay::httpx_cat($usessl, $site, $port, $req, $crt_path, $key_path); return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs; $http = '' if !defined $http; ($headers, $page) = split /\s?\n\s?\n/, $http, 2; warn "headers >$headers< page >>$page<< http >>>$http<<<" if $DEBUG>1; ($response, $headers) = split /\s?\n/, $headers, 2; return ($page, $response, $headers, $server_cert); }; sub Net::SSLeay::make_form { my (@fields) = @_; my $form; while (@fields) { my ($name, $data) = (shift(@fields), shift(@fields)); # $data =~ s/([^\w\-.\@\$ ])/sprintf("%%%2.2x",ord($1))/gse; # $data =~ tr[ ][+]; $form .= "$name=$data&"; } chop $form; return $form; } sub set_defaults { my $self = shift; my %options = @_; # inistialize standard B::OP attributes $self->is_success(0); $self->$_( '' ) for qw/authorization result_code error_message server port path server_response/; # B::OP creates the following accessors: # server, port, path, test_transaction, transaction_type, # server_response, is_success, authorization, # result_code, error_message, $self->build_subs(qw/ env platform userid gid tid appid action cvv_response avs_response risk_score /); $DEBUG = exists($options{debug}) ? $options{debug} : $DEBUG; $self->server($options{'url'}); $self->gid($options{'gid'}); $self->tid($options{'tid'}); $self->platform($options{'platform'}); $self->appid($options{'appid'}); $self->env((defined($options{'env'})) ? $options{'env'} : 'live'); # 'live'/'test' # $self->port(($options{'env'} eq 'test') ? 80 : 443); $self->port(443); } sub clean_content { my ($self,$content) = @_; my %content = $self->content(); { no warnings 'uninitialized'; # strip non-digits from card number my $card_number = ''; if ( $content{card_number} ) { $content{card_number} =~ s/\D//g; } # separate month and year values for expiry_date if ( $content{expiration} ) { ($content{exp_month}, $content{exp_year}) = split /\//, $content{expiration}; $content{exp_month} = sprintf "%02d", $content{exp_month}; $content{exp_year} = substr($content{exp_year},0,2) if ($content{exp_year} > 99); } if (!$content{'first_name'} || !$content{'last_name'} && $content{'name'}) { ($content{'first_name'}, $content{'last_name'}) = split(' ', $content{'name'}, 2); } if ($content{'address'} =~ m/[\D ]*(\d+)\D/) { $content{'street_number'} = $1; } } warn "Content after cleaning:\n".Dumper(\%content)."\n" if ($DEBUG >2); $self->content(%content); } sub process_content { my $self = shift; $self->clean_content(); my %content = $self->content(); $self->action(($action_mapping{lc $content{'action'}}) ? $action_mapping{lc $content{'action'}} : lc $content{'action'}); $self->path($payment_actions{ $self->action }{path}); $self->appid($content{appid}) if (!$self->appid && $content{appid}); } sub submit { my $self = shift; # inistialize standard B::OP attributes $self->is_success(0); $self->$_( '' ) for qw/authorization result_code error_message server_response/; # clean and process the $self->content info $self->process_content(); my %content = $self->content; my $action = $self->action(); my @acceptable_actions = ('charge', 'refund', 'void'); unless ( grep { $action eq $_ } @acceptable_actions ) { croak "'$action' is not supported at this time."; } # fill out the template vars my $template_vars = { auth => { platform => $self->platform, userid => $self->userid, gid => $self->gid, tid => $self->tid }, payment => { amount => $content{'amount'}, track1 => ($content{'track1'}) ? $content{'track1'} : '', track2 => ($content{'track2'}) ? $content{'track2'} : '', type => ($content{'description'}) ? $content{'description'} : '', cf1 => ($content{'UDField1'}) ? $content{'UDField1'} : '', cf2 => ($content{'UDField2'}) ? $content{'UDField2'} : '', cf3 => '', account_number => ($content{'card_number'}) ? $content{'card_number'} : '', exp_month => $content{'exp_month'}, exp_year => $content{'exp_year'}, cvv => ($content{'cvv'}) ? $content{'cvv'} : ($content{'cvv2'}) ? $content{'cvv2'} : '', first_name => ($content{'first_name'}) ? $content{'first_name'} : '', last_name => ($content{'last_name'}) ? $content{'last_name'} : '', postal_code => ($content{'zip'}) ? $content{'zip'} : '', street_address => ($content{'street_number'}) ? $content{'street_number'} : '', industry_type => ($content{'IndustryInfo'} && lc($content{'IndustryInfo'}) eq 'ecommerce') ? 'ecom_3' : '', invoice_num => ($content{'invoice_number'}) ? $content{'invoice_number'} : '', appid => $self->appid(), recurring => ($content{'recurring_billing'} && $content{'recurring_billing'} eq 'YES' ) ? 1 : 0, response_code => ($content{'response_code'}) ? $content{'response_code'} : '', reference_number=> ($content{'ref_num'}) ? $content{'ref_num'} : '', token => ($content{'token'}) ? $content{'token'} : '', receipt => ($content{'receipt'}) ? $content{'receipt'} : '', transaction_date=> ($content{'txn_date'}) ? $content{'txn_date'} : '', merchant_data => ($content{'merchant_data'}) ? $content{'merchant_data'} : '', }, # we won't be using level2 nor level3. So I'm leaving them blank for now. level2 => { card_type => '', purchase_code => '', country_code => '', ship_tp_postal_code => '', ship_from_postal_code => '', sales_tax => '', product_description1 => '', product_description2 => '', product_description3 => '', product_description4 => '' }, level3 => { purchase_order_num => '', order_date => '', duty_amount => '', alt_tax_amount => '', discount_amount => '', freight_amount => '', tax_exempt => '', line_item_count => '', purchase_items => $self->_parse_line_items() } }; # create the list of required fields based on the action my @required_fields = qw/ amount /; if ($action eq 'charge') { push(@required_fields, $_) foreach (qw/ account_number cvv exp_month exp_year /); }elsif ($action eq 'void') { push(@required_fields, $_) foreach (qw/ response_code reference_number receipt token transaction_date exp_month exp_year /); }elsif ($action eq 'refund') { push(@required_fields, $_) foreach (qw/ merchant_data token account_number exp_month exp_year /); } # check the requirements are met. my @missing_fields; foreach my $field (@required_fields) { push(@missing_fields, $field) if (!$template_vars->{payment}{$field}); } if (scalar(@missing_fields)) { croak "Missing required fields: ".join(', ', @missing_fields); } # read in the appropriate xml template my $xml_template .= _get_xml_template( $action ); # create a template object. my $tt = Template->new(); # populate the XML template. my $xml_data; $tt->process( \$xml_template, $template_vars, \$xml_data ) || croak $tt->error(); warn "XML:\n$xml_data\n" if $DEBUG > 2; # my $opts = {'Content-Type' => 'multipart/form-data'}; my $opts = {'Cache-Control' => 'no-cache', 'Content-Type' => 'multipart/form-data; boundary=----FormBoundaryE19zNvXGzXaLvS5C'}; my $params = {param => $xml_data}; my $content = qq|----FormBoundaryE19zNvXGzXaLvS5C Content-Disposition: form-data; name="param" ${xml_data} ----FormBoundaryE19zNvXGzXaLvS5C|; my ( $page, $server_response, %headers ) = $self->https_post( $opts, $content ); # store the server response. $self->server_response($server_response); # parse the result page. $self->parse_response($page); if (!$self->is_success() && !$self->error_message() ) { if ( $DEBUG ) { #additional logging information, possibly too sensitive for an error msg # (vSecureProcessing seems to have a failure mode where they return the full # original request including card number) $self->error_message( "(HTTPS response: ".$server_response.") ". "(HTTPS headers: ". join(", ", map { "$_ => ". $headers{$_} } keys %headers ). ") ". "(Raw HTTPS content: ".$page.")" ); } else { $self->error_message('No error information was returned by vSecureProcessing (enable debugging for raw HTTPS response)'); } } } # read $self->server_response and decipher any errors sub parse_response { my $self = shift; my $page = shift; if ($self->server_response =~ /^200/) { my $response = XMLin($page); $self->result_code($response->{Status}); $self->avs_response($response->{AvsResponse}); $self->cvv_response($response->{CvvResponse}); $self->is_success($self->result_code() eq '0' ? 1 : 0); if ($self->is_success()) { $self->authorization($response->{AuthIdentificationResponse}); } # fill in error_message if there is is an error if ( !$self->is_success && exists($response->{ResultCode})) { $self->error_message('Error '.$response->{ResponseCode}.': '.$response->{ResultCode}); }elsif ( !$self->is_success && exists($response->{Receipt}) ) { $self->error_message('Error '.$response->{ResponseCode}.': '.(exists($response->{Receipt})) ? $response->{Receipt} : ''); } }else { $self->is_success(0); $self->error_message('Error communicating with vSecureProcessing server'); return; } } sub _get_xml_template { my $action = shift; my $xml_template = q| [% auth.platform %] [% auth.userid %] [% auth.gid %] [% auth.tid %] |; if ($action eq 'charge') { $xml_template .= _get_xml_template_charge(); }elsif($action eq 'void') { $xml_template .= _get_xml_template_void(); }elsif($action eq 'authorize') { $xml_template .= _get_xml_template_auth(); }elsif($action eq 'authorize_cancel') { $xml_template .= _get_xml_template_auth_cancel(); }elsif($action eq 'refund') { $xml_template .= _get_xml_template_refund(); }elsif($action eq 'capture') { $xml_template .= _get_xml_template_capture(); }elsif($action eq 'create_token') { $xml_template .= _get_xml_template_create_token(); }elsif($action eq 'delete_token') { $xml_template .= _get_xml_template_delete_token(); }elsif($action eq 'query_token') { $xml_template .= _get_xml_template_query_token(); }elsif($action eq 'update_exp_date') { $xml_template .= _get_xml_template_update_exp_date(); }elsif($action eq 'update_token') { $xml_template .= _get_xml_template_update_token(); } $xml_template .= ""; $xml_template =~ s/[\n\t\s]*//g; return $xml_template; } sub _get_xml_template_charge { my $xml_template = q| [% payment.amount %] [% payment.track1 %] [% payment.track2 %] [% payment.type %] [% payment.cf1 %] [% payment.cf2 %] [% payment.cf3 %] [% payment.account_number %] [% payment.exp_month %] [% payment.exp_year %] [% payment.cvv %] [% payment.first_name %] [% payment.last_name %] [% payment.postal_code %] [% payment.street_address %] [% payment.industry_type %] [% payment.invoice_num %] [% payment.appid %] [% payment.recurring %] |; # other options (that we are not using right now): # # [% level2.card_type %] # [% level2.purchase_code %] # [% level2.country_code %] # [% level2.ship_tp_postal_code %] # [% level2.ship_from_postal_code %] # [% level2.sales_tax %] # [% level2.product_description1 %] # [% level2.product_description2 %] # [% level2.product_description3 %] # [% level2.product_description4 %] # # # [% level3.purchase_order_num %] # [% level3.order_date %] # [% level3.duty_amount %] # [% level3.alt_tax_amount %] # [% level3.discount_amount %] # [% level3.freight_amount %] # [% level3.tax_exempt %] # [% level3.line_item_count %] # # [% level3.purchase_items %] # # return $xml_template; } sub _parse_line_items { my $self = shift; my %content = $self->content(); return '' if (!$content{'items'}); my @line_items; my $template = q| [% seq_num %] [% code %] [% desc %] [% qty %] [% unit %] [% unit_cost %] [% amount %] [% discount_amount %] [% tax_amount %] [% tax_rate %] |; my @items = $content{'items'}; foreach my $item (@items) { # fille in the slots from $template with details in $item # push to @line_items } return join("\n", @line_items); } sub _get_xml_template_void { my $xml_template = q| [% payment.amount %] [% payment.account_number %] [% payment.exp_month %] [% payment.exp_year %] [% payment.reference_number %] [% payment.industry_type %] [% payment.appid %] |; return $xml_template; } sub _get_xml_template_refund { my $xml_template = q| [% payment.amount %] [% payment.account_number %] [% payment.exp_month %] [% payment.exp_year %] [% payment.appid %] |; return $xml_template; } sub _get_xml_template_auth { my $xml_template = ''; return $xml_template; } sub _get_xml_template_auth_cancel { my $xml_template = ''; return $xml_template; } sub _get_xml_template_capture { my $xml_template = ''; return $xml_template; } sub _get_xml_template_create_token { my $xml_template = ''; return $xml_template; } sub _get_xml_template_delete_token { my $xml_template = ''; return $xml_template; } sub _get_xml_template_query_token { my $xml_template = ''; return $xml_template; } sub _get_xml_template_update_exp_date { my $xml_template = ''; return $xml_template; } sub _get_xml_template_update_token { my $xml_template = ''; return $xml_template; } 1; __END__ =head1 NAME Business::OnlinePayment::vSecureProcessing - vSecureProcessing backend for Business::OnlinePayment =head1 SYNOPSIS use Business::OnlinePayment; my %processor_info = ( platform => '####', gid => 12345678901234567890, tid => 01, user_id => '####', url => 'www.####.com' ); my $tx = new Business::OnlinePayment( "vSecureProcessing", %processor_info); $tx->content( appid => '######', type => 'VISA', action => 'Normal Authorization', description => 'Business::OnlinePayment test', amount => '49.95', customer_id => 'tfb', name => 'Tofu Beast', address => '123 Anystreet', city => 'Anywhere', state => 'UT', zip => '84058', card_number => '4007000000027', expiration => '09/02', cvv2 => '1234', #optional ); $tx->submit(); if($tx->is_success()) { print "Card processed successfully: ".$tx->authorization."\n"; } else { print "Card was rejected: ".$tx->error_message."\n"; } =head1 DESCRIPTION For detailed information see L. =head1 METHODS AND FUNCTIONS See L for the complete list. The following methods either override the methods in L or provide additional functions. =head2 result_code Returns the response error code. =head2 error_message Returns the response error description text. =head2 server_response Returns the complete response from the server. =head1 Handling of content(%content) data: =head2 action The following actions are valid normal authorization credit void =head1 Setting vSecureProcessing parameters from content(%content) The following rules are applied to map data to vSecureProcessing parameters from content(%content): # param => $content{} AccountNumber => 'card_number', Cvv => 'cvv2', ExpirationMonth => \( $month ), # MM from MM/YY of 'expiration' ExpirationYear => \( $year ), # YY from MM/YY of 'expiration' Trk1 => 'track1', Trk2 => 'track2', CardHolderFirstName => 'first_name', CardHolderLastName => 'last_name', Amount => 'amount' AvsStreet => 'address', AvsZip => 'zip', Cf1 => 'UDField1', Cf2 => 'UDField2', IndustryType => 'IndustryInfo', =head1 NOTE =head1 COMPATIBILITY Business::OnlinePayment::vSecureProcessing uses vSecureProcessing XML Document Version: 140901 (September 1, 2014). See http://www.vsecureprocessing.com/ for more information. =head1 AUTHORS Original author: Alex Brelsfoard Current maintainer: Alex Brelsfoard =head1 COPYRIGHT Copyright (c) 2015 Freeside Internet Services, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 ADVERTISEMENT Need a complete, open-source back-office and customer self-service solution? The Freeside software includes support for credit card and electronic check processing with vSecureProcessing and over 50 other gateways, invoicing, integrated trouble ticketing, and customer signup and self-service web interfaces. http://freeside.biz/freeside/ =head1 SEE ALSO perl(1). L. =cut