summaryrefslogtreecommitdiff
path: root/lib/Net/HTTPS/Any.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net/HTTPS/Any.pm')
-rw-r--r--lib/Net/HTTPS/Any.pm367
1 files changed, 367 insertions, 0 deletions
diff --git a/lib/Net/HTTPS/Any.pm b/lib/Net/HTTPS/Any.pm
new file mode 100644
index 0000000..c65c7d9
--- /dev/null
+++ b/lib/Net/HTTPS/Any.pm
@@ -0,0 +1,367 @@
+package Net::HTTPS::Any;
+
+use warnings;
+use strict;
+use vars qw(@EXPORT_OK $ssl_module $skip_NetSSLeay);
+use Exporter;
+use URI::Escape;
+use Tie::IxHash;
+
+@EXPORT_OK = qw( https_get https_post );
+
+BEGIN {
+
+ $ssl_module = '';
+
+ eval {
+ die if defined($skip_NetSSLeay) && $skip_NetSSLeay;
+ require Net::SSLeay;
+ Net::SSLeay->VERSION(1.30);
+
+ #import Net::SSLeay
+ # qw(get_https post_https make_form make_headers);
+ $ssl_module = 'Net::SSLeay';
+ };
+
+ if ($@) {
+ eval {
+ require LWP::UserAgent;
+ require HTTP::Request::Common;
+ require Crypt::SSLeay;
+
+ #import HTTP::Request::Common qw(GET POST);
+ $ssl_module = 'Crypt::SSLeay';
+ };
+ }
+
+ unless ($ssl_module) {
+ die "One of Net::SSLeay (v1.30 or later)"
+ . " or Crypt::SSLeay (+LWP) is required";
+ }
+
+}
+
+=head1 NAME
+
+Net::HTTPS::Any - Simple HTTPS class using whatever underlying module is available
+
+=head1 VERSION
+
+Version 0.09
+
+=cut
+
+our $VERSION = '0.09';
+
+=head1 SYNOPSIS
+
+ use Net::HTTPS::Any qw(https_get https_post);
+
+ ( $page, $response, %reply_headers )
+ = https_get(
+ { 'host' => 'secure.sisd.com',
+ 'port' => 443,
+ 'path' => '/freeside/index.html',
+ 'args' => { 'field' => 'value' },
+ #'args' => [ 'field'=>'value' ], #order preserved
+ },
+ );
+
+ ( $page, $response, %reply_headers )
+ = https_post(
+ 'host' => 'secure.sisd.com',
+ 'port' => 443,
+ 'path' => '/freeside/index.html',
+ 'args' => { 'field' => 'value' },
+ #'args' => [ 'field'=>'value' ], #order preserved
+ );
+
+ #...
+
+=head1 DESCRIPTION
+
+This is a simple wrapper around either of the two available SSL
+modules.
+
+It depends on Net::SSLeay _or_ ( Crypt::SSLeay and LWP::UserAgent ).
+
+=head1 FUNCTIONS
+
+=head2 https_get HASHREF | FIELD => VALUE, ...
+
+Accepts parameters as either a hashref or a list of fields and values.
+
+Parameters are:
+
+=over 4
+
+=item host
+
+=item port
+
+=item path
+
+=item headers (hashref)
+
+For example: { 'X-Header1' => 'value', ... }
+
+=item Content-Type
+
+For example: 'text/namevalue',
+
+=item args
+
+CGI arguments, eitehr as a hashref or a listref. In the latter case, ordering
+is preserved (see L<Tie::IxHash> to do so when passing a hashref).
+
+=back
+
+Returns a list consisting of the page content as a string, the HTTP
+response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
+key/value pairs representing the HTTP response headers.
+
+=cut
+
+sub https_get {
+ my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
+
+ # accept a hashref or a list (keep it ordered)
+ my $post_data = {};
+ if ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH' ) {
+ $post_data = shift;
+ } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
+ tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
+ $post_data = \%hash;
+ }
+
+ $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
+
+ ### XXX referer!!!
+ my %headers = ();
+ if ( ref( $opts->{headers} ) eq "HASH" ) {
+ %headers = %{ $opts->{headers} };
+ }
+ $headers{'Host'} ||= $opts->{'host'};
+
+ my $path = $opts->{'path'};
+ if ( keys %$post_data ) {
+ $path .= '?'
+ . join( ';',
+ map { uri_escape($_) . '=' . uri_escape( $post_data->{$_} ) }
+ keys %$post_data );
+ }
+
+ if ( $ssl_module eq 'Net::SSLeay' ) {
+
+ import Net::SSLeay qw(get_https make_headers);
+ my $headers = make_headers(%headers);
+
+ my( $res_page, $res_code, @res_headers ) =
+ get_https( $opts->{'host'},
+ $opts->{'port'},
+ $path,
+ $headers,
+ "",
+ $opts->{"Content-Type"},
+ );
+
+ return ( $res_page, $res_code, @res_headers );
+
+ } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
+
+ import HTTP::Request::Common qw(GET);
+
+ my $url = 'https://' . $opts->{'host'};
+ $url .= ':' . $opts->{'port'}
+ unless $opts->{'port'} == 443;
+ $url .= "/$path";
+
+ my $ua = new LWP::UserAgent;
+ foreach my $hdr ( keys %headers ) {
+ $ua->default_header( $hdr => $headers{$hdr} );
+ }
+ my $res = $ua->request( GET($url) );
+
+ my @res_headers = map { $_ => $res->header($_) }
+ $res->header_field_names;
+
+ return ( $res->content, $res->code. ' '. $res->message, @res_headers );
+
+ } else {
+ die "unknown SSL module $ssl_module";
+ }
+
+}
+
+=head2 https_post HASHREF | FIELD => VALUE, ...
+
+Accepts parameters as either a hashref or a list of fields and values.
+
+Parameters are:
+
+=over 4
+
+=item host
+
+=item port
+
+=item path
+
+=item headers (hashref)
+
+For example: { 'X-Header1' => 'value', ... }
+
+=item Content-Type
+
+For example: 'text/namevalue',
+
+=item args
+
+CGI arguments, eitehr as a hashref or a listref. In the latter case, ordering
+is preserved (see L<Tie::IxHash> to do so when passing a hashref).
+
+=item content
+
+Raw content (overrides args). A simple scalar containing the raw content.
+
+
+=back
+
+Returns a list consisting of the page content as a string, the HTTP
+response code and message (i.e. "200 OK" or "404 Not Found"), and a list of
+key/value pairs representing the HTTP response headers.
+
+=cut
+
+sub https_post {
+ my $opts = ref($_[0]) ? shift : { @_ }; #hashref or list
+
+ # accept a hashref or a list (keep it ordered). or a scalar of content.
+ my $post_data = '';
+ if ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'HASH' ) {
+ $post_data = shift;
+ } elsif ( exists($opts->{'args'}) && ref($opts->{'args'}) eq 'ARRAY' ) {
+ tie my %hash, 'Tie::IxHash', @{ $opts->{'args'} };
+ $post_data = \%hash;
+ }
+ if ( exists $opts->{'content'} ) {
+ $post_data = $opts->{'content'};
+ }
+
+ $opts->{"Content-Type"} ||= "application/x-www-form-urlencoded";
+
+ ### XXX referer!!!
+ my %headers;
+ if ( ref( $opts->{headers} ) eq "HASH" ) {
+ %headers = %{ $opts->{headers} };
+ }
+ $headers{'Host'} ||= $opts->{'host'};
+
+ if ( $ssl_module eq 'Net::SSLeay' ) {
+
+ import Net::SSLeay qw(post_https make_headers make_form);
+ my $headers = make_headers(%headers);
+
+ my $raw_data = ref($post_data) ? make_form(%$post_data) : $post_data;
+
+ my( $res_page, $res_code, @res_headers ) =
+ post_https( $opts->{'host'},
+ $opts->{'port'},
+ $opts->{'path'},
+ $headers,
+ $raw_data,
+ $opts->{"Content-Type"},
+ );
+
+ return ( $res_page, $res_code, @res_headers );
+
+ } elsif ( $ssl_module eq 'Crypt::SSLeay' ) {
+
+ import HTTP::Request::Common qw(POST);
+
+ my $url = 'https://' . $opts->{'host'};
+ $url .= ':' . $opts->{'port'}
+ unless $opts->{'port'} == 443;
+ $url .= $opts->{'path'};
+
+ my $ua = new LWP::UserAgent;
+ foreach my $hdr ( keys %headers ) {
+ $ua->default_header( $hdr => $headers{$hdr} );
+ }
+
+ my $res;
+ if ( ref($post_data) ) {
+ $res = $ua->request( POST( $url, [%$post_data] ) );
+ }
+ else {
+ my $req = new HTTP::Request( 'POST' => $url );
+ $req->content_type( $opts->{"Content-Type"} );
+ $req->content($post_data);
+ $res = $ua->request($req);
+ }
+
+ my @res_headers = map { $_ => $res->header($_) }
+ $res->header_field_names;
+
+ return ( $res->content, $res->code. ' '. $res->message, @res_headers );
+
+ } else {
+ die "unknown SSL module $ssl_module";
+ }
+
+}
+
+=head1 AUTHOR
+
+Ivan Kohler, C<< <ivan-net-https-any at freeside.biz> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-net-https-any at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-HTTPS-Any>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Net::HTTPS::Any
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Net-HTTPS-Any>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Net-HTTPS-Any>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Net-HTTPS-Any>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Freeside Internet Services, Inc. (http://freeside.biz/)
+All rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-15 05:09:56 +0000