Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

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/', SSL_cert_file => '/home/swilting/perltest/certs/ks37777.kimsu', 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

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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?

    What's my password?
    Create A New User
    and !@monks...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (7)
    As of 2018-03-22 16:11 GMT
    Find Nodes?
      Voting Booth?
      When I think of a mole I think of:

      Results (279 votes). Check out past polls.