Hi "M",
Here's a test program which negotiates an SSL connection and sends
data in a single process (no threads, all async IO).
I've also included a patch for Net-SSLeay-1.06. I had to add a few
macros to Net::SSLeay to support the async error returns. I also
fixed the makefile to detect openssl.exe under Windows.
Hope it helps.
--Noel
> From: [EMAIL PROTECTED]
> To: [EMAIL PROTECTED]
> Subject: non-blocking example for Net::SSLeay
> Date: Sun, 29 Apr 2001 17:59:46 -0700 (PDT)
>
>
> I'm trying to write a tiny SSL webserver. It would really
> help to have an example of how to set up and use non-blocking
> SSL calls with a select statement or similar. The problem
> here is implementing CGI: the CGI script wants normal I/O
> through normal file descriptiors, and I see that it's my
> job to do SSL_read and copy the result into that file
> descriptor, and copy output from the CGI script into SSL_write.
>
> I need to select() on the CGI processes output pipe, and the
> SSL input pipe, and service requests as they come in.
>
> I'm writing this in perl, using Net::SSLeay. I've patched
> the echo example code into my tiny webserver, so if I'm
> doing the SSL_reads and SSL_writes in the main process, it works,
> but of course, the cgi part fails miserably.
>
> Does the underlying BIO interface mean if I do a fcntl
> O_NONBLOCK on the NS (network socket) that SSL will somehow
> figure that out? I don't see a BIO_set sort of thing
> to set nonblocking behavior for the BIO or SSL. The
> docs are a bit sparse, here.
>
> Maybe a new call: SSL_select($ssl,$readfds,$writefds,$exceptfds,$timeout)
> what it might do internally is do a select on the ssl network
> socket read and the rest of the $readfs, but loop around and
> try again if the network socket read didn't complete a pending
> SSL_read? Can SSL writes not be similarly monitored,
> they can just be set as nonblocking?
#! /usr/bin/perl -w
use lib '../lib';
use Socket;
use QV::OS;
use Net::SSLeay qw(1.07 die_now die_if_ssl_error);
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::randomize();
use strict;
sub ssl_ctx {
my($io) = @_;
my($ctx, $ssl);
$ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
and die_if_ssl_error("CTX_set_options");
$ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
Net::SSLeay::set_fd($ssl, fileno($io))
and die_if_ssl_error("set_fd");
return $ssl;
}
sub ssl_err_select {
my($ret, $ssl, $io, $sel_read, $sel_write) = @_;
my($i);
my($fileno) = fileno($io);
vec($$sel_read, $fileno, 1) = 0;
vec($$sel_write, $fileno, 1) = 0;
if( $ret < 0 ) {
$i = Net::SSLeay::get_error($ssl, $ret);
if( $i == &Net::SSLeay::ERROR_WANT_READ ) {
# debug
print("ERROR_WANT_READ: fileno=" . fileno($io) . "\n");
vec($$sel_read, $fileno, 1) = 1;
$ret = undef;
}
elsif( $i == &Net::SSLeay::ERROR_WANT_WRITE ) {
# debug
print("ERROR_WANT_WRITE: fileno=" . fileno($io) . "\n");
vec($$sel_write, $fileno, 1) = 1;
$ret = undef;
}
}
return $ret;
}
#---------------------------------------------------------------------
my($buf, $off);
$off = 0;
if( @ARGV || ! -t STDIN ) {
local($/) = undef;
$buf = <>;
}
else {
$buf = "Hello from Alice";
}
my($ssl_A, $connect_A,
$ssl_B, $accept_B,
$rfds, $wfds, $sel_read, $sel_write,
$s, $i, $x);
($a, $b) = QV::OS->socket_pair();
select($a); $|=1;
select($b); $|=1;
select(STDOUT);
QV::OS->io_nonblock($a, 1);
QV::OS->io_nonblock($b, 1);
# debug
print("fileno(A)=", fileno($a), "\n");
print("fileno(B)=", fileno($b), "\n");
$ssl_A = ssl_ctx($a);
#Net::SSLeay::set_connect_state($ssl_A);
Net::SSLeay::use_RSAPrivateKey_file($ssl_A, 'b-rsa.pem',
&Net::SSLeay::FILETYPE_PEM);
die_if_ssl_error("private key");
Net::SSLeay::use_certificate_file($ssl_A, 'b-cert.pem',
&Net::SSLeay::FILETYPE_PEM);
die_if_ssl_error("certificate");
$ssl_B = ssl_ctx($b);
#Net::SSLeay::set_connect_state($ssl_B);
Net::SSLeay::use_RSAPrivateKey_file($ssl_B, 'b-rsa.pem',
&Net::SSLeay::FILETYPE_PEM);
die_if_ssl_error("private key");
Net::SSLeay::use_certificate_file($ssl_B, 'b-cert.pem',
&Net::SSLeay::FILETYPE_PEM);
die_if_ssl_error("certificate");
$accept_B = $connect_A = undef;
$rfds = $wfds = '';
vec($rfds, fileno($a), 1) = 1;
vec($rfds, fileno($b), 1) = 1;
$sel_read = $sel_write = '';
while(1) {
if( vec($rfds, fileno($a), 1)
|| vec($wfds, fileno($a), 1)
) {
if( !$connect_A ) {
$i = Net::SSLeay::connect($ssl_A);
$i = ssl_err_select($i, $ssl_A, $a, \$sel_read, \$sel_write);
if( !defined($i) ) {
# no error, just continue
print("connect(A), continuing...\n");
}
elsif( $i > 0 ) {
$connect_A = 1;
print("connect(A)=$i: cipher=`"
. Net::SSLeay::get_cipher($ssl_A)
. "'\n");
vec($sel_write, fileno($a), 1) = 1;
}
else {
# closed, or some other error
Net::SSLeay::die_now("accept(B): ret=$i");
}
}
else {
$i = Net::SSLeay::write_partial($ssl_A, $off, length($buf)-$off,
$buf);
$i = ssl_err_select($i, $ssl_A, $a, \$sel_read, \$sel_write);
if( !defined($i) ) {
# no error, just continue
print("write(A): continuing...\n");
}
elsif( $i > 0 ) {
print("write(A)=$i\n");
$off += $i;
if( $off >= length($buf) ) {
shutdown($a, 1);
}
else {
vec($sel_write, fileno($a), 1) = 1;
}
}
else {
# closed, or some other error
Net::SSLeay::die_now("write(A): ret=$i");
}
}
}
if( vec($rfds, fileno($b), 1)
|| vec($wfds, fileno($b), 1)
) {
if( !$accept_B ) {
$i = Net::SSLeay::accept($ssl_B);
$i = ssl_err_select($i, $ssl_B, $b, \$sel_read, \$sel_write);
if( !defined($i) ) {
# no error, just continue
print("accept(B) continuing...\n");
}
elsif( $i > 0 ) {
$accept_B = $i;
print("accept(B)=$i: cipher=`"
. Net::SSLeay::get_cipher($ssl_B)
. "'\n");
vec($sel_read, fileno($b), 1) = 1;
}
else {
# closed, or some other error
Net::SSLeay::die_now("accept(B): ret=$i");
}
}
else {
$i = Net::SSLeay::ssl_read($ssl_B, $s, 4096);
$i = ssl_err_select($i, $ssl_B, $b, \$sel_read, \$sel_write);
if( !defined($i) ) {
# no error, just continue
print("read(B) continuing...\n");
}
elsif( $i > 0 ) {
print("read(B)=$i\n");
vec($sel_read, fileno($b), 1) = 1;
}
else {
# closed, or some other error
Net::SSLeay::die_now("read(B): ret=$i");
}
}
}
$rfds = $sel_read;
$wfds = $sel_write;
# debug
#my(@l, $r, $w);
#@l = (fileno($a), fileno($b));
#$r = "[" . join(",", (grep { vec($rfds, $_, 1); } @l)) . "]";
#$w = "[" . join(",", (grep { vec($wfds, $_, 1); } @l)) . "]";
#print("before select(rfds=$r, wfds=$w)\n");
select($rfds, $wfds, undef, undef);
# debug
#$r = "[" . join(",", (grep { vec($rfds, $_, 1); } @l)) . "]";
#$w = "[" . join(",", (grep { vec($wfds, $_, 1); } @l)) . "]";
#print("after select(rfds=$r, wfds=$w)\n");
}
Net::SSLeay::free($ssl_A);
Net::SSLeay::free($ssl_B);
Net_SSLeay.pm-1.07.diff
