Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

any question Net::Server tchat ssl

by swilting (Beadle)
on Feb 17, 2012 at 23:55 UTC ( [id://954642]=perlquestion: print w/replies, xml ) Need Help??

swilting has asked for the wisdom of the Perl Monks concerning the following question:

hi guys , hi master of "Fu"

I continue my research on secured with SSL chats. using the example included in Net :: Server I managed to create a chat secured with a key and a certificate

my exemple

#!/usr/bin/perl -w use strict; use warnings; use Chatbot::Eliza; $|++; my $s = Server::TchatSSL::CGI->new(@ARGV); $s->background( SSL_cert_file => '/home/swilting/perltest/private/local +host.key', SSL_key_file => '/home/swilting/perltest/certs/localho +st.cert', port => '42000', ); ChatServer->run(port => 42000); exit; package Server::TchatSSL::CGI; use base qw(HTTP::Server::Simple::CGI); use strict; use base qw(Net::Server::Multiplex); sub net_server { 'Net::Server::PreFork' } package HTTP::Server::Simple::CGI; use HTTP::Server::Simple::CGI; use base qw(HTTP::Server::Simple::CGI); package ChatServer; use strict; use base qw(ChatServer); use base qw(Net::Server::Multiplex); use base qw(HTTP::Server::Simple::CGI); # Demonstrate a Net::Server style hookI continue my research on secure +d with SSL chats. using the example included in Net :: Server I manag +ed to create a chat secured with a key and a certificate sub allow_deny_hook { my $self = shift; my $prop = $self->{server}; my $sock = $prop->{client}; return 1 if $prop->{peeraddr} =~ /^127\./; return 0; } # Another Net::Server style hook sub request_denied_hook { print "Go away!\n"; print STDERR "DEBUG: Client denied!\n"; } # IO::Multiplex style callback hook sub mux_connection { my $self = shift; my $mux = shift; my $fh = shift; my $peer = $self->{peeraddr}; # Net::Server stores a connection counter in the {requests} field. $self->{id} = $self->{net_server}->{server}->{requests}; # Keep some values that I might need while the {server} # property hash still contains the current client infoI continue my +research on secured with SSL chats. using the example included in Net + :: Server I managed to create a chat secured with a key and a certif +icate # and stash them in my own object hash. $self->{peerport} = $self->{net_server}->{server}->{peerport}; # Net::Server directs STDERR to the log_file print STDERR "DEBUG: Client [$peer] (id $self->{id}) just connected. +..\n"; # Notify everyone that the client arrived $self->broadcast($mux,"JOIN: (#$self->{id}) from $peer\r\n"); # STDOUT is tie'd to the correct IO::Multiplex handle print "Welcome, you are number $self->{id} to connect.\r\n"; # Try out the timeout feature of IO::Multiplex $mux->set_timeout($fh, undef); $mux->set_timeout($fh, 20); # This is my state and will be unique to this connection $self->{state} = "junior"; } # If this callback is ever hooked, then the mux_connection callback # is guaranteed to have already been run once (if defined). sub mux_input { my $self = shift; my $mux = shift; my $fh = shift; my $in_ref = shift; # Scalar reference to the input my $peer = $self->{peeraddr}; my $id = $self->{id}; print STDERR "DEBUG: input from [$peer] ready for consuming.\n"; # Process each line in the input, leaving partial lines # in the input buffer while ($$in_ref =~ s/^(.*?)\r?\n//) { next unless $1; my $message = "[$id - $peer] $1\r\n"; $self->broadcast($mux, $message); print " - sent ".(length $message)." byte message\r\n"; } if ($self->{state} eq "senior") { $mux->set_timeout($fh, undef); $mux->set_timeout($fh, 40); } } # It is possible that this callback will be called even # if mux_connection or mux_input were never called. This # occurs when allow_deny or allow_deny_hook fails to # authorize the client. The callback object will be the # default listen object instead of a client unique object. # However, both object should contain the $self->{net_server} # key pointing to the original Net::Server object. sub mux_close { my $self = shift; my $mux = shift; my $fh = shift; my $peer = $self->{peeraddr}; # If mux_connection has actually been run if (exists $self->{id}) { $self->broadcast($mux,"LEFT: (#$self->{id}) from $peer\r\n"); print STDERR "DEBUG: Client [$peer] (id $self->{id}) closed connec +tion!\n"; } } # This callback will happen when the mux->set_timeout expires. sub mux_timeout { my $self = shift; my $mux = shift; my $fh = shift; print STDERR "DEBUG: HEARTBEAT!\n"; if ($self->{state} eq "junior") { print "Whoa, you must have a lot of patience. You have been upgra +ded.\r\n"; $self->{state} = "senior"; } elsif ($self->{state} eq "senior") { print "If you don't want to talk then you should leave. *BYE*\r\n" +; close(STDOUT); }I continue my research on secured with SSL chats. using the example + included in Net :: Server I managed to create a chat secured with a +key and a certificate $mux->set_timeout($fh, undef); $mux->set_timeout($fh, 40); } # Routine to send a message to all clients in a mux. sub broadcast { my $self = shift; my $mux = shift; my $msg = shift; foreach my $fh ($mux->handles) { # NOTE: All the client unique objects can be found at # $mux->{_fhs}->{$fh}->{object} # In this example, the {id} would be # $mux->{_fhs}->{$fh}->{object}->{id} print $fh $msg; } } 1; __END__
#!/usr/bin/perl use warnings; use strict; use Tk; use IO::Socket::SSL 'inet4'; require Tk::ROText; #Turn off buffering $|++; #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/ks37777.kim +sufi.com.key', SSL_cert_file => '/home/swilting/perltest/certs/ks37777.kimsu +fi.com.cert', 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__

I can not connect the client to the server can you help me

Replies are listed 'Best First'.
Re: any question Net::Server tchat ssl
by quester (Vicar) on Feb 18, 2012 at 06:27 UTC

    I'm not sure I can help, but there are at least three things you need to do to give anyone a fighting chance of helping you. First, I can not connect the client to the server is not at all enough of a clue as to the problem that occurs when the scripts are run on your system. You really need to post the actual error messages.

    Second, you need to upload your server code again... this segment makes it look like the posted code is corrupt:

    close(STDOUT); }I continue my research on secured with SSL chats. using the example + included in Net :: Server I managed to create a chat secured with a +key and a certificate $mux->set_timeout($fh, undef);

    I guessed that just commenting out the section beginning with "I continue..." might be sufficient, but apparently that isn't the case; the server fails immediately after starting because there is a conflict in the call to ChatServer->run over the use of port 42000. It looks like the server is binding the same port a second time.

    Third, you should post the test data that is in /home/swilting/perltest/private/localhost.key and /home/swilting/perltest/certs/localhost.cert; it is possible that differences in the test data could cause other people trying to help you to get sidetracked by errors that you don't have. Or, equally, by not getting errors that you do have.

    And, by the way... double check that the keys are really only test data before posting them. If you test with your public web server's key on your own isolated system it's not an immediate problem, but it would be if you accidentally published the private key for the world to see.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://954642]
Approved by planetscape
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (6)
As of 2024-04-19 09:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found