From 06aef4f2a899ed6d6aaaf77c23567aea7db8847c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 25 May 2010 04:57:47 +0000 Subject: [PATCH] refactor most of the B:OP:HTTPS code out to Net:HTTPS::Any. Add card_token documentation. Add token_support to introspection --- Changes | 3 + Makefile.PL | 10 +- OnlinePayment.pm | 24 +++- OnlinePayment/HTTPS.pm | 269 +++++++++----------------------------------- notes_for_module_writers_v3 | 7 +- 5 files changed, 85 insertions(+), 228 deletions(-) diff --git a/Changes b/Changes index f916a36..d438c3b 100644 --- a/Changes +++ b/Changes @@ -10,6 +10,9 @@ Revision history for Perl extension Business::OnlinePayment. - Add clarification to notes_for_module_writers_v3 on authorization vs. order_number - (3.01_03) Add ECHECK_void_requires_account to introspection + - (3.01_04) Refactor most of the B:OP:HTTPS code out to Net:HTTPS::Any + - (3.01_04) Add card_token documentation. Add token_support to + introspection. 3.00 Mon Aug 17 15:55:11 PDT 2009 - It finally happened. diff --git a/Makefile.PL b/Makefile.PL index 54d15bb..03657c1 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -8,14 +8,8 @@ WriteMakefile( 'PMLIBDIRS' => [ 'OnlinePayment', 'FraudDetect' ], 'NORECURS' => 1, # dont descend into subdirectories 'PREREQ_PM' => { - # for HTTPS (maybe it should be a separate dist?) - 'URI::Escape' => 0, - 'Tie::IxHash' => 0, - - # 'Net::SSLeay' => 0, - # or 'Crypt::SSLeay' => 0, - # 'URI - + 'Tie::IxHash' => 0, + 'Net::HTTPS::Any' => 0, }, #'dist' => {CI => 'ci -l'}, ); diff --git a/OnlinePayment.pm b/OnlinePayment.pm index 482f6e8..00a34c1 100644 --- a/OnlinePayment.pm +++ b/OnlinePayment.pm @@ -6,7 +6,7 @@ use Carp; require 5.005; -$VERSION = '3.01_03'; +$VERSION = '3.01_04'; $VERSION = eval $VERSION; # modperlstyle: convert the string into a number # Remember subclasses we have "wrapped" submit() with _pre_submit() @@ -492,14 +492,27 @@ IP Address from which the transaction originated. Credit card number. +=item expiration + +Credit card expiration. + =item cvv2 CVV2 number (also called CVC2 or CID) is a three- or four-digit security code used to reduce credit card fraud. -=item expiration +=item card_token -Credit card expiration. +If supported by your gateway, you can pass a card_token instead of a +card_number and expiration. + +=cut + +#=item card_response +# +#Some card_token schemes implement a challenge/response handshake. In those +#cases, this field is used for the response. In most cases the handshake +#it taken care of by the gateway module. =item track1 @@ -649,6 +662,11 @@ later. The unique order number for the transaction generated by the gateway. Store this if you would like to run inquiries or refunds on the transaction later. +=head2 card_token() + +If supported by your gateway, a card_token can be used in a subsequent +transaction to refer to a card number. + =head2 fraud_score() Retrieve or change the fraud score from any Business::FraudDetect plugin diff --git a/OnlinePayment/HTTPS.pm b/OnlinePayment/HTTPS.pm index cb51905..7248cd7 100644 --- a/OnlinePayment/HTTPS.pm +++ b/OnlinePayment/HTTPS.pm @@ -1,46 +1,14 @@ package Business::OnlinePayment::HTTPS; use strict; -use vars qw($VERSION $DEBUG $ssl_module $skip_NetSSLeay); -use URI::Escape; -use Tie::IxHash; use base qw(Business::OnlinePayment); +use vars qw($VERSION $DEBUG); +use Tie::IxHash; +use Net::HTTPS::Any 0.10; -$VERSION = '0.09'; +$VERSION = '0.10'; $DEBUG = 0; -BEGIN { - - $ssl_module = ''; - - eval { - die if defined($skip_NetSSLeay) && $skip_NetSSLeay; - require Net::SSLeay; - Net::SSLeay->VERSION(1.30); - - #import Net::SSLeay - # qw(get_https post_https make_form make_headers); - $ssl_module = 'Net::SSLeay'; - }; - - if ($@) { - eval { - require LWP::UserAgent; - require HTTP::Request::Common; - require Crypt::SSLeay; - - #import HTTP::Request::Common qw(GET POST); - $ssl_module = 'Crypt::SSLeay'; - }; - } - - unless ($ssl_module) { - die "One of Net::SSLeay (v1.30 or later)" - . " or Crypt::SSLeay (+LWP) is required"; - } - -} - =head1 NAME Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs @@ -72,7 +40,8 @@ Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs This is a base class for HTTPS based gateways, providing useful code for implementors of HTTPS payment APIs. -It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ). +It depends on Net::HTTPS::Any, which in turn depends on +Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ). =head1 METHODS @@ -88,108 +57,53 @@ Returns a list consisting of the page content as a string, the HTTP response code and message (i.e. "200 OK" or "404 Not Found"), and a list of key/value pairs representing the HTTP response headers. -The options hashref supports setting headers and Content-Type: +The options hashref supports setting headers: { headers => { 'X-Header1' => 'value', ... }, - Content-Type => 'text/namevalue', } =cut +# Content-Type => 'text/namevalue', + sub https_get { my $self = shift; # handle optional options hashref - my $opts; + my $opts = {}; if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) { - $opts = shift; + $opts = shift; } # accept a hashref or a list (keep it ordered) my $post_data; if ( ref( $_[0] ) eq 'HASH' ) { - $post_data = shift; - } - elsif ( scalar(@_) > 1 ) { - tie my %hash, 'Tie::IxHash', @_; - $post_data = \%hash; - } - elsif ( scalar(@_) == 1 ) { - $post_data = shift; - } - else { - die "https_get called with no params\n"; - } - - $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded"; - - ### XXX referer!!! - my %headers; - if ( ref( $opts->{headers} ) eq "HASH" ) { - %headers = %{ $opts->{headers} }; - } - $headers{'Host'} ||= $self->server; - - my $path = $self->path; - if ( keys %$post_data ) { - $path .= '?' - . join( '&', - map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) } - keys %$post_data ); + $post_data = shift; + } elsif ( scalar(@_) > 1 ) { + tie my %hash, 'Tie::IxHash', @_; + $post_data = \%hash; + } elsif ( scalar(@_) == 1 ) { + $post_data = shift; + } else { + die "https_get called with no params\n"; } $self->build_subs(qw( response_page response_code response_headers )); - if ( $ssl_module eq 'Net::SSLeay' ) { - - import Net::SSLeay qw(get_https make_headers); - my $headers = make_headers(%headers); - - my( $res_page, $res_code, @res_headers ) = - get_https( $self->server, - $self->port, - $path, - $headers, - "", - $opts->{"Content-Type"}, - ); - - $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2; - - $self->response_page( $res_page ); - $self->response_code( $res_code ); - $self->response_headers( { @res_headers } ); - - ( $res_page, $res_code, @res_headers ); - - } elsif ( $ssl_module eq 'Crypt::SSLeay' ) { - - import HTTP::Request::Common qw(GET); - - my $url = 'https://' . $self->server; - $url .= ':' . $self->port - unless $self->port == 443; - $url .= "/$path"; + my( $res_page, $res_code, @res_headers) = Net::HTTPS::Any::https_get( + 'host' => $self->server, + 'path' => $self->path, + 'headers' => $opts->{headers}, + 'args' => $post_data, + 'debug' => $DEBUG, + ); - my $ua = new LWP::UserAgent; - foreach my $hdr ( keys %headers ) { - $ua->default_header( $hdr => $headers{$hdr} ); - } - my $res = $ua->request( GET($url) ); + $self->response_page( $res_page ); + $self->response_code( $res_code ); + $self->response_headers( { @res_headers } ); - my @res_headers = map { $_ => $res->header($_) } - $res->header_field_names; - - $self->response_page( $res->content ); - $self->response_code( $res->code. ' '. $res->message ); - $self->response_headers( { @res_headers } ); - - ( $res->content, $res->code. ' '. $res->message, @res_headers ); - - } else { - die "unknown SSL module $ssl_module"; - } + ( $res_page, $res_code, @res_headers ); } @@ -218,115 +132,42 @@ sub https_post { my $self = shift; # handle optional options hashref - my $opts; + my $opts = {}; if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) { $opts = shift; } + my %post = ( + 'host' => $self->server, + 'path' => $self->path, + 'headers' => $opts->{headers}, + 'Content-Type' => $opts->{'Content-Type'}, + 'debug' => $DEBUG, + ); + # accept a hashref or a list (keep it ordered) - my $post_data; + my $post_data = ''; + my $content = undef; if ( ref( $_[0] ) eq 'HASH' ) { - $post_data = shift; - } - elsif ( scalar(@_) > 1 ) { - tie my %hash, 'Tie::IxHash', @_; - $post_data = \%hash; - } - elsif ( scalar(@_) == 1 ) { - $post_data = shift; - } - else { - die "https_post called with no params\n"; - } - - $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded"; - - ### XXX referer!!! - my %headers; - if ( ref( $opts->{headers} ) eq "HASH" ) { - %headers = %{ $opts->{headers} }; - } - $headers{'Host'} ||= $self->server; - - if ( $DEBUG && ref($post_data) ) { - warn "post data:\n", - join( '', - map { " $_ => " . $post_data->{$_} . "\n" } keys %$post_data ); + $post{'args'} = shift; + } elsif ( scalar(@_) > 1 ) { + tie my %hash, 'Tie::IxHash', @_; + $post{'args'} = \%hash; + } elsif ( scalar(@_) == 1 ) { + $post{'content'} = shift; + } else { + die "https_post called with no params\n"; } $self->build_subs(qw( response_page response_code response_headers )); - if ( $ssl_module eq 'Net::SSLeay' ) { - - import Net::SSLeay qw(post_https make_headers make_form); - my $headers = make_headers(%headers); + my( $res_page, $res_code, @res_headers)= Net::HTTPS::Any::https_post(%post); - if ($DEBUG) { - no warnings 'uninitialized'; - warn $self->server . ':' . $self->port . $self->path . "\n"; - $Net::SSLeay::trace = $DEBUG; - } + $self->response_page( $res_page ); + $self->response_code( $res_code ); + $self->response_headers( { @res_headers } ); - my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data; - - my( $res_page, $res_code, @res_headers ) = - post_https( $self->server, - $self->port, - $self->path, - $headers, - $raw_data, - $opts->{"Content-Type"}, - ); - - $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2; - - $self->response_page( $res_page ); - $self->response_code( $res_code ); - $self->response_headers( { @res_headers } ); - - ( $res_page, $res_code, @res_headers ); - - } elsif ( $ssl_module eq 'Crypt::SSLeay' ) { - - import HTTP::Request::Common qw(POST); - - my $url = 'https://' . $self->server; - $url .= ':' . $self->port - unless $self->port == 443; - $url .= $self->path; - - if ($DEBUG) { - warn $url; - } - - my $ua = new LWP::UserAgent; - foreach my $hdr ( keys %headers ) { - $ua->default_header( $hdr => $headers{$hdr} ); - } - - my $res; - if ( ref($post_data) ) { - $res = $ua->request( POST( $url, [%$post_data] ) ); - } - else { - my $req = new HTTP::Request( 'POST' => $url ); - $req->content_type( $opts->{"Content-Type"} ); - $req->content($post_data); - $res = $ua->request($req); - } - - my @res_headers = map { $_ => $res->header($_) } - $res->header_field_names; - - $self->response_page( $res->content ); - $self->response_code( $res->code. ' '. $res->message ); - $self->response_headers( { @res_headers } ); - - ( $res->content, $res->code. ' '. $res->message, @res_headers ); - - } else { - die "unknown SSL module $ssl_module"; - } + ( $res_page, $res_code, @res_headers ); } @@ -334,7 +175,7 @@ sub https_post { =head1 SEE ALSO -L +L, L =cut diff --git a/notes_for_module_writers_v3 b/notes_for_module_writers_v3 index f8d9ce5..e7f0501 100644 --- a/notes_for_module_writers_v3 +++ b/notes_for_module_writers_v3 @@ -5,9 +5,6 @@ These are the module writer's notes for v3. See the regular - If your gateway is HTTPS-based, use (or convert to) Business::OnlinePayment::HTTPS !! - - Business::OnlinePayment::OpenECHO is the first "v3-ish" module, try - starting from there. - - Handling failures: @@ -53,6 +50,8 @@ These are the module writer's notes for v3. See the regular 'gateway_url' => 'http://www.example.com/', 'module_version' => $VERSION, 'supported_types' => [ qw( CC ECHECK ) ], + 'token_support' => 0, #card storage/tokenization support + 'test_transaction' => 0, #set true if ->test_transaction(1) works 'supported_actions' => [ 'Normal Authorization', 'Authorization Only', @@ -74,6 +73,8 @@ These are the module writer's notes for v3. See the regular 'module_version' => $VERSION, 'module_notes' => 'usage notes', 'supported_types' => [ qw( CC ECHECK ) ], + 'token_support' => 1, + 'test_transaction' => 1, 'supported_actions' => { 'CC' => [ 'Normal Authorization', 'Authorization Only', -- 2.11.0