Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

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


In reply to any question Net::Server tchat ssl by swilting

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (12)
    As of 2015-07-06 17:24 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (77 votes), past polls