Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

comment on

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


I finally switched to POE, It works great for what I need and today I was working in a script with SSL support and works great. Here is the code

#!/usr/bin/perl use warnings; use strict; use POE qw(Component::Server::TCP); use POE::Component::SSLify qw(Server_SSLify SSLify_Options); my @allowed_ips = ('', '', '', '172.1 +6.0.225'); my $listen_address = ''; my $listen_port = '1337'; my $listen_conns = '-1'; my $listen_alias = 'rc-listener'; my $output = '/home/projects/perl/rc-listener/unknown-commands +.txt'; my $ssl = 1; my $ssl_certfile = '/home/projects/perl/rc-listener/cert.crt'; my $ssl_keyfile = '/home/projects/perl/rc-listener/cert.key'; my $ssl_version = 'default'; POE::Component::Server::TCP->new( # Listen options Address => $listen_address, Port => $listen_port, Concurrency => $listen_conns, Alias => $listen_alias, # Server handlers Error => \&handle_server_error, Started => \&handle_server_started, Stopped => \&handle_server_stopped, # Client handlers ClientPreConnect => \&handle_client_pre_connect, ClientConnected => \&handle_client_connect, ClientDisconnected => \&handle_client_disconnect, ClientInput => \&handle_client_input, ClientError => \&handle_client_error, ClientFlushed => \&handle_client_flushed, ); # Start the server. POE::Kernel->run(); exit 0; sub handle_client_pre_connect { my ($session, $heap, $socket) = @_[SESSION, HEAP, ARG0]; my $session_id = $session->ID; my $remote_ip = $heap->{remote_ip}; my $remote_port = $heap->{remote_port}; my $remote = "[${remote_ip}]:${remote_port}"; unless (client_allowed($remote_ip)){ warn "ERROR > Connection from ${remote} with Session-ID ${sess +ion_id} denied by IP Policy.\n"; return undef; } if($ssl){ eval { SSLify_Options($ssl_keyfile, $ssl_certfile, $ssl_versio +n) }; if($@){ warn "ERROR > Server unable to load key or certificate fil +e.\n"; return undef; } my $ssl_socket = eval { Server_SSLify($socket) }; if($@){ warn "ERROR > Server unable to make an SSL connection.\n"; return undef; } return $ssl_socket; } else { return $socket; } } sub handle_client_connect { my ($session, $heap, $input) = @_[SESSION, HEAP, ARG0]; my $session_id = $session->ID; my $client = $heap->{client}; my $remote_ip = $heap->{remote_ip}; my $remote_port = $heap->{remote_port}; my $remote = "[${remote_ip}]:${remote_port}"; $client->put("Welcome ${remote} your Session-ID is ${session_id}") +; $client->put("Type 'help' for a complete list of accepted commands +"); warn "WARN > Client ${remote} connected with Session-ID ${session +_id}\n"; } sub handle_client_disconnect { my ($session, $heap, $input) = @_[SESSION, HEAP, ARG0]; my $session_id = $session->ID; my $client = $heap->{client}; my $remote_ip = $heap->{remote_ip}; my $remote_port = $heap->{remote_port}; my $remote = "[${remote_ip}]:${remote_port}"; warn "WARN > Client ${remote} with Session-ID ${session_id} disco +nnected\n"; } sub handle_client_input { my ($session, $heap, $input) = @_[SESSION, HEAP, ARG0]; my $session_id = $session->ID; my $client = $heap->{client}; my $remote_ip = $heap->{remote_ip}; my $remote_port = $heap->{remote_port}; my $remote = "[${remote_ip}]:${remote_port}"; if ($input eq "quit") { $client->put("Goodbye ${remote}"); $_[KERNEL]->yield("shutdown"); return; } if ($input eq "ping") { $client->put("pong"); return; } if ($input eq "whoami") { $client->put("Your IP Address is ${remote_ip}"); $client->put("Your port is ${remote_port}"); return; } if ($input eq "help") { $client->put("Really? C'mon, just type something!"); return; } open(my $fh, '>>', $output) or die "Could not open file '$output' +$!"; print $fh "${input}\n"; #$heap->{client}->put("Received input: ".$input); warn "WARN > Client ${remote} Session-ID ${session_id}: ${input}\ +n"; } sub handle_client_error { my ($syscall_name, $err_num, $err_str) = @_[ARG0..ARG2]; warn "ERROR > Client: ${err_num} - ${err_str}\n"; } sub handle_client_flushed { my ($session, $heap, $input) = @_[SESSION, HEAP, ARG0]; my $session_id = $session->ID; my $client = $heap->{client}; my $remote_ip = $heap->{remote_ip}; my $remote_port = $heap->{remote_port}; my $remote = "[${remote_ip}]:${remote_port}"; warn "INFO > Client ${remote} flushed\n"; } sub handle_server_started { warn "INFO > Server [${listen_address}]:${listen_port} started\n" +; } sub handle_server_stopped { warn "INFO > Server [".$listen_address."]:".$listen_port." stoppe +d\n"; } sub handle_server_error { my ($syscall_name, $err_num, $err_str) = @_[ARG0..ARG2]; warn "ERROR > Server: ${err_num} - ${err_str}\n"; } sub client_allowed { my $client_ip = shift; return grep { $_ eq $client_ip || $_ eq '0/0' || $_ eq '' + } @allowed_ips; }

It's working like I want, obviusly still need a lot of work but hey, for now it's working pretty good

Now the next thing I want is to make some authentication mechanism, any hint?

What I was thinking is to save a plain text "database" or a postgresql table with a relation of ip address and token and match each IP address with the token

The database connector and checks it's not the big deal here, what I need is some type of auth in the connect handle or something to not be very database intensive, for example I'm thinking to load the entire table to an array on load the listener and make it "static" and refresh the array every 30 seconds with a subroutine or something

Really this is the "thing" I don't know how to do, what I'm trying to do is to make some bolean variable with the session-id and after first check insert it into the array and on each read/write from the client check it with the array

I'm near to the answer or anyone have another mechanism to achieve this?

Thanks for all, I really appreciate all the comments

In reply to Re: Client-Server app by radu
in thread Client-Server app by radu

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 the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (3)
    As of 2020-10-31 05:24 GMT
    Find Nodes?
      Voting Booth?
      My favourite web site is:

      Results (286 votes). Check out past polls.