Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re^2: Parallel::ForkManager or something like that?

by Sascha2018 (Novice)
on Aug 12, 2017 at 11:58 UTC ( #1197306=note: print w/replies, xml ) Need Help??


in reply to Re: Parallel::ForkManager or something like that?
in thread Parallel::ForkManager or something like that?

Hello Mario. Thank you for your answer. I have modified the script a little bit, but if i want to send a http Header to $bay and open the site on http://127.0.0.1:2222 the browser shows me nothing or only if i have luck the script code. But not HTML ... What i do wrong ?
#!/usr/bin/perl use strict; use warnings; use feature 'state'; no strict 'refs'; use IO::Socket; use IO::Select; use Parallel::ForkManager; my $die = 0; my %lkup; $|=1; sub _uid { state $uid = 0; $uid = 1 if ++$uid > 2e9; $uid; } $SIG{INT} = sub { $die = 1; exit; }; my %clients = (); my $select = IO::Select->new; my $server = IO::Socket::INET->new( LocalHost => '127.0.0.1', LocalPort => 2222, Proto => 'tcp', Listen => 10000, Reuse => 1, ) or die "Sock Error: $!\n"; my $pm = Parallel::ForkManager->new(10); $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}; }); $server->autoflush(1); $select->add($server); while (!$die) { foreach my $key ($select->can_read()) { # foreach if ($key eq $server) { # if $bay eq $server next if $key eq ""; my $bay = $server->accept or next; my $ip = $bay->peerhost(); my $ident = _uid(); $lkup{$ident} = $bay; $select->add($bay); my $buffer = <$bay>; if( $buffer =~ m/^GET\s\/\sHTTP\/1\.1/ ){ print "OK"; sendHeader($bay); my $html=<<"EOT"; <html> <head> </head> <body style='background-color: blue'> </body> </html> EOT $bay->syswrite($html); } $pm->start($ident) and next; print "$buffer\n"; $pm->finish(0, { ip => $ip }); } } $pm->wait_all_children; } sub sendHeader { my $sock = shift; my $header =<<"EOT"; HTTP/1.0 200 OK Content-type: text/html EOT for( 1.. 10 ){ $sock->syswrite("<!-- Server 2017 //-->\n"); } $sock->syswrite($header); }

Replies are listed 'Best First'.
Re^3: Parallel::ForkManager or something like that?
by Sascha2018 (Novice) on Aug 12, 2017 at 13:03 UTC
    Now it works :) And how can i solve it that the processes are not blocking? If i open the address and port through the browser and open another browser where i connect to it, i can see the page only in one windows, till i close the browser. Then i can see the other page. Regards

      Hi Sascha2018. Run $pm->start before $select->add.

      while (!$die) { foreach my $key ($select->can_read()) { # foreach if ($key eq $server) { # if $bay eq $server next if $key eq ""; my $bay = $server->accept or next; my $ip = $bay->peerhost(); my $ident = _uid(); $lkup{$ident} = $bay; $pm->start($ident) and next; # <-- spawn worker here $select->add($bay); my $buffer = <$bay>; if ($buffer =~ m/^GET\s\/\sHTTP\/1\.1/) { print "OK"; sendHeader($bay); my $html=<<"EOT"; <html> <head> </head> <body style='background-color: blue'> </body> </html> EOT $bay->syswrite($html); } print "$buffer\n"; $pm->finish(0, { ip => $ip }); } } $pm->wait_all_children; }

      Regards, Mario

Re^3: Problems with IO::Socket:SSL
by Anonymous Monk on Aug 12, 2017 at 17:18 UTC
    Hello. In another script i have IO::Socket::SSL If i fork() with $pm->start($ident) and next; and call the IO::Socket::SSL->start_SSL() routine later, i only get
    DEBUG: .../IO/Socket/SSL.pm:1492: new ctx 44788592 DEBUG: .../IO/Socket/SSL.pm:938: start handshake DEBUG: .../IO/Socket/SSL.pm:505: starting sslifying
    in the console. The handshake does not finish if a client connects. If i make Strg+C on the console i get the rest , but only then.
    DEBUG: .../IO/Socket/SSL.pm:1528: free ctx 44788592 open=44788592 DEBUG: .../IO/Socket/SSL.pm:1533: free ctx 44788592 callback DEBUG: .../IO/Socket/SSL.pm:1536: OK free ctx 44788592
    Nothing happens in the browser :( What do i wrong?
      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 +.
      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); } }
      Please help thanks.. Regards Sascha
        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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1197306]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2017-12-14 23:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What programming language do you hate the most?




















    Results (414 votes). Check out past polls.

    Notices?