Net-HTTPS-NB-0.13/0000755000175000017500000000000012156104054012014 5ustar olegolegNet-HTTPS-NB-0.13/MANIFEST0000644000175000017500000000041212156104054013142 0ustar olegolegMANIFEST lib/Net/HTTPS/NB.pm t/Net-HTTPS-NB.t Makefile.PL Changes README examples/google_multi.pl META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-HTTPS-NB-0.13/lib/0000755000175000017500000000000012156104054012562 5ustar olegolegNet-HTTPS-NB-0.13/lib/Net/0000755000175000017500000000000012156104054013310 5ustar olegolegNet-HTTPS-NB-0.13/lib/Net/HTTPS/0000755000175000017500000000000012156104054014212 5ustar olegolegNet-HTTPS-NB-0.13/lib/Net/HTTPS/NB.pm0000644000175000017500000001407212156103600015047 0ustar olegolegpackage Net::HTTPS::NB; use strict; use Net::HTTP; use IO::Socket::SSL 0.98; use Exporter; use vars qw($VERSION @ISA @EXPORT $HTTPS_ERROR); $VERSION = 0.13; =head1 NAME Net::HTTPS::NB - Non-blocking HTTPS client =head1 SYNOPSIS =over =item Example from L use Net::HTTPS::NB; use IO::Select; use strict; my $s = Net::HTTPS::NB->new(Host => "pause.perl.org") || die $@; $s->write_request(GET => "/"); my $sel = IO::Select->new($s); READ_HEADER: { die "Header timeout" unless $sel->can_read(10); my($code, $mess, %h) = $s->read_response_headers; redo READ_HEADER unless $code; } while (1) { die "Body timeout" unless $sel->can_read(10); my $buf; my $n = $s->read_entity_body($buf, 1024); last unless $n; print $buf; } =item Example of non-blocking connect use strict; use Net::HTTPS::NB; use IO::Select; my $sock = Net::HTTPS::NB->new(Host => 'encrypted.google.com', Blocking => 0); my $sele = IO::Select->new($sock); until ($sock->connected) { if ($HTTPS_ERROR == HTTPS_WANT_READ) { $sele->can_read(); } elsif($HTTPS_ERROR == HTTPS_WANT_WRITE) { $sele->can_write(); } else { die 'Unknown error: ', $HTTPS_ERROR; } } =back See `examples' subdirectory for more examples. =head1 DESCRIPTION Same interface as Net::HTTPS but it will never try multiple reads when the read_response_headers() or read_entity_body() methods are invoked. In addition allows non-blocking connect. =over =item If read_response_headers() did not see enough data to complete the headers an empty list is returned. =item If read_entity_body() did not see new entity data in its read the value -1 is returned. =back =cut # we only supports IO::Socket::SSL now # use it force $Net::HTTPS::SSL_SOCKET_CLASS = 'IO::Socket::SSL'; require Net::HTTPS; # make aliases to IO::Socket::SSL variables and constants use constant { HTTPS_WANT_READ => SSL_WANT_READ, HTTPS_WANT_WRITE => SSL_WANT_WRITE, }; *HTTPS_ERROR = \$SSL_ERROR; =head1 PACKAGE CONSTANTS Imported by default HTTPS_WANT_READ HTTPS_WANT_WRITE =head1 PACKAGE VARIABLES Imported by default $HTTPS_ERROR =cut # need export some stuff for error handling @EXPORT = qw($HTTPS_ERROR HTTPS_WANT_READ HTTPS_WANT_WRITE); @ISA = qw(Net::HTTPS Exporter); =head1 METHODS =head2 new(%cfg) Same as Net::HTTPS::new, but in addition allows `Blocking' parameter. By setting this parameter to 0 you can perform non-blocking connect. See connected() to determine when connection completed. =cut sub new { my ($class, %args) = @_; my %ssl_opts; while (my $name = each %args) { if (substr($name, 0, 4) eq 'SSL_') { $ssl_opts{$name} = delete $args{$name}; } } unless (exists $args{PeerPort}) { $args{PeerPort} = 443; } # create plain socket first my $self = Net::HTTP->new(%args) or return; # and upgrade it to SSL then $class->start_SSL($self, %ssl_opts, SSL_startHandshake => 0) or return; if (!exists($args{Blocking}) || $args{Blocking}) { # blocking connect $self->connected() or return; } # non-blocking handshake will be started after SUPER::connected return $self; } =head2 connected() Returns true value when connection completed (https handshake done). Otherwise returns false. In this case you can check $HTTPS_ERROR to determine what handshake need for, read or write. $HTTPS_ERROR could be HTTPS_WANT_READ or HTTPS_WANT_WRITE respectively. See L. =cut sub connected { my $self = shift; if (exists ${*$self}{httpsnb_connected}) { # already connected or disconnected return ${*$self}{httpsnb_connected}; } if (${*$self}{httpsnb_super_connected}) { # SUPER already connected # start/continue SSL handshaking if ( $self->connect_SSL() ) { return ${*$self}{httpsnb_connected} = 1; } return 0; } if ($self->SUPER::connected) { # SUPER just connected. Start handshaking ${*$self}{httpsnb_super_connected} = 1; return $self->connected; } # SUPER still not connected if ($! = $self->sockopt(SO_ERROR)) { # some error while connecting $HTTPS_ERROR = $!; } else { $HTTPS_ERROR = HTTPS_WANT_WRITE; } return 0; } sub close { my $self = shift; # need some cleanup ${*$self}{httpsnb_connected} = 0; return $self->SUPER::close(); } =head2 blocking($flag) As opposed to Net::HTTPS where blocking method consciously broken you can set socket blocking. For example you can return socket to blocking state after non-blocking connect. =cut sub blocking { # blocking() is breaked in Net::HTTPS # restore it here my $self = shift; $self->IO::Socket::blocking(@_); } # code below copied from Net::HTTP::NB with some modifications # Author: Gisle Aas sub sysread { my $self = shift; unless (${*$self}{'httpsnb_reading'}) { # allow reading without restrictions when called # not from our methods return $self->SUPER::sysread(@_); } if (${*$self}{'httpsnb_read_count'}++) { ${*$self}{'http_buf'} = ${*$self}{'httpsnb_save'}; die "Multi-read\n"; } my $offset = $_[2] || 0; my $n = $self->SUPER::sysread($_[0], $_[1], $offset); ${*$self}{'httpsnb_save'} .= substr($_[0], $offset); return $n; } sub read_response_headers { my $self = shift; ${*$self}{'httpsnb_reading'} = 1; ${*$self}{'httpsnb_read_count'} = 0; ${*$self}{'httpsnb_save'} = ${*$self}{'http_buf'}; my @h = eval { $self->SUPER::read_response_headers(@_) }; ${*$self}{'httpsnb_reading'} = 0; if ($@) { return if $@ eq "Multi-read\n" || $HTTPS_ERROR == HTTPS_WANT_READ; die; } return @h; } sub read_entity_body { my $self = shift; ${*$self}{'httpsnb_reading'} = 1; ${*$self}{'httpsnb_read_count'} = 0; ${*$self}{'httpsnb_save'} = ${*$self}{'http_buf'}; # XXX I'm not so sure this does the correct thing in case of # transfer-encoding tranforms my $n = eval { $self->SUPER::read_entity_body(@_) }; ${*$self}{'httpsnb_reading'} = 0; if ($@ || (!defined($n) && $HTTPS_ERROR == HTTPS_WANT_READ)) { $_[0] = ""; return -1; } return $n; } 1; =head1 SEE ALSO L, L =head1 COPYRIGHT Copyright 2011-2013 Oleg G . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-HTTPS-NB-0.13/META.yml0000644000175000017500000000114712156104054013270 0ustar olegoleg--- abstract: 'Non-blocking HTTPS client' author: - 'Oleg G ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-HTTPS-NB no_index: directory: - t - inc requires: Exporter: 0 IO::Socket::SSL: 0.98 Net::HTTP: 0 Net::HTTPS: 0 Test::More: 0.88 resources: repository: https://github.com/olegwtf/p5-Net-HTTPS-NB version: 0.13 Net-HTTPS-NB-0.13/t/0000755000175000017500000000000012156104054012257 5ustar olegolegNet-HTTPS-NB-0.13/t/Net-HTTPS-NB.t0000644000175000017500000000167411572741433014410 0ustar olegoleg#!/usr/bin/env perl use Test::More; BEGIN { use_ok('Net::HTTPS::NB'); } use strict; SKIP: { skip "I heared fork doesn't work on Windows" if $^O =~ /MSWin/i; my ($host, $port) = make_server(); my $start = time(); my $sock = Net::HTTPS::NB->new(Host => $host, PeerPort => $port); ok(time() - $start >= 3, 'Blocking connect'); ok(! defined $sock, 'HTTPS init error'); ($host, $port) = make_server(); $start = time(); $sock = Net::HTTPS::NB->new(Host => $host, PeerPort => $port, Blocking => 0); ok(time() - $start < 3, 'Non blocking connect'); is($sock->connected, 0, 'Invalid socket connection'); isa_ok($sock, 'Net::HTTPS::NB'); } done_testing(); sub make_server { my $serv = IO::Socket::INET->new(Listen => 3); my $child = fork(); die 'fork:', $! unless defined $child; if ($child == 0) { sleep 3; $serv->accept(); exit; } return ($serv->sockhost eq "0.0.0.0" ? "127.0.0.1" : $serv->sockhost, $serv->sockport); } Net-HTTPS-NB-0.13/examples/0000755000175000017500000000000012156104054013632 5ustar olegolegNet-HTTPS-NB-0.13/examples/google_multi.pl0000755000175000017500000000440112156050266016664 0ustar olegoleg#!/usr/bin/env perl use lib '../lib'; use Net::HTTPS::NB; use AnyEvent; use strict; use warnings; # Get number of the search results for each specified language in parallel via encrypted google # Make it easier with AnyEvent my $loop = AnyEvent->condvar; for my $q (qw(perl python ruby php lua)) { my $sock = Net::HTTPS::NB->new(Host => 'encrypted.google.com', Blocking => 0) or next; $loop->begin(); my $wc; $wc = AnyEvent->io( fh => $sock, poll => 'w', # first wait until non-blocking socket connection completed cb => sub { wait_connection($wc, $loop, $sock, $q) } ); } $loop->recv(); # wait until non-blocking connection completed sub wait_connection { undef $_[0]; # remove watcher completely my ($wc, $loop, $sock, $q) = @_; if ($sock->connected) { # handsheke completed print "$q: Connected\n"; $sock->write_request(GET => "/search?q=$q"); my $wh; $wh = AnyEvent->io( # now wait headers fh => $sock, poll => 'r', cb => sub { wait_headers($wh, $loop, $sock, $q) } ); } elsif($HTTPS_ERROR == HTTPS_WANT_READ) { $wc = AnyEvent->io( # handsheke need reading fh => $sock, poll => 'r', cb => sub { wait_connection($wc, $loop, $sock, $q) } ); } elsif($HTTPS_ERROR == HTTPS_WANT_WRITE) { $wc = AnyEvent->io( # handsheke need writing fh => $sock, poll => 'w', cb => sub { wait_connection($wc, $loop, $sock, $q) } ); } else { print "$q: Connection failed - $HTTPS_ERROR\n"; $loop->end(); } } # wait for full headers sub wait_headers { my (undef, $loop, $sock, $q) = @_; if (my @h = $sock->read_response_headers()) { undef $_[0]; # remove headers watcher print "$q: HTTP code - $h[0]\n"; my $body = ''; my $wb; $wb = AnyEvent->io( # now wait body fh => $sock, poll => 'r', cb => sub { wait_body($wb, $loop, $sock, $q, \$body) } ); } # else this sub will invoked again when new data will arrive } # wait for full body sub wait_body { my (undef, $loop, $sock, $q, $body) = @_; my $n = $sock->read_entity_body(my $buf, 1024); if (!$n) { # error or eof, but who cares? undef $_[0]; # remove body watcher my ($result) = $$body =~ /([\d,]+\s+results?)/; print "$q: ", $result||'unknown', "\n"; $loop->end; } elsif ($n != -1) { substr($$body, length $$body) = $buf; # append body } } Net-HTTPS-NB-0.13/Makefile.PL0000644000175000017500000000135111571470250013772 0ustar olegoleguse 5.005000; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Net::HTTPS::NB', LICENSE => 'perl', VERSION_FROM => 'lib/Net/HTTPS/NB.pm', # finds $VERSION PREREQ_PM => { Exporter => 0, IO::Socket::SSL => 0.98, Net::HTTP => 0, Net::HTTPS => 0, Test::More => 0.88 }, META_MERGE => { resources => {repository => 'https://github.com/olegwtf/p5-Net-HTTPS-NB'} }, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Net/HTTPS/NB.pm', # retrieve abstract from module AUTHOR => 'Oleg G ') : ()), ); Net-HTTPS-NB-0.13/README0000644000175000017500000000033611565643444012714 0ustar olegolegNet::HTTPS::NB - Non-blocking HTTPS client Like Net::HTTP has non-blocking Net::HTTP::NB, Net::HTTPS now has Net::HTTPS::NB This make it possible to multiplex multiple HTTPS connections using select without risk blocking. Net-HTTPS-NB-0.13/Changes0000644000175000017500000000073512156103362013315 0ustar olegolegRevision history for Perl extension Net::HTTPS::NB. 0.13 Wed Jun 12 21:31:43 2013 - Fix for rt #85931: ability to specify SSL_* options 0.12 Tue Jun 7 18:49:45 2011 - Test::More dependency added - tests fixes: OpenBSD doesn't know how to connect to 0.0.0.0 0.11 Mon May 23 13:54:47 2011 - Assign properly value to $HTTP_ERROR when socket connection fails - Fixed typo in the test 0.10 Sat May 21 12:02:35 2011 - original version Net-HTTPS-NB-0.13/META.json0000644000175000017500000000213512156104054013436 0ustar olegoleg{ "abstract" : "Non-blocking HTTPS client", "author" : [ "Oleg G " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-HTTPS-NB", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Exporter" : "0", "IO::Socket::SSL" : "0.98", "Net::HTTP" : "0", "Net::HTTPS" : "0", "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/olegwtf/p5-Net-HTTPS-NB" } }, "version" : "0.13" }