lib/Net/HTTPS/Any.pm

   1 package Net::HTTPS::Any;
   2
   3 use warnings;
   4 use strict;
   5 use base qw( Exporter );
   6 use vars qw(@EXPORT_OK $ssl_module $skip_NetSSLeay);
   7 use URI::Escape;
   8 use Tie::IxHash;
   9
  10 @EXPORT_OK = qw( https_get https_post );
  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 Net::HTTPS::Any - Simple HTTPS client using whichever underlying SSL module is available
  47
  48 =cut
  49
  50 our $VERSION = '0.11';
  51
  52 =head1 SYNOPSIS
  53
  54   use Net::HTTPS::Any qw(https_get https_post);
  55
  56   ( $page, $response, %reply_headers )
  57       = https_get(
  58                    { 'host' => 'www.fortify.net',
  59                      'port' => 443,
  60                      'path' => '/sslcheck.html',
  61                      'args' => { 'field' => 'value' },
  62                      #'args' => [ 'field'=>'value' ], #order preserved
  63                    },
  64                  );
  65
  66   ( $page, $response, %reply_headers )
  67       = https_post(
  68                     'host' => 'www.google.com',
  69                     'port' => 443,
  70                     'path' => '/accounts/ServiceLoginAuth',
  71                     'args' => { 'field' => 'value' },
  72                     #'args' => [ 'field'=>'value' ], #order preserved
  73                   );
  74
  75   #...
  76
  77 =head1 DESCRIPTION
  78
  79 This is a simple wrapper around either of the two available SSL
  80 modules.  It offers a unified API for sending GET and POST requests over HTTPS
  81 and receiving responses.
  82
  83 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
  84
  85 =head1 WHY THIS MODULE
  86
  87 If you just want to write something that speaks HTTPS, you don't need this
  88 module.  Just go ahead and use whichever of the two modules is good for you.
  89 Don't worry about it.
  90
  91 On the other hand, if you are a CPAN author or distribute a Perl application,
  92 especially if you aim to support multiple OSes/disributions, using this module
  93 for speaking HTTPS may make things easier on your users.  It allows your code
  94 to be used with either SSL implementation.
  95
  96 =head1 FUTURE
  97
  98 Using LWP::Protocol::https 6.02 or later, the LWP path actually uses
  99 Net::SSLeay also instead of Crypt::SSLeay.  Going forward that makes this
 100 module more of historical interest, especially so since modern LWP has its own
 101 mechanism to force use of Crypt::SSLeay:
 102   $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL";
 103
 104 Therefore this module will likely eventually become a wrapper around a single
 105 codepath, driven by the conservative needs of Business::OnlinePayment::HTTPS.
 106
 107 =head1 FUNCTIONS
 108
 109 =head2 https_get HASHREF | FIELD => VALUE, ...
 110
 111 Accepts parameters as either a hashref or a list of fields and values.
 112
 113 Parameters are:
 114
 115 =over 4
 116
 117 =item host
 118
 119 =item port
 120
 121 =item path
 122
 123 =item headers (hashref)
 124
 125 For example: { 'X-Header1' => 'value', ... }
 126
 127 =cut
 128
 129 # =item Content-Type
 130 #
 131 # Defaults to "application/x-www-form-urlencoded" if not specified.
 132
 133 =item args
 134
 135 CGI arguments, either as a hashref or a listref.  In the latter case, ordering
 136 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 137
 138 =item debug
 139
 140 Set true to enable debugging.
 141
 142 =back
 143
 144 Returns a list consisting of the page content as a string, the HTTP
 145 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 146 key/value pairs representing the HTTP response headers.
 147
 148 =cut
 149
 150 sub https_get {
 151     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 152
 153     # accept a hashref or a list (keep it ordered)
 154     my $post_data = {}; # technically get_data, pedant
 155     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 156         $post_data = $opts->{'args'};
 157     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 158         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 159         $post_data = \%hash;
 160     }
 161
 162     $opts->{'port'} ||= 443;
 163     #$opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 164
 165     ### XXX referer!!!
 166     my %headers = ();
 167     if ( ref( $opts->{headers} ) eq "HASH" ) {
 168         %headers = %{ $opts->{headers} };
 169     }
 170     $headers{'Host'} ||= $opts->{'host'};
 171
 172     my $path = $opts->{'path'};
 173     if ( keys %$post_data ) {
 174         $path .= '?'
 175           . join( ';',
 176             map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
 177               keys %$post_data );
 178     }
 179
 180     if ( $ssl_module eq 'Net::SSLeay' ) {
 181
 182         no warnings 'uninitialized';
 183
 184         import Net::SSLeay qw(get_https make_headers);
 185         my $headers = make_headers(%headers);
 186
 187         $Net::SSLeay::trace = $opts->{'debug'}
 188           if exists $opts->{'debug'} && $opts->{'debug'};
 189
 190         my( $res_page, $res_code, @res_headers ) =
 191           get_https( $opts->{'host'},
 192                      $opts->{'port'},
 193                      $path,
 194                      $headers,
 195                      #"",
 196                      #$opts->{"Content-Type"},
 197                    );
 198
 199         $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
 200
 201         return ( $res_page, $res_code, @res_headers );
 202
 203     } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 204
 205         import HTTP::Request::Common qw(GET);
 206
 207         my $url = 'https://' . $opts->{'host'};
 208         $url .= ':' . $opts->{'port'}
 209           unless $opts->{'port'} == 443;
 210         $url .= "/$path";
 211
 212         my $ua = new LWP::UserAgent;
 213         foreach my $hdr ( keys %headers ) {
 214             $ua->default_header( $hdr => $headers{$hdr} );
 215         }
 216         $ENV{HTTPS_DEBUG} = $opts->{'debug'} if exists $opts->{'debug'};
 217         my $res = $ua->request( GET($url) );
 218
 219         my @res_headers = map { $_ => $res->header($_) }
 220                               $res->header_field_names;
 221
 222         return ( $res->content, $res->code. ' '. $res->message, @res_headers );
 223
 224     } else {
 225         die "unknown SSL module $ssl_module";
 226     }
 227
 228 }
 229
 230 =head2 https_post HASHREF | FIELD => VALUE, ...
 231
 232 Accepts parameters as either a hashref or a list of fields and values.
 233
 234 Parameters are:
 235
 236 =over 4
 237
 238 =item host
 239
 240 =item port
 241
 242 =item path
 243
 244 =item headers (hashref)
 245
 246 For example: { 'X-Header1' => 'value', ... }
 247
 248 =item Content-Type
 249
 250 Defaults to "application/x-www-form-urlencoded" if not specified.
 251
 252 =item args
 253
 254 CGI arguments, either as a hashref or a listref.  In the latter case, ordering
 255 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 256
 257 =item content
 258
 259 Raw content (overrides args).  A simple scalar containing the raw content.
 260
 261 =item debug
 262
 263 Set true to enable debugging in the underlying SSL module.
 264
 265 =back
 266
 267 Returns a list consisting of the page content as a string, the HTTP
 268 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 269 key/value pairs representing the HTTP response headers.
 270
 271 =cut
 272
 273 sub https_post {
 274     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 275
 276     # accept a hashref or a list (keep it ordered).  or a scalar of content.
 277     my $post_data = '';
 278     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 279         $post_data = $opts->{'args'};
 280     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 281         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 282         $post_data = \%hash;
 283     }
 284     if ( exists $opts->{'content'} ) {
 285         $post_data = $opts->{'content'};
 286     }
 287
 288     $opts->{'port'} ||= 443;
 289     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 290
 291     ### XXX referer!!!
 292     my %headers;
 293     if ( ref( $opts->{headers} ) eq "HASH" ) {
 294         %headers = %{ $opts->{headers} };
 295     }
 296     $headers{'Host'} ||= $opts->{'host'};
 297
 298     if ( $ssl_module eq 'Net::SSLeay' ) {
 299
 300         no warnings 'uninitialized';
 301
 302         import Net::SSLeay qw(post_https make_headers make_form);
 303         my $headers = make_headers(%headers);
 304
 305         $Net::SSLeay::trace = $opts->{'debug'}
 306           if exists $opts->{'debug'} && $opts->{'debug'};
 307
 308         my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 309
 310         $Net::SSLeay::trace = $opts->{'debug'}
 311           if exists $opts->{'debug'} && $opts->{'debug'};
 312
 313         my( $res_page, $res_code, @res_headers ) =
 314           post_https( $opts->{'host'},
 315                       $opts->{'port'},
 316                       $opts->{'path'},
 317                       $headers,
 318                       $raw_data,
 319                       $opts->{"Content-Type"},
 320                     );
 321
 322         $res_code =~ /^(HTTP\S+ )?(.*)/ and $res_code = $2;
 323
 324         return ( $res_page, $res_code, @res_headers );
 325
 326     } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 327
 328         import HTTP::Request::Common qw(POST);
 329
 330         my $url = 'https://' . $opts->{'host'};
 331         $url .= ':' . $opts->{'port'}
 332           unless $opts->{'port'} == 443;
 333         $url .= $opts->{'path'};
 334
 335         my $ua = new LWP::UserAgent;
 336         foreach my $hdr ( keys %headers ) {
 337             $ua->default_header( $hdr => $headers{$hdr} );
 338         }
 339
 340         $ENV{HTTPS_DEBUG} = $opts->{'debug'} if exists $opts->{'debug'};
 341
 342         my $res;
 343         if ( ref($post_data) ) {
 344             $res = $ua->request( POST( $url, [%$post_data] ) );
 345         }
 346         else {
 347             my $req = new HTTP::Request( 'POST' => $url );
 348             $req->content_type( $opts->{"Content-Type"} );
 349             $req->content($post_data);
 350             $res = $ua->request($req);
 351         }
 352
 353         my @res_headers = map { $_ => $res->header($_) }
 354                               $res->header_field_names;
 355
 356         return ( $res->content, $res->code. ' '. $res->message, @res_headers );
 357
 358     } else {
 359         die "unknown SSL module $ssl_module";
 360     }
 361
 362 }
 363
 364 =head1 AUTHOR
 365
 366 Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
 367
 368 =head1 BUGS
 369
 370 Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
 371 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>.  I will be notified, and then you'll
 372 automatically be notified of progress on your bug as I make changes.
 373
 374 =head1 SUPPORT
 375
 376 You can find documentation for this module with the perldoc command.
 377
 378     perldoc Net::HTTPS::Any
 379
 380 You can also look for information at:
 381
 382 =over 4
 383
 384 =item * RT: CPAN's request tracker
 385
 386 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
 387
 388 =item * AnnoCPAN: Annotated CPAN documentation
 389
 390 L<http://annocpan.org/dist/Net-HTTPS-Any>
 391
 392 =item * CPAN Ratings
 393
 394 L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
 395
 396 =item * Search CPAN
 397
 398 L<http://search.cpan.org/dist/Net-HTTPS-Any>
 399
 400 =back
 401
 402 =head1 COPYRIGHT & LICENSE
 403
 404 Copyright 2008-2014 Freeside Internet Services, Inc. (http://freeside.biz/)
 405 All rights reserved.
 406
 407 This program is free software; you can redistribute it and/or modify it
 408 under the same terms as Perl itself.
 409
 410 =cut
 411
 412 1;