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         foreach my $hdr ( keys %headers ) {
 160             $ua->default_header( $hdr => $headers{$hdr} );
 161         }
 162         my $res = $ua->request( GET($url) );
 163
 164         (
 165             $res->content, $res->code,
 166             map { $_ => $res->header($_) } $res->header_field_names
 167         );
 168     }
 169     else {
 170         die "unknown SSL module $ssl_module";
 171     }
 172 }
 173
 174 =item https_post [ \%options ] SCALAR | HASHREF | FIELD => VALUE, ...
 175
 176 Accepts form fields and values as either a hashref or a list.  In the
 177 latter case, ordering is preserved (see L<Tie::IxHash> to do so when
 178 passing a hashref).
 179
 180 Also accepts instead a simple scalar containing the raw content.
 181
 182 Returns a list consisting of the page content as a string, the HTTP
 183 response code, and a list of key/value pairs representing the HTTP
 184 response headers.
 185
 186 The options hashref supports setting headers and Content-Type:
 187
 188   {
 189       headers => { 'X-Header1' => 'value', ... },
 190       Content-Type => 'text/namevalue',
 191   }
 192
 193 =cut
 194
 195 sub https_post {
 196     my $self = shift;
 197
 198     # handle optional options hashref
 199     my $opts;
 200     if ( scalar(@_) > 1 and ref( $_[0] ) eq "HASH" ) {
 201         $opts = shift;
 202     }
 203
 204     # accept a hashref or a list (keep it ordered)
 205     my $post_data;
 206     if ( ref( $_[0] ) eq 'HASH' ) {
 207         $post_data = shift;
 208     }
 209     elsif ( scalar(@_) > 1 ) {
 210         tie my %hash, 'Tie::IxHash', @_;
 211         $post_data = \%hash;
 212     }
 213     elsif ( scalar(@_) == 1 ) {
 214         $post_data = shift;
 215     }
 216     else {
 217         die "https_post called with no params\n";
 218     }
 219
 220     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 221
 222     ### XXX referer!!!
 223     my %headers;
 224     if ( ref( $opts->{headers} ) eq "HASH" ) {
 225         %headers = %{ $opts->{headers} };
 226     }
 227     $headers{'Host'} ||= $self->server;
 228
 229     if ( $DEBUG && ref($post_data) ) {
 230         warn "post data:\n",
 231           join( '',
 232             map { "  $_ => " . $post_data->{$_} . "\n" } keys %$post_data );
 233     }
 234
 235     if ( $ssl_module eq 'Net::SSLeay' ) {
 236
 237         import Net::SSLeay qw(post_https make_headers make_form);
 238         my $headers = make_headers(%headers);
 239
 240         if ($DEBUG) {
 241             no warnings 'uninitialized';
 242             warn $self->server . ':' . $self->port . $self->path . "\n";
 243             $Net::SSLeay::trace = $DEBUG;
 244         }
 245
 246         my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 247         post_https( $self->server, $self->port, $self->path, $headers,
 248             $raw_data, $opts->{"Content-Type"} );
 249     }
 250     elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 251
 252         import HTTP::Request::Common qw(POST);
 253
 254         my $url = 'https://' . $self->server;
 255         $url .= ':' . $self->port
 256           unless $self->port == 443;
 257         $url .= $self->path;
 258
 259         if ($DEBUG) {
 260             warn $url;
 261         }
 262
 263         my $ua = new LWP::UserAgent;
 264         foreach my $hdr ( keys %headers ) {
 265             $ua->default_header( $hdr => $headers{$hdr} );
 266         }
 267
 268         my $res;
 269         if ( ref($post_data) ) {
 270             $res = $ua->request( POST( $url, [%$post_data] ) );
 271         }
 272         else {
 273             my $req = new HTTP::Request( 'POST' => $url );
 274             $req->content_type( $opts->{"Content-Type"} );
 275             $req->content($post_data);
 276             $res = $ua->request($req);
 277         }
 278
 279         (
 280             $res->content, $res->code,
 281             map { $_ => $res->header($_) } $res->header_field_names
 282         );
 283     }
 284     else {
 285         die "unknown SSL module $ssl_module";
 286     }
 287 }
 288
 289 =back
 290
 291 =head1 SEE ALSO
 292
 293 L<Business::OnlinePayment>
 294
 295 =cut
 296
 297 1;