lib/Net/HTTPS/Any.pm

   1 package Net::HTTPS::Any;
   2
   3 use warnings;
   4 use strict;
   5 use vars qw(@ISA @EXPORT_OK $ssl_module $skip_NetSSLeay);
   6 use Exporter;
   7 use URI::Escape;
   8 use Tie::IxHash;
   9
  10 @ISA = qw( Exporter );
  11 @EXPORT_OK = qw( https_get https_post );
  12
  13 BEGIN {
  14
  15     $ssl_module = '';
  16
  17     eval {
  18         die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
  19         require Net::SSLeay;
  20         Net::SSLeay->VERSION(1.30);
  21
  22         #import Net::SSLeay
  23         #  qw(get_https post_https make_form make_headers);
  24         $ssl_module = 'Net::SSLeay';
  25     };
  26
  27     if ($@) {
  28         eval {
  29             require LWP::UserAgent;
  30             require HTTP::Request::Common;
  31             require Crypt::SSLeay;
  32
  33             #import HTTP::Request::Common qw(GET POST);
  34             $ssl_module = 'Crypt::SSLeay';
  35         };
  36     }
  37
  38     unless ($ssl_module) {
  39         die "One of Net::SSLeay (v1.30 or later)"
  40           . " or Crypt::SSLeay (+LWP) is required";
  41     }
  42
  43 }
  44
  45 =head1 NAME
  46
  47 Net::HTTPS::Any - Simple HTTPS class using whatever underlying module is available
  48
  49 =head1 VERSION
  50
  51 Version 0.09
  52
  53 =cut
  54
  55 our $VERSION = '0.09';
  56
  57 =head1 SYNOPSIS
  58
  59   use Net::HTTPS::Any qw(https_get https_post);
  60
  61   ( $page, $response, %reply_headers )
  62       = https_get(
  63                    { 'host' => 'secure.sisd.com',
  64                      'port' => 443,
  65                      'path' => '/freeside/index.html',
  66                      'args' => { 'field' => 'value' },
  67                      #'args' => [ 'field'=>'value' ], #order preserved
  68                    },
  69                  );
  70
  71   ( $page, $response, %reply_headers )
  72       = https_post(
  73                     'host' => 'secure.sisd.com',
  74                     'port' => 443,
  75                     'path' => '/freeside/index.html',
  76                     'args' => { 'field' => 'value' },
  77                     #'args' => [ 'field'=>'value' ], #order preserved
  78                   );
  79
  80   #...
  81
  82 =head1 DESCRIPTION
  83
  84 This is a simple wrapper around either of the two available SSL
  85 modules.  It offers a unified API for send GET and POST requests over HTTPS
  86 and receiving responses.
  87
  88 It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
  89
  90 =head1 FUNCTIONS
  91
  92 =head2 https_get HASHREF | FIELD => VALUE, ...
  93
  94 Accepts parameters as either a hashref or a list of fields and values.
  95
  96 Parameters are:
  97
  98 =over 4
  99
 100 =item host
 101
 102 =item port
 103
 104 =item path
 105
 106 =item headers (hashref)
 107
 108 For example: { 'X-Header1' => 'value', ... }
 109
 110 =item Content-Type
 111
 112 For example: 'text/namevalue',
 113
 114 =item args
 115
 116 CGI arguments, eitehr as a hashref or a listref.  In the latter case, ordering
 117 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 118
 119 =item debug
 120
 121 =back
 122
 123 Returns a list consisting of the page content as a string, the HTTP
 124 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 125 key/value pairs representing the HTTP response headers.
 126
 127 =cut
 128
 129 sub https_get {
 130     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 131
 132     # accept a hashref or a list (keep it ordered)
 133     my $post_data = {};
 134     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 135         $post_data = $opts->{'args'};
 136     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 137         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 138         $post_data = \%hash;
 139     }
 140
 141     $opts->{'port'} ||= 443;
 142     #$opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 143
 144     ### XXX referer!!!
 145     my %headers = ();
 146     if ( ref( $opts->{headers} ) eq "HASH" ) {
 147         %headers = %{ $opts->{headers} };
 148     }
 149     $headers{'Host'} ||= $opts->{'host'};
 150
 151     my $path = $opts->{'path'};
 152     if ( keys %$post_data ) {
 153         $path .= '?'
 154           . join( ';',
 155             map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
 156               keys %$post_data );
 157     }
 158
 159     if ( $ssl_module eq 'Net::SSLeay' ) {
 160
 161         import Net::SSLeay qw(get_https make_headers);
 162         my $headers = make_headers(%headers);
 163
 164         $Net::SSLeay::trace = $opts->{'debug'} if exists $opts->{'debug'};
 165
 166         my( $res_page, $res_code, @res_headers ) =
 167           get_https( $opts->{'host'},
 168                      $opts->{'port'},
 169                      $path,
 170                      $headers,
 171                      "",
 172                      $opts->{"Content-Type"},
 173                    );
 174
 175         return ( $res_page, $res_code, @res_headers );
 176
 177     } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 178
 179         import HTTP::Request::Common qw(GET);
 180
 181         my $url = 'https://' . $opts->{'host'};
 182         $url .= ':' . $opts->{'port'}
 183           unless $opts->{'port'} == 443;
 184         $url .= "/$path";
 185
 186         my $ua = new LWP::UserAgent;
 187         foreach my $hdr ( keys %headers ) {
 188             $ua->default_header( $hdr => $headers{$hdr} );
 189         }
 190         $ENV{HTTPS_DEBUG} = $opts->{'debug'} if exists $opts->{'debug'};
 191         my $res = $ua->request( GET($url) );
 192
 193         my @res_headers = map { $_ => $res->header($_) }
 194                               $res->header_field_names;
 195
 196         return ( $res->content, $res->code. ' '. $res->message, @res_headers );
 197
 198     } else {
 199         die "unknown SSL module $ssl_module";
 200     }
 201
 202 }
 203
 204 =head2 https_post HASHREF | FIELD => VALUE, ...
 205
 206 Accepts parameters as either a hashref or a list of fields and values.
 207
 208 Parameters are:
 209
 210 =over 4
 211
 212 =item host
 213
 214 =item port
 215
 216 =item path
 217
 218 =item headers (hashref)
 219
 220 For example: { 'X-Header1' => 'value', ... }
 221
 222 =item Content-Type
 223
 224 For example: 'text/namevalue',
 225
 226 =item args
 227
 228 CGI arguments, eitehr as a hashref or a listref.  In the latter case, ordering
 229 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 230
 231 =item content
 232
 233 Raw content (overrides args).  A simple scalar containing the raw content.
 234
 235
 236 =back
 237
 238 Returns a list consisting of the page content as a string, the HTTP
 239 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 240 key/value pairs representing the HTTP response headers.
 241
 242 =cut
 243
 244 sub https_post {
 245     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 246
 247     # accept a hashref or a list (keep it ordered).  or a scalar of content.
 248     my $post_data = '';
 249     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 250         $post_data = $opts->{'args'};
 251     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 252         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 253         $post_data = \%hash;
 254     }
 255     if ( exists $opts->{'content'} ) {
 256         $post_data = $opts->{'content'};
 257     }
 258
 259     $opts->{'port'} ||= 443;
 260     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 261
 262     ### XXX referer!!!
 263     my %headers;
 264     if ( ref( $opts->{headers} ) eq "HASH" ) {
 265         %headers = %{ $opts->{headers} };
 266     }
 267     $headers{'Host'} ||= $opts->{'host'};
 268
 269     if ( $ssl_module eq 'Net::SSLeay' ) {
 270
 271         import Net::SSLeay qw(post_https make_headers make_form);
 272         my $headers = make_headers(%headers);
 273
 274         my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 275
 276         $Net::SSLeay::trace = $opts->{'debug'} if exists $opts->{'debug'};
 277
 278         my( $res_page, $res_code, @res_headers ) =
 279           post_https( $opts->{'host'},
 280                       $opts->{'port'},
 281                       $opts->{'path'},
 282                       $headers,
 283                       $raw_data,
 284                       $opts->{"Content-Type"},
 285                     );
 286
 287         return ( $res_page, $res_code, @res_headers );
 288
 289     } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 290
 291         import HTTP::Request::Common qw(POST);
 292
 293         my $url = 'https://' . $opts->{'host'};
 294         $url .= ':' . $opts->{'port'}
 295           unless $opts->{'port'} == 443;
 296         $url .= $opts->{'path'};
 297
 298         my $ua = new LWP::UserAgent;
 299         foreach my $hdr ( keys %headers ) {
 300             $ua->default_header( $hdr => $headers{$hdr} );
 301         }
 302
 303         $ENV{HTTPS_DEBUG} = $opts->{'debug'} if exists $opts->{'debug'};
 304
 305         my $res;
 306         if ( ref($post_data) ) {
 307             $res = $ua->request( POST( $url, [%$post_data] ) );
 308         }
 309         else {
 310             my $req = new HTTP::Request( 'POST' => $url );
 311             $req->content_type( $opts->{"Content-Type"} );
 312             $req->content($post_data);
 313             $res = $ua->request($req);
 314         }
 315
 316         my @res_headers = map { $_ => $res->header($_) }
 317                               $res->header_field_names;
 318
 319         return ( $res->content, $res->code. ' '. $res->message, @res_headers );
 320
 321     } else {
 322         die "unknown SSL module $ssl_module";
 323     }
 324
 325 }
 326
 327 =head1 AUTHOR
 328
 329 Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
 330
 331 =head1 BUGS
 332
 333 Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
 334 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>.  I will be notified, and then you'll
 335 automatically be notified of progress on your bug as I make changes.
 336
 337 =head1 SUPPORT
 338
 339 You can find documentation for this module with the perldoc command.
 340
 341     perldoc Net::HTTPS::Any
 342
 343
 344 You can also look for information at:
 345
 346 =over 4
 347
 348 =item * RT: CPAN's request tracker
 349
 350 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
 351
 352 =item * AnnoCPAN: Annotated CPAN documentation
 353
 354 L<http://annocpan.org/dist/Net-HTTPS-Any>
 355
 356 =item * CPAN Ratings
 357
 358 L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
 359
 360 =item * Search CPAN
 361
 362 L<http://search.cpan.org/dist/Net-HTTPS-Any>
 363
 364 =back
 365
 366
 367 =head1 ACKNOWLEDGEMENTS
 368
 369
 370 =head1 COPYRIGHT & LICENSE
 371
 372 Copyright 2008 Freeside Internet Services, Inc. (http://freeside.biz/)
 373 All rights reserved.
 374
 375 This program is free software; you can redistribute it and/or modify it
 376 under the same terms as Perl itself.
 377
 378 =cut
 379
 380 1;