comment on

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

In reply to Re^4: Problems with IO::Socket:SSL by Sascha2018
in thread Parallel::ForkManager or something like that? by Sascha2018

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Do you know where your variables are?
	PerlMonks