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'}
 165           if exists $opts->{'debug'} && $opts->{'debug'};
 166
 167         my( $res_page, $res_code, @res_headers ) =
 168           get_https( $opts->{'host'},
 169                      $opts->{'port'},
 170                      $path,
 171                      $headers,
 172                      "",
 173                      $opts->{"Content-Type"},
 174                    );
 175
 176         return ( $res_page, $res_code, @res_headers );
 177
 178     } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 179
 180         import HTTP::Request::Common qw(GET);
 181
 182         my $url = 'https://' . $opts->{'host'};
 183         $url .= ':' . $opts->{'port'}
 184           unless $opts->{'port'} == 443;
 185         $url .= "/$path";
 186
 187         my $ua = new LWP::UserAgent;
 188         foreach my $hdr ( keys %headers ) {
 189             $ua->default_header( $hdr => $headers{$hdr} );
 190         }
 191         $ENV{HTTPS_DEBUG} = $opts->{'debug'} if exists $opts->{'debug'};
 192         my $res = $ua->request( GET($url) );
 193
 194         my @res_headers = map { $_ => $res->header($_) }
 195                               $res->header_field_names;
 196
 197         return ( $res->content, $res->code. ' '. $res->message, @res_headers );
 198
 199     } else {
 200         die "unknown SSL module $ssl_module";
 201     }
 202
 203 }
 204
 205 =head2 https_post HASHREF | FIELD => VALUE, ...
 206
 207 Accepts parameters as either a hashref or a list of fields and values.
 208
 209 Parameters are:
 210
 211 =over 4
 212
 213 =item host
 214
 215 =item port
 216
 217 =item path
 218
 219 =item headers (hashref)
 220
 221 For example: { 'X-Header1' => 'value', ... }
 222
 223 =item Content-Type
 224
 225 For example: 'text/namevalue',
 226
 227 =item args
 228
 229 CGI arguments, eitehr as a hashref or a listref.  In the latter case, ordering
 230 is preserved (see L<Tie::IxHash> to do so when passing a hashref).
 231
 232 =item content
 233
 234 Raw content (overrides args).  A simple scalar containing the raw content.
 235
 236
 237 =back
 238
 239 Returns a list consisting of the page content as a string, the HTTP
 240 response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
 241 key/value pairs representing the HTTP response headers.
 242
 243 =cut
 244
 245 sub https_post {
 246     my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
 247
 248     # accept a hashref or a list (keep it ordered).  or a scalar of content.
 249     my $post_data = '';
 250     if (      exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH'  ) {
 251         $post_data = $opts->{'args'};
 252     } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
 253         tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
 254         $post_data = \%hash;
 255     }
 256     if ( exists $opts->{'content'} ) {
 257         $post_data = $opts->{'content'};
 258     }
 259
 260     $opts->{'port'} ||= 443;
 261     $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
 262
 263     ### XXX referer!!!
 264     my %headers;
 265     if ( ref( $opts->{headers} ) eq "HASH" ) {
 266         %headers = %{ $opts->{headers} };
 267     }
 268     $headers{'Host'} ||= $opts->{'host'};
 269
 270     if ( $ssl_module eq 'Net::SSLeay' ) {
 271
 272         import Net::SSLeay qw(post_https make_headers make_form);
 273         my $headers = make_headers(%headers);
 274
 275         my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
 276
 277         $Net::SSLeay::trace = $opts->{'debug'}
 278           if exists $opts->{'debug'} && $opts->{'debug'};
 279
 280         my( $res_page, $res_code, @res_headers ) =
 281           post_https( $opts->{'host'},
 282                       $opts->{'port'},
 283                       $opts->{'path'},
 284                       $headers,
 285                       $raw_data,
 286                       $opts->{"Content-Type"},
 287                     );
 288
 289         return ( $res_page, $res_code, @res_headers );
 290
 291     } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
 292
 293         import HTTP::Request::Common qw(POST);
 294
 295         my $url = 'https://' . $opts->{'host'};
 296         $url .= ':' . $opts->{'port'}
 297           unless $opts->{'port'} == 443;
 298         $url .= $opts->{'path'};
 299
 300         my $ua = new LWP::UserAgent;
 301         foreach my $hdr ( keys %headers ) {
 302             $ua->default_header( $hdr => $headers{$hdr} );
 303         }
 304
 305         $ENV{HTTPS_DEBUG} = $opts->{'debug'} if exists $opts->{'debug'};
 306
 307         my $res;
 308         if ( ref($post_data) ) {
 309             $res = $ua->request( POST( $url, [%$post_data] ) );
 310         }
 311         else {
 312             my $req = new HTTP::Request( 'POST' => $url );
 313             $req->content_type( $opts->{"Content-Type"} );
 314             $req->content($post_data);
 315             $res = $ua->request($req);
 316         }
 317
 318         my @res_headers = map { $_ => $res->header($_) }
 319                               $res->header_field_names;
 320
 321         return ( $res->content, $res->code. ' '. $res->message, @res_headers );
 322
 323     } else {
 324         die "unknown SSL module $ssl_module";
 325     }
 326
 327 }
 328
 329 =head1 AUTHOR
 330
 331 Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
 332
 333 =head1 BUGS
 334
 335 Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
 336 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>.  I will be notified, and then you'll
 337 automatically be notified of progress on your bug as I make changes.
 338
 339 =head1 SUPPORT
 340
 341 You can find documentation for this module with the perldoc command.
 342
 343     perldoc Net::HTTPS::Any
 344
 345
 346 You can also look for information at:
 347
 348 =over 4
 349
 350 =item * RT: CPAN's request tracker
 351
 352 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
 353
 354 =item * AnnoCPAN: Annotated CPAN documentation
 355
 356 L<http://annocpan.org/dist/Net-HTTPS-Any>
 357
 358 =item * CPAN Ratings
 359
 360 L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
 361
 362 =item * Search CPAN
 363
 364 L<http://search.cpan.org/dist/Net-HTTPS-Any>
 365
 366 =back
 367
 368
 369 =head1 ACKNOWLEDGEMENTS
 370
 371
 372 =head1 COPYRIGHT & LICENSE
 373
 374 Copyright 2008 Freeside Internet Services, Inc. (http://freeside.biz/)
 375 All rights reserved.
 376
 377 This program is free software; you can redistribute it and/or modify it
 378 under the same terms as Perl itself.
 379
 380 =cut
 381
 382 1;