1 package Business::OnlinePayment::HTTPS;
4 use vars qw($VERSION @ISA $DEBUG $ssl_module $skip_NetSSLeay);
10 @ISA = qw( Business::OnlinePayment );
21 die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
24 # qw(get_https post_https make_form make_headers);
25 $ssl_module = 'Net::SSLeay';
30 require LWP::UserAgent;
31 require HTTP::Request::Common;
32 require Crypt::SSLeay;
33 #import HTTP::Request::Common qw(GET POST);
34 $ssl_module = 'Crypt::SSLeay';
38 unless ( $ssl_module ) {
39 die "Net::SSLeay or Crypt::SSLeay (+LWP) is required";
46 Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs
50 package Business::OnlinePayment::MyProcessor
51 @ISA = qw( Business::OnlinePayment::HTTPS );
58 # pass a list (order is preserved, if your gateway needs that)
59 ($page, $response, %reply_headers)
60 = $self->https_get( field => 'value', ... );
63 my %hash = ( field => 'value', ... );
64 ($page, $response_code, %reply_headers)
65 = $self->https_get( $hashref );
72 This is a base class for HTTPS based gateways, providing useful code for
73 implementors of HTTPS payment APIs.
75 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
81 =item https_get HASHREF | FIELD => VALUE, ...
83 Accepts parameters as either a hashref or a list of fields and values. In the
84 latter case, ordering is preserved (see L<Tie::IxHash> to do so when passing a
87 Returns a list consisting of the page content as a string, the HTTP response
88 code, and a list of key/value pairs representing the HTTP response headers.
95 #accept a hashref or a list (keep it ordered)
100 tie my %hash, 'Tie::IxHash', @_;
104 my $path = $self->path;
105 if ( keys %$post_data ) {
107 #my $u = URI->new("", "https");
108 #$u->query_param(%$post_data);
109 #$path .= '?'. $u->query;
111 $path .= '?'. join('&',
112 map { uri_escape($_).'='. uri_escape($post_data->{$_}) }
119 my $referer = ''; ### XXX referer!!!
121 $headers{'Referer'} = $referer if length($referer);
123 if ( $ssl_module eq 'Net::SSLeay' ) {
125 import Net::SSLeay qw(get_https make_headers);
126 my $headers = make_headers(%headers);
127 get_https( $self->server, $self->port, $path, $referer, $headers );
129 } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
131 import HTTP::Request::Common qw(GET);
133 my $url = 'https://'. $self->server;
134 $url .= ':'. $self->port
135 unless $self->port == 443;
138 my $ua = new LWP::UserAgent;
139 my $res = $ua->request( GET( $url ) );
141 #( $res->as_string, # wtf?
144 map { $_ => $res->header($_) } $res->header_field_names
149 die "unknown SSL module $ssl_module";
155 =item https_post SCALAR | HASHREF | FIELD => VALUE, ...
157 Accepts form fields and values as either a hashref or a list. In the latter
158 case, ordering is preserved (see L<Tie::IxHash> to do so when passing a
161 Also accepts instead a simple scalar containing the raw content.
163 Returns a list consisting of the page content as a string, the HTTP response
164 code, and a list of key/value pairs representing the HTTP response headers.
171 #accept a hashref or a list (keep it ordered)
173 if ( ref($_[0]) eq 'HASH' ) {
175 } elsif ( scalar(@_) > 1 ) {
176 tie my %hash, 'Tie::IxHash', @_;
178 } elsif ( scalar(@_) == 1 ) {
181 die "https_post called with no params\n";
184 my $referer = ''; ### XXX referer!!!
186 $headers{'Referer'} = $referer if length($referer);
187 $headers{'Host'} = $self->server;
189 if ( $DEBUG && ref($post_data) ) {
190 warn join('', map { " $_ => ". $post_data->{$_}. "\n" } keys %$post_data );
193 if ( $ssl_module eq 'Net::SSLeay' ) {
195 #import Net::SSLeay qw(post_https make_headers make_form);
196 import Net::SSLeay qw(make_headers make_form);
197 my $headers = make_headers(%headers);
200 warn $self->server. ':'. $self->port. $self->path. "\n";
201 $Net::SSLeay::trace = 2;
203 #post_https( $self->server, $self->port, $self->path,
204 # $headers, make_form(%$post_data) );
206 my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
207 _my_post_https( $self->server, $self->port, $self->path,
208 $headers, $raw_data );
210 } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
212 import HTTP::Request::Common qw(POST);
214 my $url = 'https://'. $self->server;
215 $url .= ':'. $self->port
216 unless $self->port == 443;
223 my $ua = new LWP::UserAgent;
226 if ( ref($post_data) ) {
227 $res = $ua->request( POST( $url, [ %$post_data ] ) );
229 my $req =new HTTP::Request( 'POST' => $url );
230 $req->content_type('application/x-www-form-urlencoded');
231 $req->content($post_data);
232 $res = $ua->request($req);
235 #( $res->as_string, # wtf?
238 map { $_ => $res->header($_) } $res->header_field_names
243 die "unknown SSL module $ssl_module";
249 # SecureHostingUPG (and presumably other IIS-based gateways?) doesn't like the
250 # Host: $site:$port header auto-added by Net::SSLeay, which it adds regardless
251 # if you supply one or not
253 sub _my_post_https ($$$;***) { _my_do_httpx2(POST => 1, @_) }
256 my ($page, $response, $headers, $server_cert) = &_my_do_httpx3;
257 Net::SSLeay::X509_free($server_cert) if defined $server_cert;
259 return ($page, $response,
260 map( { ($h,$v)=/^(\S+)\:\s*(.*)$/; (uc($h),$v); }
261 split(/\s?\n/, $headers)
267 my ($method, $usessl, $site, $port, $path, $headers,
268 $content, $mime_type, $crt_path, $key_path) = @_;
269 my ($response, $page, $h,$v);
271 my $CRLF = $Net::SSLeay::CRLF;
274 $mime_type = "application/x-www-form-urlencoded" unless $mime_type;
275 my $len = Net::SSLeay::blength($content);
276 $content = "Content-Type: $mime_type$CRLF"
277 . "Content-Length: $len$CRLF$CRLF$content";
279 $content = "$CRLF$CRLF";
282 my $req = "$method $path HTTP/1.0$CRLF";
283 unless ( defined $headers && $headers =~ /^Host:/m ) {
284 $req .= "Host: $site";
285 unless ( ( $port==80 && !$usessl ) || ( $port==443 && $usessl ) ) {
290 $req .= (defined $headers ? $headers : '') . "Accept: */*$CRLF$content";
292 warn "do_httpx3($method,$usessl,$site:$port)" if $Net::SSLeay::trace;
293 my ($http, $errs, $server_cert)
294 = Net::SSLeay::httpx_cat($usessl, $site, $port, $req, $crt_path, $key_path);
295 return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs;
297 $http = '' if !defined $http;
298 ($headers, $page) = split /\s?\n\s?\n/, $http, 2;
299 warn "headers >$headers< page >>$page<< http >>>$http<<<" if $Net::SSLeay::trace>1;
300 ($response, $headers) = split /\s?\n/, $headers, 2;
301 return ($page, $response, $headers, $server_cert);
308 L<Business::OnlinePayment>