OnlinePayment/HTTPS.pm

   1 package Business::OnlinePayment::HTTPS;
   2
   3 use strict;
   4 use vars qw($VERSION $DEBUG $ssl_module $skip_NetSSLeay);
   5 use URI::Escape;
   6 use Tie::IxHash;
   7 use base qw(Business::OnlinePayment);
   8
   9 $VERSION = '0.05';
  10 $DEBUG   = 0;
  11
  12 BEGIN {
  13
  14     $ssl_module = '';
  15
  16     eval {
  17         die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
  18         require Net::SSLeay;
  19         Net::SSLeay->VERSION(1.30);
  20
  21         #import Net::SSLeay
  22         #  qw(get_https post_https make_form make_headers);
  23         $ssl_module = 'Net::SSLeay';
  24     };
  25
  26     if ($@) {
  27         eval {
  28             require LWP::UserAgent;
  29             require HTTP::Request::Common;
  30             require Crypt::SSLeay;
  31
  32             #import HTTP::Request::Common qw(GET POST);
  33             $ssl_module = 'Crypt::SSLeay';
  34         };
  35     }
  36
  37     unless ($ssl_module) {
  38         die "One of Net::SSLeay (v1.30 or later)"
  39           . " or Crypt::SSLeay (+LWP) is required";
  40     }
  41
  42 }
  43
  44 =head1 NAME
  45
  46 Business::OnlinePayment::HTTPS - Base class for HTTPS payment APIs
  47
  48 =head1 SYNOPSIS
  49
  50   package Business::OnlinePayment::MyProcessor;
  51   use base qw(Business::OnlinePayment::HTTPS);
  52
  53   sub submit {
  54       my $self = shift;
  55
  56       #...
  57
  58       # pass a list (order is preserved, if your gateway needs that)
  59       ( $page, $response, %reply_headers )
  60           = $self->https_get( field => 'value', ... );
  61
  62       # or a hashref
  63       my %hash = ( field => 'value', ... );
  64       ( $page, $response_code, %reply_headers )
  65             = $self->https_get( \%hash );
  66
  67       #...
  68   }
  69
  70 =head1 DESCRIPTION
  71
  72 This is a base class for HTTPS based gateways, providing useful code
  73 for implementors of HTTPS payment APIs.
  74
  75 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
  76
  77 =head1 METHODS
  78
  79 =over 4
  80
  81 =item https_get [ \%options ] HASHREF | FIELD => VALUE, ...
  82
  83 Accepts parameters as either a hashref or a list of fields and values.
  84 In the latter case, ordering is preserved (see L<Tie::IxHash> to do so
  85 when passing a hashref).
  86
  87 Returns a list consisting of the page content as a string, the HTTP
  88 response code, and a list of key/value pairs representing the HTTP
  89 response headers.
  90
  91 The options hashref supports setting headers and Content-Type:
  92
  93   {
  94       headers => { 'X-Header1' => 'value', ... },
  95       Content-Type => 'text/namevalue',
  96   }
  97
  98 =cut
  99
 100 sub https_get {
 101     my $self = shift;
 102
 103     # handle optional options hashref
 104     my $opts;
 105     if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) {
 106         $opts = shift;
 107     }
 108
 109     # accept a hashref or a list (keep it ordered)
 110     my $post_data;
 111     if ( ref( $_[0] ) eq 'HASH' ) {
 112         $post_data = shift;
 113     }
 114     elsif ( scalar(@_) > 1 ) {
 115         tie my %hash, 'Tie::IxHash', @_;
 116         $post_data = \%hash;
 117     }
 118     elsif ( scalar(@_) == 1 ) {
 119         $post_data = shift;
 120     }
 121     else {
 122         die "https_get called with no params\n";
 123     }
 124
 125     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 126
 127     ### XXX referer!!!
 128     my %headers;
 129     if ( ref( $opts->{headers} ) eq "HASH" ) {
 130         %headers = %{ $opts->{headers} };
 131     }
 132     $headers{'Host'} ||= $self->server;
 133
 134     my $path = $self->path;
 135     if ( keys %$post_data ) {
 136         $path .= '?'
 137           . join( '&',
 138             map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
 139               keys %$post_data );
 140     }
 141
 142     if ( $ssl_module eq 'Net::SSLeay' ) {
 143
 144         import Net::SSLeay qw(get_https make_headers);
 145         my $headers = make_headers(%headers);
 146         get_https( $self->server, $self->port, $path, $headers, "",
 147             $opts->{"Content-Type"} );
 148     }
 149     elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 150
 151         import HTTP::Request::Common qw(GET);
 152
 153         my $url = 'https://' . $self->server;
 154         $url .= ':' . $self->port
 155           unless $self->port == 443;
 156         $url .= "/$path";
 157
 158         my $ua  = new LWP::UserAgent;
 159         my $res = $ua->request( GET($url) );
 160
 161         (
 162             $res->content, $res->code,
 163             map { $_ => $res->header($_) } $res->header_field_names
 164         );
 165     }
 166     else {
 167         die "unknown SSL module $ssl_module";
 168     }
 169 }
 170
 171 =item https_post [ \%options ] SCALAR | HASHREF | FIELD => VALUE, ...
 172
 173 Accepts form fields and values as either a hashref or a list.  In the
 174 latter case, ordering is preserved (see L<Tie::IxHash> to do so when
 175 passing a hashref).
 176
 177 Also accepts instead a simple scalar containing the raw content.
 178
 179 Returns a list consisting of the page content as a string, the HTTP
 180 response code, and a list of key/value pairs representing the HTTP
 181 response headers.
 182
 183 The options hashref supports setting headers and Content-Type:
 184
 185   {
 186       headers => { 'X-Header1' => 'value', ... },
 187       Content-Type => 'text/namevalue',
 188   }
 189
 190 =cut
 191
 192 sub https_post {
 193     my $self = shift;
 194
 195     # handle optional options hashref
 196     my $opts;
 197     if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) {
 198         $opts = shift;
 199     }
 200
 201     # accept a hashref or a list (keep it ordered)
 202     my $post_data;
 203     if ( ref( $_[0] ) eq 'HASH' ) {
 204         $post_data = shift;
 205     }
 206     elsif ( scalar(@_) > 1 ) {
 207         tie my %hash, 'Tie::IxHash', @_;
 208         $post_data = \%hash;
 209     }
 210     elsif ( scalar(@_) == 1 ) {
 211         $post_data = shift;
 212     }
 213     else {
 214         die "https_post called with no params\n";
 215     }
 216
 217     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 218
 219     ### XXX referer!!!
 220     my %headers;
 221     if ( ref( $opts->{headers} ) eq "HASH" ) {
 222         %headers = %{ $opts->{headers} };
 223     }
 224     $headers{'Host'} ||= $self->server;
 225
 226     if ( $DEBUG && ref($post_data) ) {
 227         warn "post data:\n",
 228           join( '',
 229             map { "  $_ => " . $post_data->{$_} . "\n" } keys %$post_data );
 230     }
 231
 232     if ( $ssl_module eq 'Net::SSLeay' ) {
 233
 234         import Net::SSLeay qw(post_https make_headers make_form);
 235         my $headers = make_headers(%headers);
 236
 237         if ($DEBUG) {
 238             no warnings 'uninitialized';
 239             warn $self->server . ':' . $self->port . $self->path . "\n";
 240             $Net::SSLeay::trace = $DEBUG;
 241         }
 242
 243         my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 244         post_https( $self->server, $self->port, $self->path, $headers,
 245             $raw_data, $opts->{"Content-Type"} );
 246     }
 247     elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 248
 249         import HTTP::Request::Common qw(POST);
 250
 251         my $url = 'https://' . $self->server;
 252         $url .= ':' . $self->port
 253           unless $self->port == 443;
 254         $url .= $self->path;
 255
 256         if ($DEBUG) {
 257             warn $url;
 258         }
 259
 260         my $ua = new LWP::UserAgent;
 261
 262         my $res;
 263         if ( ref($post_data) ) {
 264             $res = $ua->request( POST( $url, [%$post_data] ) );
 265         }
 266         else {
 267             my $req = new HTTP::Request( 'POST' => $url );
 268             $req->content_type( $opts->{"Content-Type"} );
 269             $req->content($post_data);
 270             $res = $ua->request($req);
 271         }
 272
 273         (
 274             $res->content, $res->code,
 275             map { $_ => $res->header($_) } $res->header_field_names
 276         );
 277     }
 278     else {
 279         die "unknown SSL module $ssl_module";
 280     }
 281 }
 282
 283 =back
 284
 285 =head1 SEE ALSO
 286
 287 L<Business::OnlinePayment>
 288
 289 =cut
 290
 291 1;