http://qs321.pair.com?node_id=1197329


in reply to Re^3: Problems with IO::Socket:SSL
in thread Parallel::ForkManager or something like that?

Whats wrong with this code ? I get no handshake .... Only i get this message in the console: 
DEBUG: .../IO/Socket/SSL.pm:1492: new ctx 32253824
DEBUG: .../IO/Socket/SSL.pm:938: start handshake
DEBUG: .../IO/Socket/SSL.pm:505: starting sslifying
DEBUG: .../IO/Socket/SSL.pm:545: Net::SSLeay::accept -> 0
DEBUG: .../IO/Socket/SSL.pm:1203: SSL connect accept failed because of
+ handshake problemserror:00000000:lib(0):func(0):reason(0)

DEBUG: .../IO/Socket/SSL.pm:1528: free ctx 32253824 open=32253824
DEBUG: .../IO/Socket/SSL.pm:1533: free ctx 32253824 callback
DEBUG: .../IO/Socket/SSL.pm:1536: OK free ctx 32253824
SSL accept failed: SSL connect accept failed because of handshake prob
+lemserror:00000000:lib(0):func(0):reason(0) at testserver.pl line 101
+.

[download]
use strict;
use warnings;
use feature 'state';

no strict 'refs';


my %lkup;
our %config;
our %language;
our $dbh;

our %srv_modes;
our $HOST = $config{server};
our $PORT = $config{port};
our $last_RnR = time;
our $last_UPDATE = time;
our( %srvban, %loggedin, %rooms) = ((),(),(),());
my $uid;
my $die = 0;


require "config.cfg";
require 5.002;
use IO::Socket::SSL 'inet4';
use IO::Select;
$IO::Socket::SSL::DEBUG = 3;
use Time::HiRes;
use HTML::Template;
use  Text::Wrap;
use Fcntl ':flock';
use strict;
no strict 'refs';
$SIG{INT} = sub{ exit; };

use Parallel::ForkManager;

$|=1;

sub _uid {
    state $uid = 0;
    $uid = 1 if ++$uid > 2e9;
    $uid;
}


my %clients = ();
my $select = IO::Select->new;

my $server = IO::Socket::INET->new(
    LocalHost => 'host',
    LocalPort => 63027,
    Proto     => 'tcp',
    Listen    => 10000,
    Reuse     => 1,
) or die "Sock Error: $!\n";

my $pm = Parallel::ForkManager->new(500);
$pm->set_waitpid_blocking_sleep(0);

$pm->run_on_finish( sub {
    my ($pid,$exitcode,$ident,$exitsignal,$coredump,$get) = @_;
    $clients{$ident}->{ident}  = $ident;
    $clients{$ident}->{ip}     = $get->{ip};
    $clients{$ident}->{socket} = delete $lkup{$ident};
    my $killsock = $get->{killing} || 0;
    my $sock = $clients{$ident}->{socket};
    if($killsock){ 
      delete $clients{$ident};
      $select->remove($sock);
    }
});

$server->autoflush(1);
$select->add($server);

while (1) {
    foreach my $key ($select->can_read()) {  # foreach
        if ($key eq $server) {  # if $bay eq $server
            next if $key eq "";

            our $bay   = $server->accept or next;
            my $ip    = $bay->peerhost();
            our $ident = _uid();

            $lkup{$ident} = $bay;
            $select->add($bay);
            my $buffer = <$bay>;
            $pm->start($ident) and next;
            IO::Socket::SSL->start_SSL($bay,
                                      PeerAddr => $config{server},
                                      SSL_verify_mode => SSL_VERIFY_PE
+ER,
                                      verify_hostname => 1,
                                      SSL_hostname => $config{server},
                                      SSL_port     => $PORT,
                                      SSL_server => 1,
                                         SSL_ca_file => $config{ca_fil
+e},
                                        SSL_ca_path => $config{ca_path
+},
                                      SSL_verifycn_name => 'host',
                                      SSL_verifycn_scheme => 'http',
                                      SSL_cert_file => $config{cert_fi
+le},
                                      SSL_key_file => $config{key_file
+},
                                     ) or die "SSL accept failed: $SSL
+_ERROR";
            my $killing = 0;

            if( defined $buffer && $buffer =~ m/^GET\s\/\?sid=12\sHTTP
+\/1\.1\s/ ){
              print "$buffer";
              sendHeader($bay);
              print "OK";
              for( 1 .. 30 ){ # Firefox and other browsers
              $bay->syswrite("<!-- //--><!-- //--><!-- //--><!-- //-->
+<!-- //-->\n\n");
              }
my $html=<<"EOT";
<html>
<head>
<title>hallo</title>
</head>
<body style='background-color: darkblue; color: #FFFFFF'>
hello world
</body>
</html>
EOT

              $bay->syswrite($html);
            }elsif( defined $buffer && $buffer =~ m/^GET\s\/\?printoal
+l=1\sHTTP\/1\.1\s/ ){
                foreach my $client( keys %clients ){
                    print "$buffer";
                    my $socket = $clients{$client}->{socket};
                    $socket->syswrite("The sun is shining\n");
                    print "Conntected: \n" . keys %clients;
                   
                }
                $killing = 1;
            }
            
            $pm->finish(0, { ip => $ip, killing => $killing });
        }
    }

    $pm->wait_all_children;
}

sub sendHeader {
    my $client = shift;
    if( defined $client ) {
my $header =<<"EOT";
HTTP/1.1 200 OK
Content-type: text/html\n\n
EOT
      $client->syswrite($header);
    }
}

[download]
Please help thanks.. Regards Sascha

Replies are listed 'Best First'.
Re^5: Problems with IO::Socket:SSL
by noxxi (Pilgrim) on Aug 13, 2017 at 16:22 UTC
    Handshake error can be about anything, i.e. mismatch in protocol version, wrong certificates, no cipher overlap, .... But there are some things which are very strange which your way of doing start_SSL. It looks like you've added any options you could find somewhere, no matter if they make sense for the SSL server or not. Some of these might be the cause of the problem:
    • You are setting SSL_server to true. This is correct
    • You are requesting a client certificate (SSL_VERIFY_PEER). This is probably not what you intend. Also, you add various options which are relevant for requesting of verification of server certificates (SSL_hostname, SSL_verifycn_..., ..) and which makes no sense in the role of an SSL server.
    • There is no verify_hostname option for IO::Socket::SSL::start_SSL. There is also no PeerAddr option. All options start with SSL_ prefix.
    I would suggest to clean up the code and try again. If the problem persists try with a minimal server instead (i.e. no forkmanager) so that the problem can be more easily debugged.
[reply]

In Section Seekers of Perl Wisdom