Solution
As reported by #limulus in the answer I accepted, this was a bug in Net::HTTPS version 6.00. Always be wary of fresh .0 releases. Here's the relevant diff between the buggy and fixed version of that module:
D:\Opt\Perl512.32 :: diff lib\Net\HTTPS.pm site\lib\Net\HTTPS.pm
6c6
< $VERSION = "6.00";
---
> $VERSION = "6.02";
75,78c75,80
< # The underlying SSLeay classes fails to work if the socket is
< # placed in non-blocking mode. This override of the blocking
< # method makes sure it stays the way it was created.
< sub blocking { } # noop
---
> if ($SSL_SOCKET_CLASS eq "Net::SSL") {
> # The underlying SSLeay classes fails to work if the socket is
> # placed in non-blocking mode. This override of the blocking
> # method makes sure it stays the way it was created.
> *blocking = sub { };
> }
Original question
Relevance: It is annoying to see your HTTPS client block indefinitely because the connection endpoint is unreliable.
This experiment is easy to set up and replay at home. You just need two things, a tarpit to trap an incoming client, and a Perl script. The tarpit can be set up using netcat:
nc -k -l localhost 9999 # on Linux, for multiple requests
nc -l -p 9999 localhost # on Cygwin, for one request only
Then, point the script to this tarpit:
use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
print 'LWP::UserAgent::VERSION ', $LWP::UserAgent::VERSION, "\n";
print 'IO::Socket::SSL::VERSION ', $IO::Socket::SSL::VERSION, "\n";
my $ua = LWP::UserAgent->new( timeout => 5, keep_alive => 1 );
$ua->ssl_opts( timeout => 5, Timeout => 5 ); # Yes - see note below!
my $rsp = $ua->request( GET 'https://localhost:9999' );
if ( $rsp->is_success ) {
print $rsp->as_string;
} else {
die $rsp->status_line;
}
What is this going to do? Well, connect to the port opened by NetCat, and then ... hang. Indefinitely. At least in terms of developer time. I mean it might time out after ten minutes or two hours, but I haven't checked; the specified timeout doesn't take effect, not on Linux, and not on Windows (Win32, haven't checked Cygwin).
Versions used:
LWP::UserAgent::VERSION 6.02
IO::Socket::SSL::VERSION 1.44
# on Linux
LWP::UserAgent::VERSION 6.02
IO::Socket::SSL::VERSION 1.44
# on Win32
Now for the timeout and Timeout parameters. The former is the name of the parameter for LWP::UA, the latter is the name for IO::Socket::SSL, used via LWP::Protocol::https. (Incidentally, why is metacpan HTTPS? Well, at least it's not a tarpit.) I am somehow hoping to have these parameters passed along :)
Just so you know, keep_alive doesn't have anything to do with the timeout not working, I verified that empirically. :)
Anyway, before digging deeper, does anyone know what's going on here and how to make the timeout work with HTTPS? Hard to believe I'm the first person running into this.
This is a result of the Net::HTTPS module overriding the blocking method of IO::Socket with a noop. Upgrading to the latest Net::HTTP package should fix this.
The timeout (and Timeout) options apply only to the connection -- how many seconds will LWP::UserAgent wait while connecting -- they are not for setting a timeout on the whole transaction.
You'll want to use Perl's alarm with a $SIG{ALRM} handler to timeout the whole transaction. See perldoc -f alarm or perlipc.
local $SIG{ALRM} = sub { die "SSL timeout\n" };
my $ua = LWP::UserAgent->new( timeout => 5, keep_alive => 1 );
$ua->ssl_opts( timeout => 5, Timeout => 5 );
eval {
alarm(10);
my $rsp = $ua->request( GET 'https://localhost:9999' );
if ( $rsp->is_success ) {
print $rsp->as_string;
} else {
die $rsp->status_line;
}
};
alarm(0);
if ($#) {
if ($# =~ /SSL timeout/) {
warn "request timed out";
} else {
die "error in request: $#";
}
}
(tested on Linux. Alarms can be a bit more cantankerous in Windows/Cygwin)
I asked this question on PerlMonks, and received an answer to the effect that:
The underlying IO::Socket::INET does not support non-blocking sockets
on Win32, thus non-blocking IO::Socket::SSL is not supported on Win32,
which means also, that timeouts don't work (because they are based on
non-blocking). See also http://www.perlmonks.org/?node_id=378675
http://cpansearch.perl.org/src/SULLR/IO-Socket-SSL-1.60/README.Win32
The PerlMonks post pointed to is from 2004. Not sure the information still applies; after all, I've seen the timeout does work on Windows, just not via SSL.
Related
I'm using the following code, with the following snippet:
my $mech = WWW::Mechanize->new( 'ssl_opts' => { 'verify_hostname' => 0 } );
the following error is still being thrown:
Error GETing https://www.1031exchangeinc.com/: Can't connect to www.1031exchangeinc.com:443 (SSL connect attempt failed error:14077410:SSL routines:SSL23_GET_SERVER_HELLO:sslv3 alert handshake failure) at crawl.pl line 29.
I want to ignore the SSL handshake.
#!/usr/bin/perl
use Modern::Perl;
use WWW::Mechanize;
use IO::Socket::SSL;
my $root = 'https://www.1031exchangeinc.com/';
my $domain = 'https://www.1031exchangeinc.com';
#my $mech = WWW::Mechanize->new;
my $mech = WWW::Mechanize->new( 'ssl_opts' => { 'verify_hostname' => 0 } );
sub visit {
my $url = shift;
my $indent = shift || 0;
my $visited = shift || {};
my $tab = ' ' x $indent;
# Already seen that.
return if $visited->{$url}++;
# Leaves domain.
if ($url !~ /^$domain/) {
say $tab, "-> $url";
return;
}
# Not seen yet.
say $tab, "- $url ";
$mech->get($url);
visit($_, $indent+2, $visited) for
map {$_->url_abs} $mech->links;
}
visit($root);
I want to ignore the SSL handshake.
The SSL handshake can not be ignored with https since it is an integral part of a TLS connection (and thus https). At most you could try to skip validation of the certificate (bad idea) which is what you are trying. But, this does not make handshake failures vanish.
Such handshake errors are instead caused for example by non overlapping cipher suites between client and server, unsupported protocol versions or missing but required TLS extensions.
It is unclear what exactly is the problem in your case. But given that the server requires SNI according to the SSLLabs report and that it requires modern ciphers (ECDHE and/or GCM or ChaCha20) my guess is that you are using a too old version of OpenSSL. This is typically the case on MacOS X which ships with a very old version of OpenSSL, i.e. version 0.9.8.
You can check the version you use with
perl -MNet::SSLeay -e 'warn Net::SSLeay::SSLeay_version(0)'
If this reports anything like 0.9.8 then you've found the reason on why it is failing and you need to upgrade to a newer version of OpenSSL and recompile Net::SSLeay against this.
If you instead have at least OpenSSL 1.0.1 then it is a different problem and you should add the versions of Net::SSLeay and IO::Socket::SSL to your question and also the output when running with perl -MIO::Socket::SSL=debug4 your-program.pl.
I am trying to connect via HTTPS to a site using LWP::Simple. I have set the environment variables both inside of the script and in the shell. I continue to get a 500 Connection Timed Out. I can connect to a HTTP site just fine.
The proxy is letting communication through. I can connect to the HTTPS site through the proxy using curl without a problem.
Any suggestions?
#!/usr/bin/perl
use warnings;
use Net::SSL;
use LWP::UserAgent;
use LWP::Debug qw(+);
use Data::Dumper;
$ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = "Net::SSL";
$ENV{HTTPS_DEBUG} = 1;
$ENV{HTTPS_VERSION} = 2;
my $ua = LWP::UserAgent->new (verify_hostname => 0);
$ua->ssl_opts(verify_hostname => 0,
SSL_verify_mode => 0x00);
$ua->proxy('https' => 'http://x.x.x.x:3128');
print $ua->proxy('https');
print Dumper($ua);
my $response = $ua->get('https://qualys.com/');
print Dumper ($response);
if ($response->is_success) {
print $response->decoded_content; # or whatever
exit(0);
}
else {
print "\nFail:\n";
print $response->status_line ."\n";
exit(1);
}
HTTPS proxy support for LWP is (or at least was until some days ago) broken, at least if you use IO::Socket::SSL, which is the default for LWP versions >=6.0 because it provides better security. It should be much better now with LWP 6.0.6 and LWP::Protocol::https 6.0.6 which were released few days ago. If you cannot upgrade you might try using Net::SSLGlue::LWP which patches LWP for better https proxy support.
Is there a way to discover on what server app.psgi is running?
For example, I am looking for some idea for how to solve the next code fragment from app.psgi:
#app.psgi
use Modern::Perl;
use Plack::Builder;
my $app = sub { ... };
my $server = MyApp::GetServerType(); # <--- I need some idea for how to write this...
given($server) {
when (/plackup/) { ... do something ... };
when (/Starman/) { ... do something other ... };
default { die "Unknown" };
}
$app;
Checking the PLACK_ENV environment variable is not a solution...
Short answer, inspect the caller:
#app.psgi
# use Modern::Perl;
use feature qw(switch say);
use Carp qw(longmess);
use Plack::Builder;
my $app = sub {
return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello World' ] ];
};
# This hack gets what we need out of the call stack
my $stack = longmess("Stack:");
# say STDERR $stack;
given($stack) {
when (/plackup/) { say STDERR "Server: plackup" };
when (/Starman/) { say STDERR "Server: starman" };
default { die "Server: Unknown" };
}
return $app;
However, doing this in the app.psgi will make your code less portable. If you die on an unknown server people won't be able to run your code in an unknown location.
Also, be aware that this code may be run multiple times depending on how the server is implemented so any side effects may occur multiple times.
For example, here is the output for plackup:
plackup --app /usr/lusers/bburnett/dev/trunk/getserver.psgi
Server: plackup
HTTP::Server::PSGI: Accepting connections at http://0:5000/
So far so good. But here is the output for starman:
starman --app /usr/lusers/bburnett/dev/trunk/getserver.psgi
2014/02/21-16:09:46 Starman::Server (type Net::Server::PreFork) starting! pid(27365)
Resolved [*]:5000 to [0.0.0.0]:5000, IPv4
Binding to TCP port 5000 on host 0.0.0.0 with IPv4
Setting gid to "15 15 0 0 15 20920 20921 20927"
Server: starman
Server: starman
Server: starman
Server: starman
Server: starman
Here it gets run once for the master and once per child (defaults to four children).
If you really want something different to happen for these different servers a more robust way may be to subclass them yourself and put the code into each subclass passing -s My::Starman::Wrapper to plackup and starman as needed.
If you really want a switch statement and to put the code in one place, you could look into writing some code that calls Plack::Loader or Plack::Runner. Take a look at the source for plackup, and you'll see how it wraps Plack::Runner. Take a look at the source for Plack::Loader, and you'll see how it gets the backend to run and then loads the appropriate server class.
I'm writing a small script to monitor if certain ports are attempted to be accessed on my Linux box (Centos 6) using Perl 5.10.1. I'm getting back blank entries for my peerhost request. I'm not sure why. It sounds like it may be a failure in the IO socket module (http://snowhare.com/utilities/perldoc2tree/example/IO/Socket.html) but I'm not really sure. Any insight would be much appreciated.
EDIT:
Since I enabled the strict and warnings I'm getting an 'uninitialized value $display' in the cases where I thought it was blank.
#! /usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Sys::Syslog qw( :DEFAULT setlogsock);
use threads;
my #threads=();
my #ports=(88,110,389);
main(\#ports);
sub main
{
my $ports=shift;
setlogsock('unix');
openlog($0,'','user');
for my $port (#{$ports} ) {
push #threads, threads->create(\&create_monitor, $port );
}
$_->join foreach #threads;
closelog;
# wait for all threads to finish
}
sub create_monitor{
my $LocalPort=shift;
my $sock = new IO::Socket::INET (
LocalPort => $LocalPort,
Proto => 'tcp',
Listen => 1,
Reuse => 1,
) or die "Could not create socket: $!\n";
while(1)
{
my $peer_connection= $sock->accept;
my $display = $peer_connection->peerhost();
my $message="Connection attempt on port $LocalPort from $display";
#syslog('info', $message);
print $message."\n";
}
}
NOTE - it is intentional that this script never finish. I'll eventually wrap this with an init script and have it run as a service.
Perl accept() has an error code like most other functions. For accept() it is a false return, see also here.
So when you get undefined as result there is an error in accept() call. The error of accept is saved in the errno variable ($!).
Same is true for peerhost() (see here). It also can fail and return an error code.
If you only use the above code without anything else, then probably you reach connection limit of your system (you should close the connections) when accept() fails. See rlimit() to find out how that number can be increased.
One case where peerhost() fails may be that remote connection was closed already.
I have the following code on Windows XP and ActiveState ActivePerl 5.8.
What could be the problem with it? Why does it not work?
I tried to set it as a proxy to my IE but when I connect to some URLs from my IE nothing happens. The code enters the thread function and nothing happens.
use HTTP::Daemon;
use threads;
use HTTP::Status;
use LWP::UserAgent;
my $webServer;
my $d = HTTP::Daemon->new(
LocalAddr => '127.0.0.1',
LocalPort => 80,
Listen => 20
) || die;
print "Web Server started!\n";
print "Server Address: ", $d->sockhost(), "\n";
print "Server Port: ", $d->sockport(), "\n";
while (my $c = $d->accept) {
threads->create(\&process_one_req, $c)->detach();
}
sub process_one_req {
STDOUT->autoflush(1);
my $c = shift;
while (my $r = $c->get_request) {
if ($r->method eq "GET") {
print "Session info\n", $r->header('Host');
my $ua = LWP::UserAgent->new;
my $response = $ua->request($r);
$c->send_response($response);
} else {
$c->send_error(RC_FORBIDDEN);
}
}
$c->close;
undef($c);
}
I added the following line to the code before LWP::UserAgent->new and it seems to be working for me (in linux).
$r->uri("http://" . $r->header('Host') . "/" . $r->uri());
The uri that you got from the HTTP::Request object from the original request does not have the hostname. So added it to make it a absolute uri. Tested as follows:
$ curl -D - -o /dev/null -s -H 'Host: www.yahoo.com' http://localhost:8080/
HTTP/1.1 200 OK
Date: Thu, 27 Jan 2011 12:59:56 GMT
Server: libwww-perl-daemon/5.827
Cache-Control: private
Connection: close
Date: Thu, 27 Jan 2011 12:57:15 GMT
Age: 0
---snip--
UPDATE: Looks like I was completely wrong. I didnt need to make the change to URI object. Your original code worked for me as it is in Linux
If I recall correctly, this is because of the threading model in Windows where file handles are not passed between processes unless specifically asked for. This PerlMonks post seems to shed some light on the underlying problem, and may lead to an approach that works for you (I imagine you may be able to call the windows API on the file descriptor of of the client connection to allow access to it within the spawned thread).
Perl threads on Windows generally make my head hurt, while on UNIX-list systems I find them very easy to deal with. Then again, I imagine figuring out how to correctly use forked processes to emulate threads on a system that ONLY supports threads and not forking would make most people's head hurt.