Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Re^3: Multiplexing HTTPS server, peer cert authentication problem.

by Thelonius (Priest)
on Mar 06, 2007 at 18:10 UTC ( #603473=note: print w/ replies, xml ) Need Help??


in reply to Re^2: Multiplexing HTTPS server, peer cert authentication problem.
in thread Multiplexing HTTPS server, peer cert authentication problem.

Well, I am suggesting it because the documentation recommends it.

I tried it out and it seems to work, with one change, that it needs SSL_server => 1 here:

my $sslaccept = IO::Socket::SSL->start_SSL($acceptsock, {SSL_startHandshake => 0, SSL_server => 1, SSL_use_cert => 1, SSL_verify_depth => 1, SSL_verify_mode => 0x03, });
Otherwise it will try to authenticate as a client.

Here's a restructured program:

#!/usr/bin/perl use IO::Socket::INET; use IO::Socket::SSL qw/debug4/; use IO::Select; use HTTP::Response; use File::MMagic; use strict; use warnings; my $magic = File::MMagic->new; my $listenport = 2222; my $listen = IO::Socket::INET->new( LocalPort => $listenport, Listen => 10, Reuse => 1, ); my $timeout = undef; my $rlen = 1024; my $wlen = 4096; my $fblen = 10240; *$listen->{callback} = \&accepter; my $rselect = IO::Select->new($listen); my $wselect = IO::Select->new(); $|++; while (1) { eval { # for all readable sockets my @socks = IO::Select::select($rselect, $wselect, undef, $timeout); my $processed = 0; for my $aref (@socks) { if ($aref) { for my $sock (@{$aref}) { if (*$sock->{callback}) { *$sock->{callback}($sock, $rselect, $wselect); } else { die "Internal error no callback on socket: $sock\n"; } ++$processed; } } } if ($processed == 0) { # do timeout } }; print "uncaught error: $@\n" if $@; } sub accepter { my ($sock, $rselect, $wselect) = @_; my $acceptsock = $sock->accept; my $sslaccept = IO::Socket::SSL->start_SSL($acceptsock, {SSL_startHandshake => 0, SSL_server => 1, SSL_use_cert => 1, SSL_verify_depth => 1, SSL_verify_mode => 0x03, }); $rselect->add($sslaccept); @{*$sslaccept}{qw/sbuf size state callback/} = ('', 0, 'handshake', \&do_handshake); # then go back to your select() } sub do_handshake { my ($sock, $rselect, $wselect) = @_; my $sslclient = $sock->accept_SSL(); if (defined($sslclient)) { # success! # advance the state of socket to connected, etc. *$sock->{state} = 'need_headers'; *$sock->{callback} = \&proc_headers; } elsif ($SSL_ERROR == SSL_WANT_READ ) { $rselect->add($sock); $wselect->remove($sock); } elsif ($SSL_ERROR == SSL_WANT_WRITE) { $rselect->remove($sock); $wselect->add($sock); } else { # connect failed # maybe log it .. $rselect->remove($sock); $wselect->remove($sock); $sock->close(); } } sub proc_headers { my ($sock, $rselect, $wselect) = @_; my $props = *$sock; # reading incoming request... my $read = $sock->sysread( $props->{sbuf},$rlen,$props->{size}); unless (defined $read) { $rselect->remove($sock); die "read error: $!\n"; } $props->{size} += $read; if (my ($headers) = ($props->{sbuf} =~ /^(.*?)\r\n\r\n(.*)/s)) { # we've finished reading the HTTP header use bytes; my ($verb, $uri) = ($headers =~ /^(\w+)\s+(\S+)/); print "[$verb] [$uri]\n"; # put any remaining bytes of request back into the buffer # (likely HTTP message body) @{$props}{qw/headers verb uri sbuf size/} = ( $headers, $verb, $uri, substr($props->{sbuf}, length($headers)), length($props->{sbuf}) ); if (my ($bsize) = ($headers =~ /Content-Length\s*:\s*(\d+)/s)) { # need to read HTTP message body of length $bsize @{$props}{qw/need state callback/} = ($bsize, 'need_body', \&read_body); # already in $rselect } else { $rselect->remove($sock); request_done($sock, $rselect, $wselect, ''); } } } sub read_body { my ($sock, $rselect, $wselect) = @_; my $props = *$sock; # reading body... my $size = $props->{need} < $rlen ? $props->{need} : $rlen; my $read = $sock->sysread( $props->{sbuf},$size,$props->{size}); $props->{size} += $read; $props->{need} -= $read; # done reading body (if we've read enough bytes) request_done($sock, $rselect, $wselect, $props->{sbuf}) unless $props->{need}; } sub request_done { my ($sock, $rselect, $wselect, $body) = @_; my $props = *$sock; @{$props}{qw/size sbuf body/} = (0, '', $body); # request read, build response... my $msg; # # YES: I'm aware the path is tainted/insecure. # This is just an example to demonstrate failure. # if (-f ".".$props->{uri}) { # the requested file was found, so... # determine mime-type my $type = $magic->checktype_filename( ".".$props->{uri}) || "text/html"; # read local file open F, "<.".$props->{uri}; my ($buf, $len) = ('', 0); while (my $read = sysread(F, $buf, $fblen, $len)) { $len += $read; } close F; # will send positive response $msg = [200, 'OK', $type, $buf]; } else { # will send negative response $msg = [404, 'File Not Found', 'text/html', 'What file?!?']; } { use bytes; # construct HTTP response as a string $props->{wbuf} = 'HTTP/1.1 '. HTTP::Response->new( $msg->[0] => $msg->[1], ['Content-Type' => $msg->[2], 'Content-Length' => length($msg->[3]), 'Connection' => 'close'], $msg->[3] )->as_string; $props->{wdone} = 0; $props->{wsize} = length($props->{wbuf}); $props->{state} = 'response_pending'; $props->{callback} = \&send_response; } send_response($sock, $rselect, $wselect); } sub send_response { # writing outgoing response... my ($sock, $rselect, $wselect) = @_; my $props = *$sock; my $size = $props->{wsize} < $wlen ? $props->{wsize} : $wlen; $wselect->add($sock); my $wrote = $sock->syswrite( $props->{wbuf},$size,$props->{wdone}); unless (defined $wrote) { $wselect->remove($sock); die "write error: $!\n"; } $props->{wdone} += $wrote; if ($props->{wdone} == $props->{wsize}) { # we're done sending the request, ready for another # NOTE: IO::Socket::SSL docs say we can't do multiple # requests, but it does work in the absense of # peer cert authentication. $wselect->remove($sock); if ($props->{keepalive}) { $rselect->add($sock); $props->{wdone} = 0; $props->{wsize} = 0; $props->{wbuf} = ''; $props->{state} = 'need_headers'; $props->{callback} = \&proc_headers; # seemingly correct, but blocks listener socket #$sock->close(SSL_no_shutdown => 1); } else { $sock->close(); } } }


Comment on Re^3: Multiplexing HTTPS server, peer cert authentication problem.
Select or Download Code
Re^4: Multiplexing HTTPS server, peer cert authentication problem.
by erroneousBollock (Curate) on Mar 07, 2007 at 01:59 UTC
    Hi Thelonius,

    Excellent! It works. Thank-you very much.

    I'll reply at the top-level with a summary so that others may benefit from your research.
    -David.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://603473]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (7)
As of 2014-12-28 21:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (183 votes), past polls