From 97e89d11919d233afc4bbe3a2c7f14a4d116584b Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 14 Jun 2008 04:14:48 +0000 Subject: [PATCH] initial import --- .cvsignore | 10 ++ Changes | 6 + MANIFEST | 12 ++ Makefile.PL | 18 +++ README | 45 +++++++ lib/Net/HTTPS/Any.pm | 367 +++++++++++++++++++++++++++++++++++++++++++++++++++ t/00-load.t | 9 ++ t/get-cryptssleay.t | 41 ++++++ t/get-netssleay.t | 36 +++++ t/pod-coverage.t | 18 +++ t/pod.t | 12 ++ t/post-cryptssleay.t | 41 ++++++ t/post-netssleay.t | 36 +++++ 13 files changed, 651 insertions(+) create mode 100644 .cvsignore create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Net/HTTPS/Any.pm create mode 100644 t/00-load.t create mode 100644 t/get-cryptssleay.t create mode 100644 t/get-netssleay.t create mode 100644 t/pod-coverage.t create mode 100644 t/pod.t create mode 100644 t/post-cryptssleay.t create mode 100644 t/post-netssleay.t diff --git a/.cvsignore b/.cvsignore new file mode 100644 index 0000000..c913efe --- /dev/null +++ b/.cvsignore @@ -0,0 +1,10 @@ +blib* +Makefile +Makefile.old +Build +_build* +pm_to_blib* +*.tar.gz +.lwpcookies +Net-HTTPS-Any-* +cover_db diff --git a/Changes b/Changes new file mode 100644 index 0000000..32caa87 --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Net-HTTPS-Any + +0.09 unrelesed + First version numbered 0.09 + (based on Business::OnlinePayment::HTTPS 0.08) + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..2fb0be3 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,12 @@ +Changes +MANIFEST +Makefile.PL +README +lib/Net/HTTPS/Any.pm +t/00-load.t +t/get-cryptssleay.t +t/get-netssleay.t +t/pod-coverage.t +t/pod.t +t/post-cryptssleay.t +t/post-netssleay.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..c6dbbc8 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Net::HTTPS::Any', + AUTHOR => 'Ivan Kohler ', + VERSION_FROM => 'lib/Net/HTTPS/Any.pm', + ABSTRACT_FROM => 'lib/Net/HTTPS/Any.pm', + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'URI::Escape' => 0, + 'Tie::IxHash' => 0, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Net-HTTPS-Any-*' }, +); diff --git a/README b/README new file mode 100644 index 0000000..8d67ccb --- /dev/null +++ b/README @@ -0,0 +1,45 @@ +Net-HTTPS-Any + +This module will make an HTTPS connection using Net::SSLeay or ( Crypt::SSLeay +and LWP), whatever is available on the current system. + +It is derived from Business::OnlinePayment::HTTPS. + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Net::HTTPS::Any + +You can also look for information at: + + RT, CPAN's request tracker + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-HTTPS-Any + + AnnoCPAN, Annotated CPAN documentation + http://annocpan.org/dist/Net-HTTPS-Any + + CPAN Ratings + http://cpanratings.perl.org/d/Net-HTTPS-Any + + Search CPAN + http://search.cpan.org/dist/Net-HTTPS-Any + + +COPYRIGHT AND LICENCE + +Copyright (C) 2008 Freeside Internet Services, Inc. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + 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 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 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<< >> + +=head1 BUGS + +Please report any bugs or feature requests to C, or through +the web interface at L. 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 + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * Search CPAN + +L + +=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; diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..b986555 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'Net::HTTPS::Any' ); +} + +diag( "Testing Net::HTTPS::Any $Net::HTTPS::Any::VERSION, Perl $], $^X" ); diff --git a/t/get-cryptssleay.t b/t/get-cryptssleay.t new file mode 100644 index 0000000..2b3babe --- /dev/null +++ b/t/get-cryptssleay.t @@ -0,0 +1,41 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More; + +BEGIN { + $Business::OnlinePayment::HTTPS::skip_NetSSLeay=1; + $Business::OnlinePayment::HTTPS::skip_NetSSLeay=1; +} + +plan( tests=>4 ); + +use_ok 'Net::HTTPS::Any'; + +#200 + +my($content, $response, %headers) = Net::HTTPS::Any::https_get( + { 'host' => 'secure.sisd.com', + 'port' => 443, + 'path' => '/freeside/index.html', + }, + 'net_https_any_test' => 1, +); + +like($response, qr/^HTTP\/[\d\.]+\s+200/i, 'Received 200 (OK) response'); + +ok( length($content), 'Received content' ); + +#404 + +my($content2, $response2, %headers2) = Net::HTTPS::Any::https_get( + { 'host' => 'secure.sisd.com', + 'port' => 443, + 'path' => '/freeside/notfound.html', + }, + 'net_https_any_test' => 1, +); + +like($response2, qr/^HTTP\/[\d\.]+\s+404/i, 'Received 404 (OK) response'); + diff --git a/t/get-netssleay.t b/t/get-netssleay.t new file mode 100644 index 0000000..9c83a0f --- /dev/null +++ b/t/get-netssleay.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More; + +plan( tests=>4 ); + +use_ok 'Net::HTTPS::Any'; + +#200 + +my($content, $response, %headers) = Net::HTTPS::Any::https_get( + { 'host' => 'secure.sisd.com', + 'port' => 443, + 'path' => '/freeside/index.html', + }, + 'net_https_any_test' => 1, +); + +like($response, qr/^HTTP\/[\d\.]+\s+200/i, 'Received 200 (OK) response'); + +ok( length($content), 'Received content' ); + +#404 + +my($content2, $response2, %headers2) = Net::HTTPS::Any::https_get( + { 'host' => 'secure.sisd.com', + 'port' => 443, + 'path' => '/freeside/notfound.html', + }, + 'net_https_any_test' => 1, +); + +like($response2, qr/^HTTP\/[\d\.]+\s+404/i, 'Received 404 (OK) response'); + diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..fc40a57 --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod::Coverage +my $min_tpc = 1.08; +eval "use Test::Pod::Coverage $min_tpc"; +plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" + if $@; + +# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, +# but older versions don't recognize some common documentation styles +my $min_pc = 0.18; +eval "use Pod::Coverage $min_pc"; +plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" + if $@; + +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..ee8b18a --- /dev/null +++ b/t/pod.t @@ -0,0 +1,12 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod +my $min_tp = 1.22; +eval "use Test::Pod $min_tp"; +plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; + +all_pod_files_ok(); diff --git a/t/post-cryptssleay.t b/t/post-cryptssleay.t new file mode 100644 index 0000000..2ddda1b --- /dev/null +++ b/t/post-cryptssleay.t @@ -0,0 +1,41 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More; + +BEGIN { + $Business::OnlinePayment::HTTPS::skip_NetSSLeay=1; + $Business::OnlinePayment::HTTPS::skip_NetSSLeay=1; +} + +plan( tests=>4 ); + +use_ok 'Net::HTTPS::Any'; + +#200 + +my($content, $response, %headers) = Net::HTTPS::Any::https_post( + { 'host' => 'secure.sisd.com', + 'port' => 443, + 'path' => '/freeside/index.html', + }, + 'net_https_any_test' => 1, +); + +like($response, qr/^HTTP\/[\d\.]+\s+200/i, 'Received 200 (OK) response'); + +ok( length($content), 'Received content' ); + +#404 + +my($content2, $response2, %headers2) = Net::HTTPS::Any::https_get( + { 'host' => 'secure.sisd.com', + 'port' => 443, + 'path' => '/freeside/notfound.html', + }, + 'net_https_any_test' => 1, +); + +like($response2, qr/^HTTP\/[\d\.]+\s+404/i, 'Received 404 (OK) response'); + diff --git a/t/post-netssleay.t b/t/post-netssleay.t new file mode 100644 index 0000000..e8cb2fd --- /dev/null +++ b/t/post-netssleay.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More; + +plan( tests=>4 ); + +use_ok 'Net::HTTPS::Any'; + +#200 + +my($content, $response, %headers) = Net::HTTPS::Any::https_post( + { 'host' => 'secure.sisd.com', + 'port' => 443, + 'path' => '/freeside/index.html', + }, + 'net_https_any_test' => 1, +); + +like($response, qr/^HTTP\/[\d\.]+\s+200/i, 'Received 200 (OK) response'); + +ok( length($content), 'Received content' ); + +#404 + +my($content2, $response2, %headers2) = Net::HTTPS::Any::https_get( + { 'host' => 'secure.sisd.com', + 'port' => 443, + 'path' => '/freeside/notfound.html', + }, + 'net_https_any_test' => 1, +); + +like($response2, qr/^HTTP\/[\d\.]+\s+404/i, 'Received 404 (OK) response'); + -- 2.11.0