From: ivan Date: Tue, 11 Jan 2005 06:40:41 +0000 (+0000) Subject: 3.00_02! X-Git-Tag: BUSINESS_ONLINEPAYMENT_3_00_02~1 X-Git-Url: http://git.freeside.biz/gitweb/?p=Business-OnlinePayment.git;a=commitdiff_plain;h=22ec7305015c71ce255e67ebb1d065184aa8b953 3.00_02! --- diff --git a/Changes b/Changes index 635b2b4..2556100 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for Perl extension Business::OnlinePayment. +3.00_02 Mon Jan 10 21:36:53 PST 2005 + - HTTPS base class now has https_post in addition to https_get + 3.00_01 Thu Aug 26 04:49:26 2004 - first of the v3 dev releases diff --git a/OnlinePayment.pm b/OnlinePayment.pm index c34ad8f..73e4010 100644 --- a/OnlinePayment.pm +++ b/OnlinePayment.pm @@ -11,7 +11,7 @@ require 5.004; #@EXPORT = qw(); #@EXPORT_OK = qw(); -$VERSION = '3.00_01'; +$VERSION = '3.00_02'; sub VERSION { #Argument "3.00_01" isn't numeric in subroutine entry local($^W)=0; UNIVERSAL::VERSION(@_); diff --git a/OnlinePayment/HTTPS.pm b/OnlinePayment/HTTPS.pm index 0ba897d..26f1748 100644 --- a/OnlinePayment/HTTPS.pm +++ b/OnlinePayment/HTTPS.pm @@ -1,7 +1,7 @@ package Business::OnlinePayment::HTTPS; use strict; -use vars qw($VERSION @ISA $ssl_module $skip_NetSSLeay); +use vars qw($VERSION @ISA $DEBUG $ssl_module $skip_NetSSLeay); #use URI; #use URI::QueryParam; use URI::Escape; @@ -9,7 +9,9 @@ use Tie::IxHash; @ISA = qw( Business::OnlinePayment ); -$VERSION = '0.01'; +$VERSION = '0.02'; + +$DEBUG = 0; BEGIN { @@ -34,7 +36,7 @@ BEGIN { } unless ( $ssl_module ) { - die "Net::SSLeay (+URI) or Crypt::SSLeay (+LWP) is required"; + die "Net::SSLeay or Crypt::SSLeay (+LWP) is required"; } } @@ -128,10 +130,13 @@ sub https_get { import HTTP::Request::Common qw(GET); + my $url = 'https://'. $self->server; + $url .= ':'. $self->port + unless $self->port == 443; + $url .= '/'. $self->path; + my $ua = new LWP::UserAgent; - my $res = $ua->request( - GET( 'https://'. $self->server. ':'. $self->port. '/'. $path ) - ); + my $res = $ua->request( GET( $url ) ); #( $res->as_string, # wtf? ( $res->content, @@ -147,16 +152,136 @@ sub https_get { } -=item https_post +=item https_post HASHREF | FIELD => VALUE, ... -Not yet implemented +Accepts parameters as either a hashref or a list of fields and values. In the +latter case, ordering is preserved (see L to do so when passing a +hashref). + +Returns a list consisting of the page content as a string, the HTTP response +code, and a list of key/value pairs representing the HTTP response headers. =cut sub https_post { my $self = shift; - die "not yet implemented"; + #accept a hashref or a list (keep it ordered) + my $post_data; + if ( ref($_[0]) ) { + $post_data = shift; + } else { + tie my %hash, 'Tie::IxHash', @_; + $post_data = \%hash; + } + + my $referer = ''; ### XXX referer!!! + my %headers; + $headers{'Referer'} = $referer if length($referer); + $headers{'Host'} = $self->server; + + if ( $DEBUG ) { + warn join('', map { " $_ => ". $post_data->{$_}. "\n" } keys %$post_data ); + } + + if ( $ssl_module eq 'Net::SSLeay' ) { + + #import Net::SSLeay qw(post_https make_headers make_form); + import Net::SSLeay qw(make_headers make_form); + my $headers = make_headers(%headers); + + if ( $DEBUG ) { + warn $self->server. ':'. $self->port. $self->path. "\n"; + $Net::SSLeay::trace = 2; + } + #post_https( $self->server, $self->port, $self->path, + # $headers, make_form(%$post_data) ); + _my_post_https( $self->server, $self->port, $self->path, + $headers, make_form(%$post_data) ); + + } 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; + my $res = $ua->request( POST( $url, [ %$post_data ] ) ); + + #( $res->as_string, # wtf? + ( $res->content, + $res->code, + map { $_ => $res->header($_) } $res->header_field_names + ); + + } else { + + die "unknown SSL module $ssl_module"; + + } + +} + +# SecureHostingUPG (and presumably other IIS-based gateways?) doesn't like the +# Host: $site:$port header auto-added by Net::SSLeay, which it adds regardless +# if you supply one or not + +sub _my_post_https ($$$;***) { _my_do_httpx2(POST => 1, @_) } + +sub _my_do_httpx2 { + my ($page, $response, $headers, $server_cert) = &_my_do_httpx3; + Net::SSLeay::X509_free($server_cert) if defined $server_cert; + my($h,$v); + return ($page, $response, + map( { ($h,$v)=/^(\S+)\:\s*(.*)$/; (uc($h),$v); } + split(/\s?\n/, $headers) + ) + ); +} + +sub _my_do_httpx3 { + my ($method, $usessl, $site, $port, $path, $headers, + $content, $mime_type, $crt_path, $key_path) = @_; + my ($response, $page, $h,$v); + + my $CRLF = $Net::SSLeay::CRLF; + + if ($content) { + $mime_type = "application/x-www-form-urlencoded" unless $mime_type; + my $len = Net::SSLeay::blength($content); + $content = "Content-Type: $mime_type$CRLF" + . "Content-Length: $len$CRLF$CRLF$content"; + } else { + $content = "$CRLF$CRLF"; + } + + my $req = "$method $path HTTP/1.0$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 : '') . "Accept: */*$CRLF$content"; + + warn "do_httpx3($method,$usessl,$site:$port)" if $Net::SSLeay::trace; + 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 $Net::SSLeay::trace>1; + ($response, $headers) = split /\s?\n/, $headers, 2; + return ($page, $response, $headers, $server_cert); } =back