async_https_server.pl [plain text]
use strict;
use IO::Socket;
use IO::Socket::SSL;
use Event::Lib;
use Errno ':POSIX';
eval 'use Debug';
*{DEBUG} = sub {} if !defined(&DEBUG);
my $server = IO::Socket::INET->new(
LocalAddr => '0.0.0.0:9000',
Listen => 10,
Reuse => 1,
Blocking => 0,
) || die $!;
event_new( $server, EV_READ|EV_PERSIST, \&_s_accept )->add();
event_mainloop;
sub _s_accept {
my $fds = shift->fh;
my $fdc = $fds->accept || return;
DEBUG( "new client" );
$fdc = IO::Socket::SSL->start_SSL( $fdc,
SSL_startHandshake => 0,
SSL_server => 1,
) || die $!;
$fdc->blocking(0);
_ssl_accept( undef,$fdc );
}
sub _ssl_accept {
my ($event,$fdc) = @_;
$fdc ||= $event->fh;
if ( $fdc->accept_SSL ) {
DEBUG( "new client ssl handshake done" );
${*$fdc}{rbuf} = ${*$fdc}{wbuf} = '';
event_new( $fdc, EV_READ, \&_client_read_header )->add;
} elsif ( $! != EAGAIN ) {
die "new client failed: $!|$SSL_ERROR";
} else {
DEBUG( "new client need to retry accept: $SSL_ERROR" );
my $what =
$SSL_ERROR == SSL_WANT_READ ? EV_READ :
$SSL_ERROR == SSL_WANT_WRITE ? EV_WRITE :
die "unknown error";
event_new( $fdc, $what, \&_ssl_accept )->add;
}
}
sub _client_read_header {
my $event = shift;
my $fdc = $event->fh;
DEBUG( "reading header" );
my $rbuf_ref = \${*$fdc}{rbuf};
my $n = sysread( $fdc,$$rbuf_ref,8192,length($$rbuf_ref));
if ( !defined($n)) {
die $! if $! != EAGAIN;
DEBUG( $SSL_ERROR );
if ( $SSL_ERROR == SSL_WANT_WRITE ) {
event_new( $fdc, EV_WRITE, \&_client_read_header )->add;
} else {
$event->add; }
} elsif ( $n == 0 ) {
DEBUG( "connection closed" );
close($fdc);
} else {
my $i = index( $$rbuf_ref,"\r\n\r\n" ); $i = index( $$rbuf_ref,"\n\n" ) if $i<0; if ( $i<0 ) {
$event->add; return;
}
my $header = substr( $$rbuf_ref,0,$i,'' );
DEBUG( "got header:\n$header" );
my $wbuf_ref = \${*$fdc}{wbuf};
$$wbuf_ref = "HTTP/1.0 200 Ok\r\nContent-type: text/plain\r\n\r\n".$header;
DEBUG( "will send $$wbuf_ref" );
event_new( $fdc, EV_WRITE, \&_client_write_response )->add;
}
}
sub _client_write_response {
my $event = shift;
DEBUG( "writing response" );
my $fdc = $event->fh;
my $wbuf_ref = \${*$fdc}{wbuf};
my $n = syswrite( $fdc,$$wbuf_ref );
if ( !defined($n) && $! == EAGAIN) {
DEBUG( $SSL_ERROR );
if ( $SSL_ERROR == SSL_WANT_READ ) {
event_new( $fdc, EV_READ, \&_client_write_response )->add;
} else {
$event->add; }
} elsif ( $n == 0 ) {
DEBUG( "connection closed: $!" );
close($fdc);
} else {
DEBUG( "wrote $n bytes" );
substr($$wbuf_ref,0,$n,'' );
if ($$wbuf_ref eq '') {
DEBUG( "done" );
close($fdc);
} else {
$event->add
}
}
}