forgiveness for the bad presentation perl code see my post on PerlMonks
http://www.perlmonks.org/?node_id=954050
Le 2012-02-15 20:51, ml a écrit :
hi guys hi master of "Fu" any update
I am doing some research on the server and client for the chat. I
have
long taken the trouble to consult the documentation that is different
and both PerlMonks different pages that deal with this vast subject.
I
try to find a minimal example because I want to turn into non
securise
securise. here is the status of my research
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket::SSL 'inet4';
use threads; use threads::shared; $|++;
print "$$ Server started\n";
# do a "top -p -H $$" to monitor server ++ threads
our @clients : shared; @clients = ();
my $server = new IO::Socket::SSL( Timeout => 7200, Proto =>
"tcp",
LocalPort => 42000, Reuse => 1, Listen => 3, SSL_use_cert =>
1,
SSL_verify_mode => 0x00, SSL_key_file =>
'/home/swilting/perltest/private/localhost.key' +, SSL_cert_file =>
'/home/swilting/perltest/certs/localhost.cert', SSL_passwd_cb => sub
{ return "" },
);
my $num_of_client = -1;
while (1) { my $client;
do { $client = $server->accept; } until ( defined($client) );
my $peerhost = $client->peerhost();
print "accepted a client $client, $peerhost, id = ",
++$num_of_client,
"\n";
my $fileno = fileno $client;
push (@clients, $fileno);
#spawn a thread here for each client
my $thr = threads->new( \&processit, $client, $fileno, $peerhost )
+->detach(); }
# end of main thread
sub processit {
my ($lclient,$lfileno,$lpeer) = @_;
#local client
if($lclient->connected){
# Here you can do your stuff # I use have the server talk to the
client
# via print $client and while(<$lclient>)
print $lclient "$lpeer->Welcome to server\n";
while(<$lclient>){
# print $lclient "$lpeer->$_\n";
print "clients-> @clients\n";
foreach my $fn (@clients) {
open my $fh, ">&=$fn" or warn $! and die;
print $fh "$lpeer->$_" } } }
#close filehandle before detached thread dies out
close( $lclient);
#remove multi-echo-clients from echo list
@clients = grep {$_ !~ $lfileno} @clients; }
__END__
#!/usr/bin/perl
use warnings; use strict; use Tk; use IO::Socket::SSL 'inet4';
require Tk::ROText;
#get id
my $name = shift || 'anon';
# create the socket
my $host = 'localhost'; my $port = 42000;
my $socket = IO::Socket::SSL->new( PeerAddr => $host, PeerPort =>
$port,
Proto => 'tcp', SSL_use_cert => 1, SSL_verify_mode => 0x00,
SSL_key_file => '/home/swilting/perltest/private/localhost.k +ey',
SSL_cert_file => '/home/swilting/perltest/certs/localhost.cer +t',
SSL_passwd_cb => sub { return "" }, ); defined $socket or die "ERROR:
Can't connect to port $port on $host: $ +!\n";
print STDERR "Connected to server ...\n";
my $mw = new MainWindow; my $log = $mw->Scrolled('ROText',
-scrollbars=>'ose', -height=> 5, -width=>45, -background =>
'lightyellow', )->pack;
my $txt = $mw->Entry( -background=>'white', )->pack(-fill=> 'x',
-pady=>
5);
$mw ->bind('<Any-Enter>' => sub { $txt->Tk::focus });
$txt->bind('<Return>' => [\&broadcast, $socket]);
$mw ->fileevent($socket, readable => sub {
my $line = <$socket>; unless (defined $line) { $mw->fileevent($socket
=>
readable => ''); return; } $log->insert(end => $line);
$log->see('end'); });
MainLoop;
sub broadcast { my ($ent, $sock) = @_;
my $text = $ent->get;
$ent->delete(qw/0 end/);
print $sock $name.'->'. $text, "\n"; }
__END__
#Server.pl
#!/usr/local/bin/perl
use strict; use warnings; use IO::Socket::SSL 'inet4';
my $server = IO::Socket::SSL->new( LocalPort=> 42000,
## Type=>SOCK_STREAM,
Reuse=>1, Listen=>5, Proto => 'tcp', SSL_use_cert => 1,
SSL_verify_mode => 0x00, SSL_key_file =>
'/home/swilting/perltest/private/localhost.key', SSL_cert_file =>
'/home/swilting/perltest/certs/localhost.cert', SSL_passwd_cb => sub
{ return "" }, )or die ("Could not create server");
while(my $client=$server->accept()){ my $child_pid; unless(defined
($child_pid=fork())){die"can not fork\n";} if(defined($child_pid)){
while(my $line = <$client>){
print "CLIENT says:$line\n"; } }
else{ while(my $line = <>){
print $client "$line\n"; } } }
redo; close($server); <>;
the server running the threads fails with a segmentation fault and my
client fails after two requests I do not know why and characters
displayed on the client encodes are poorly I do not know either why
--
http://pgp.mit.edu:11371/pks/lookup?op=get&search=0xC2626742
gpg --keyserver pgp.mit.edu --recv-key C2626742
http://urlshort.eu fakessh @
http://gplus.to/sshfake
http://gplus.to/sshswilting
http://gplus.to/john.swilting
https://lists.fakessh.eu/mailman/
This list is moderated by me, but all applications will be accepted
provided they receive a note of presentation
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
