How can I share OpenSSL sessions between Perl processes? - perl

I'm using Perl to connect to some (very) low-powered hardware devices with TLS. The first handshake can take around 10-15 seconds to complete! Reusing the session (from the same Perl process) is much faster but when the next job comes around to connect to the same device the new process has to establish a new session with the same delay. I'd like to share a session cache between my processes but I'm running into problems (and segfaults!).
I have a test script (connecting to openssl s_server -www) with a IO::Socket::SSL::Session_Cache wrapper that uses Sereal to write the cache object out to disk. Despite finding the existing sessions in the cache, it does not reuse them and sometimes segfaults when trying to add additional entries to the cache.
use 5.20.1; use warnings;
use LWP::UserAgent;
use IO::Socket::SSL;
# $IO::Socket::SSL::DEBUG = 2;
request_with_new_ua();
request_with_new_ua();
request_with_new_ua();
sub request_with_new_ua {
say "make request";
my $ua = LWP::UserAgent->new;
$ua->ssl_opts(
verify_hostname => 0,
SSL_session_cache => Inline::SessionStore->new,
);
process_response($ua->get('https://localhost:4433'));
}
sub process_response {
my $res = shift;
say "> $_" for grep /Session|Master/, split /\n/, $res->as_string;
}
BEGIN {
package Inline::SessionStore;
use 5.20.1; use warnings;
use Moo;
use experimental qw(signatures);
use Sereal::Encoder;
use Sereal::Decoder;
use Try::Tiny;
use Path::Tiny;
has session_cache => ( is => 'rw' );
my $encoder = Sereal::Encoder->new;
my $decoder = Sereal::Decoder->new;
my $file = path('/tmp/ssl-session-cache');
sub get_session ($self, $key) {
say "get session $key";
my $cache;
try {
$cache = $decoder->decode($file->slurp_raw);
say "got cache from file, ".ref $cache;
} catch {
say $_ unless /No such file/;
$cache = IO::Socket::SSL::Session_Cache->new(128);
say "made new cache";
};
$self->session_cache($cache);
my $ret = $cache->get_session($key);
say "found session $ret" if $ret;
return $ret;
}
sub add_session {
my $self = shift;
say"add session " . join ' - ', #_;
my $session = $self->session_cache->add_session(#_);
$file->spew_raw($encoder->encode($self->session_cache));
return $session;
}
sub del_session {
my $self = shift;
say "del session " . join ' - ', #_;
$self->session_cache->del_session(#_);
$file->spew_raw($encoder->encode($self->session_cache));
}
1;
}
And output:
rm -f /tmp/ssl-session-cache && perl wes.swp/workbench.pl
make request
get session localhost:4433
made new cache
add session localhost:4433 - 23864624
> SSL-Session:
> Session-ID:
> Session-ID-ctx: 01000000
> Master-Key: DDF335492BFE2A7BA7674A656E72005865859D89249D597302F338D01C5776E2C94B61E6BCBED6114DFDA5AAEECD22EA
make request
get session localhost:4433
got cache from file, IO::Socket::SSL::Session_Cache
found session 23864624
add session localhost:4433 - 23864624 # trying to re-add the session??
> SSL-Session:
> Session-ID:
> Session-ID-ctx: 01000000
> Master-Key: 4FE17B7FE9B4DE0A711C659FC333F686AD41840740B9D10E67A972D5A27D1720F0470329DA63DE65C1B023A1E2F0CC89
make request
get session localhost:4433
got cache from file, IO::Socket::SSL::Session_Cache
found session 23864624
add session localhost:4433 - 23864624
> SSL-Session:
> Session-ID:
> Session-ID-ctx: 01000000
> Master-Key: C76C52E5ECC13B0BB4FA887B381779B6F686A73DDFBEA06B33336537EC6AE39290370C07505BCD8B552CA874CD6E4089
I feel like I'm close to getting this to work but I'm missing something.

I don't think there is a way to use IO::Socket::SSL/Net::SSLeay or Crypt::SSLeay (which are the newer and older SSL backend for LWP) between processes.
The session cache you are trying to use in your code references SESSION objects which are internal to the OpenSSL library. Serializing the cache at the Perl level will not serialize the parts from inside the OpenSSL library but will just include the pointers to the internal structures. Since these pointers are only valid for the current state of the process, deserializing this again inside a different process or process state will thus result in dangling pointers pointing into nowhere in the best case or to some other data in the worst case and will thus result in segmentation faults or corruption of internal data.
In Net::SSLeay there are i2d_SSL_SESSION and d2i_SSL_SESSION functions which could in theory be used to properly serialize a SESSION object. But I doubt that there are usable in the current implementation.

Related

Perl LWP - need get timings: DNS resolving time, ssl connect, etc

I am using LWP to check website accessibility for HTTPS.
But, sometimes there are delays of 3000 ms
sub get_url{
my $url = shift;
my $browser = LWP::UserAgent->new;
$browser->timeout($alltimeout);
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $alltimeout;
$response = $browser->get($url,
'User-Agent' => 'CHECKER (Win98; U)',
'Accept-Charset' => 'utf-8',
);
alarm 0;
};
if ($#) {print "$#"; return "Timeout $alltimeout - error!"}
if ($response->is_success){$resp[0]=200; return $response->content;}
else {return "ERROR".$response->status_line}
}
i want to check separately: DNS resolving time, ssl connect time, etc for HTTPS.
LWP, and many other modules you'll use, aren't instrumented to produce this sort of tracing, and certainly not in any coherent or consistent fashion. You'd have to delve into the individual modules to provide your own hooks for this.
Do you see the same delays with other browsers, such as curl or wget?

Perl WebService increase max connections using HTTP::Server::Simple::CGI

I'm running a little Perl Webservice, based on the example i found on this page : https://www.perlmonks.org/?node_id=1078567 (first example)
However, when a lot of clients are calling it at once, it looks like the requests are suddenly crashing, and there's a lot of TIME_WAIT tcp connections left on the server running the webservice, as if the webservice was not able to handle that many connections at once.
is there a parameter in that module or other that i could use to extend this ?
or a way to put some kind of queue for the incoming requests ?
some parts of my code, to help :
{
package TACWebService;
use HTTP::Server::Simple::CGI;
use base qw(HTTP::Server::Simple::CGI);
use Cwd 'abs_path';
use POSIX;
use DBI;
use warnings;
.........
my %dispatch = (
'/insertunix' => \&resp_insertunix,
'/insertwin' => \&resp_insertwin,
'/getpwdate' => \&resp_getpwdate,
);
# ---------------------------------------------------------------------
# Requests Handling
# ---------------------------------------------------------------------
sub handle_request {
my $self = shift;
my $cgi = shift;
my $path = $cgi->path_info();
my $handler = $dispatch{$path};
if (ref($handler) eq "CODE") {
print "HTTP/1.0 200 OK\r\n";
$handler->($cgi);
} else {
print "HTTP/1.0 404 Not found\r\n";
print $cgi->header,
$cgi->start_html('Not found'),
$cgi->h1('Not found'),
$cgi->end_html;
}
}
sub resp_insertwin {
my $cgi = shift; # CGI.pm object
return if !ref $cgi;
....
} else {
print $cgi->header("text/plain"), "INSERT";
}
.....
# ---------------------------------------------------------------------
# WebService Start in background
# ---------------------------------------------------------------------
my $pid = TACWebService->new($TACWebService::conf{tac_ws_port})->background();
print "Use 'kill $pid' to stop TAC WebService.\n";
the clients themselves are using use LWP::UserAgent like this :
my $ua = LWP::UserAgent->new();
$ua->timeout($timeout);
my $response = $ua->post($TAC_Url,
[
'args' => $here,
]
if (!$response->is_success) {
print "Timeout while connecting to $TAC_Url\n";
} else {
my $content = $response->as_string();
print $content if (grep(/INSERT_/,$content));
}
to describe the exact issue would be complicated. In short : the clients are Unix servers sending their user database (user accounts). and when lots of clients are sending this user db at once, i can see the webservice receiving half of the data, and answering "timeout" after a couple of accounts (probably because it's overloaded in some way)
thanks again
The problem is, that the client waits to long for the server to respond. To solve this you have to start the server multiple times. The easiest Solution to this is to add
sub net_server { 'Net::Server::PreFork' }
to your package TACWebService and the HTTP::Server::Simple::CGI will do the rest of the magick.
Or you can use HTTP::Server::Simple::CGI::PreFork instead. See https://metacpan.org/pod/HTTP::Server::Simple::CGI::PreFork

Mojolicious re-using a previously established connection

I'm trying to reuse a previously established websocket connection to avoid the websocket handshake. I found that a custom websocket transaction can be built using build_websocket_tx (more details here), and there's a connection identifier for every websocket connection which can be retrieved using connection subroutine defined in Mojo::Transaction (more details here). Can I somehow combine both of these to re use the connection? Is there another way to do so?
PS: Websocket connections are supposed to be consistent and reusable. But Mojolicoious doesn't provide any such options for websocket connections.
EDIT
Example code without connection re-use.
#!/usr/bin/perl
use strict;
use warnings;
use Mojo::UserAgent;
use JSON qw |encode_json|;
my $ua = Mojo::UserAgent->new;
my $url = "wss://trello.com/1/Session/socket";
$| = 1;
sub _connect {
my $req = {
type => "ping",
reqid=> 0
};
$ua->websocket(
$url => sub {
my ($ua, $tx) = #_;
die "error: ", $tx->res->error->{message}, "\n" if $tx->res->error;
die 'Not a websocket connection' unless $tx->is_websocket;
# Connection established.
$tx->on(
message => sub {
my ($tx, $msg) = #_;
print "$msg\n";
$tx->closed; #Close connection
});
$tx->send(encode_json($req));
});
}
sub reuse_conn {
# Re use connection
}
_connect();
Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
Preliminaries: to run a Mojolicious client script with debugging information:
MOJO_EVENTEMITTER_DEBUG=1 MOJO_USERAGENT_DEBUG=1 perl mua.pl
As at version 7.43, Mojo::UserAgent has built-in connection pooling but specifically refuses to use it for WebSockets. This may well be because as you said, WebSockets is stateful, and if the UserAgent blindly reused connections, that could cause chaos. However, if your application knows how to safely reuse them, that is a different matter.
This question came up recently in the IRC channel for Mojolicious, and sri, the author, said:
16:28 sri mohawk: some frameworks like phoenix have their own higher level protocol on top of websockets to multiplex multiple channels https://hexdocs.pm/phoenix/channels.html
16:28 sounds like that's what you want
16:28 mojolicious should have something like that, but doesn't yet
[...]
16:42 sri it's not hard to build on top of mojolicious, but for now you have to do that yourself
16:42 ultimately i'd hope for us to have it in core, without the message bus part
16:43 but channel management and routing
[...]
16:50 jberger mohawk I did write Mojolicious::Plugin::Multiplex which might help
16:51 For an example of a higher level tool
I acknowledge OP said:
The only way I was able to reuse connection was by storing the transaction object and use it in subsequent calls.
However, as the code currently is, it appears this is the only way. This code demonstrates how to make, maintain, and use your own connection pool:
#!/usr/bin/perl
use strict;
use warnings;
use Mojo::UserAgent;
use Time::HiRes qw(time);
$| = 1;
my $REQ = {
type => "ping",
reqid => 0,
};
my $URL = "wss://trello.com/1/Session/socket";
my $SECONDS = 2;
my $POOL_SIZE = 5;
my $ua = Mojo::UserAgent->new;
my #pool;
sub make_conn {
my ($ua, $url, $pool) = #_;
$ua->websocket($URL => sub {
my (undef, $tx) = #_;
die "error: ", $tx->res->error->{message}, "\n" if $tx->res->error;
die 'Not a websocket connection' unless $tx->is_websocket;
push #$pool, $tx;
});
}
# pool gets pushed onto, shifted off, so using recently-used connection
sub send_message {
my ($pool, $request, $start) = #_;
my $tx = shift #$pool;
die "got bad connection" unless $tx; # error checking needs improving
$tx->once(message => sub {
my (undef, $msg) = #_;
print "got back: $msg\n";
print "took: ", time - $start, "\n";
push #$pool, $tx;
});
$tx->send({json => $request});
}
make_conn($ua, $URL, \#pool) for (1..5); # establish pool
# every 2 secs, send a message
my $timer_cb;
$timer_cb = sub {
my $loop = shift;
print "every $SECONDS\n";
send_message(\#pool, $REQ, time);
$loop->timer($SECONDS => $timer_cb);
};
Mojo::IOLoop->timer($SECONDS => $timer_cb);
Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
At a high level, it works like this:
make 5 connections in the pool
send_message uses the least-recently-used connection in that pool
send a message every two seconds, registering a one-time "on message" callback to deal with the response
For the sake of simplicity, it does not check connections are still working when it gets them from the pool, and relies on the first two-second delay to initialise all 5 connections.
The use of time calls demonstrates the speed gain from using this pool. Your provided code takes (on my system) around 300ms to start up the connection, then send and receive. Using the pool, it is taking around 120ms.

Running AnyEvent under Dancer application

I would like to do some non-blocking SSH to a couple of thousand machines that i'm tracking (my own machines), I have a Dancer application up and running, and I'm willing to use AnyEvent::timer to execute SSH commands asynchronously (each machine has its own polling interval, and I don't want one machine to wait for another to complete with its SSH work).
I'm wondering, what is the best way to act asynchronously in a synchronous environment?
It is not very good idea to run any external commands from within your web scripts.
For one, should your external call block or crash for any reason, it will create bad experience for the user (even it that user is just you).
Then, running external commands as web user may have a lot of security implications - I would think your web user most likely has passwordless ssh set up, doesn't it? What if someone figures out some security hole in your script and manages to use it to ssh into your servers?
Instead, you should create separate service or process which will regularly poll your servers status using ssh (or what else) and save results of that scan into database - Postgres or MySQL.
Then, change your Dancer app to display collected results from database, rather than doing live ssh request. This way it will be very fast and secure.
I could not be a good idea but it is possible. I have a big Dancer application to execute scripts remotely and I'm doing it with fork and Net::SSH2. I tried with thread but there are some modules that are not thread-safe so I recommend to use fork.
I have some comments in my blog http://perlondancer.blogspot.mx/2014/04/executing-remote-commands-from-dancer.html and in this gist is the code example below: https://gist.github.com/johandry/11197516
#!/usr/bin/env perl
use strict;
use warnings;
use Dancer;
use Net::SSH2;
sub execCommand ($$) {
my ( $ssh2, $cmd ) = #_;
my %args=(
timeout => 1_000, # polling timeout
bufsize => 10_240, # read buffer size when polling
);
$ssh2->blocking(1); #needed for ssh->channel
my $chan=$ssh2->channel(); # create SSH2 channel
if ($ssh2->error()) {
return (undef, undef, 100);
}
# exec $cmd (caveat: only one command line can be executed over this channel. No "ls -l;whoami" combo. Use ssh->shell instead.
unless ($chan->exec($cmd)) {
return (undef, undef, 500);
}
# defin polling context: will poll stdout (in) and stderr (ext)
my #poll = ( { handle => $chan, events => ['in','ext'] } );
my %std=(); # hash of strings. store stdout/stderr results
$ssh2->blocking( 0 ); # needed for channel->poll
while(!$chan->eof) { # there still something to read from channel
$ssh2->poll( $args{'timeout'}, [ #poll ] ); # if any event, it will be store into $poll;
my( $n, $buf ); # number of bytes read (n) into buffer (buf)
foreach my $poll ( #poll ) { # for each event
foreach my $ev ( qw( in ext ) ) { #for each stdout/stderr
next unless $poll->{revents}{$ev};
#there are something to read here, into $std{$ev} hash
if( $n = $chan->read( $buf, $args{'bufsize'}, $ev eq 'ext' ) ) { #got n byte into buf for stdout ($ev='in') or stderr ($ev='ext')
$std{$ev}.=$buf;
}
} #done foreach
}
}
$chan->wait_closed(); #not really needed but cleaner
my $exit_code=$chan->exit_status();
$chan->close(); #not really needed but cleaner
$ssh2->blocking(1); # set it back for sanity (future calls)
return ($std{'in'},$std{'ext'},$exit_code);
}
sub execute ($$$$) {
my ($ip, $username, $password, $cmd) = #_;
my $pid = fork();
if ($pid) {
# This is the parent (DANCER)
debug "Process started with PID $pid\n";
} elsif ( $pid == 0 ) {
# This is the child
my $ssh2 = Net::SSH2->new();
$ssh2->connect( $ip ) or debug("Cannot connect to $ip");
my $publicKeyFile = './id_rsa.pub'; # path(setting('appdir'), 'db', 'id_rsa.pub'); # I prefer to copy the public key in your app dir due to permissions issues
my $privateKeyFile = './id_rsa'; # path(setting('appdir'), 'db', 'id_rsa'); # I prefer to copy the private key in your app dir due to permissions issues
if ( $ssh2->auth_publickey( $username, $publicKeyFile, $privateKeyFile, $password ) ) {
my ($stdout, $stderr, $exitcode) = execCommand($ssh2, $cmd);
} else {
debug "Could not authenticate to $ip with $username";
}
$ssh2->disconnect();
} else {
debug "Could not fork: $!\n";
}
}
set logger => "console";
set log => "core";
set show_errors => 1;
get '/uptime/:ip' => sub {
my $username = "the username";
my $password = "the password";
execute(param('ip'), $username, $password, "uptime > /tmp/dancer_example.txt");
return 'uptime is running';
};
dance;
true;
Net::SSH2 can be used asynchronously, but it is quite buggy and crashes often. Forget about using it for running thousands (or just hundreds) of connections in parallel on the same process. It may be ok if you use it wrapped in new processes as recomended by #Johandry, but then you can just run the ssh command using AnyEvent::Util::run_cmd.
Net::OpenSSH is another Perl module that can be used asynchronously. It shouldn't be too difficult to integrate it inside AnyEvent.

What is the easiest way in pure Perl to stream from another HTTP resource?

What is the easiest way (without opening a shell to curl and reading from stdin) in Perl to stream from another HTTP resource? I'm assuming here that the HTTP resource I'm reading from is a potentially infinite stream (or just really, really long)
Good old LWP allows you to process the result as a stream.
E.g., here's a callback to yourFunc, reading/passing byte_count bytes to each call to yourFunc (you can drop that param if you don't care how large the data is to each call, and just want to process the stream as fast as possible):
use LWP;
...
$browser = LWP::UserAgent->new();
$response = $browser->get($url,
':content_cb' => \&yourFunc,
':read_size_hint' => byte_count,);
...
sub yourFunc {
my($data, $response) = #_;
# do your magic with $data
# $respose will be a response object created once/if get() returns
}
HTTP::Lite's request method allows you to specify a callback.
The $data_callback parameter, if used, is a way to filter the data as it is received or to handle large transfers. It must be a function reference, and will be passed: a reference to the instance of the http request making the callback, a reference to the current block of data about to be added to the body, and the $cbargs parameter (which may be anything). It must return either a reference to the data to add to the body of the document, or undef.
However, looking at the source, there seems to be a bug in sub request in that it seems to ignore the passed callback. It seems safer to use set_callback:
#!/usr/bin/perl
use strict;
use warnings;
use HTTP::Lite;
my $http = HTTP::Lite->new;
$http->set_callback(\&process_http_stream);
$http->http11_mode(1);
$http->request('http://www.example.com/');
sub process_http_stream {
my ($self, $phase, $dataref, $cbargs) = #_;
warn $phase, "\n";
return;
}
Output:
C:\Temp> ht
connect
content-length
done-headers
content
content-done
data
done
It looks like a callback passed to the request method is treated differently:
#!/usr/bin/perl
use strict;
use warnings;
use HTTP::Lite;
my $http = HTTP::Lite->new;
$http->http11_mode(1);
my $count = 0;
$http->request('http://www.example.com/',
\&process_http_stream,
\$count,
);
sub process_http_stream {
my ($self, $data, $times) = #_;
++$$times;
print "$$times====\n$$data\n===\n";
}
Wait, I don't understand. Why are you ruling out a separate process? This:
open my $stream, "-|", "curl $url" or die;
while(<$stream>) { ... }
sure looks like the "easiest way" to me. It's certainly easier than the other suggestions here...
Event::Lib will give you an easy interface to the fastest asynchronous IO method for your platform.
IO::Lambda is also quite nice for creating fast, responsive, IO applications.
Here is a version I ended up using via Net::HTTP
This is basically a copy of the example from the Net::HTTP man page / perl doc
use Net::HTTP;
my $s = Net::HTTP->new(Host => "www.example.com") || die $#;
$s->write_request(GET => "/somestreamingdatasource.mp3");
my ($code, $mess, %h) = $s->read_response_headers;
while (1) {
my $buf;
my $n = $s->read_entity_body($buf, 4096);
die "read failed: $!" unless defined $n;
last unless $n;
print STDERR "got $n bytes\n";
print STDOUT $buf;
}