Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??

Ok, finally got a working code, I tested it with 1000 simultaneous clients running random commands and works pretty well.

I'm using 3 shared hashes to mantain a shared relation between IP'ss and tokens for each one

#!/usr/bin/perl

use warnings;
use strict;
use threads;
use threads::shared;

use DBI;
use POE qw(Component::Server::TCP);
use POE::Component::SSLify qw(Server_SSLify SSLify_Options);
use Getopt::Long;

my %allowed : shared;
my %token : shared;
my %auth : shared;

my $loglevel      = 5;

# MySQL connection variables
my $dbhost         = "127.0.0.1";
my $dbname         = "db_mydb";
my $dbtable        = "tab_mytable";
my $ipcol          = "col_ip_address";
my $tokencol       = "col_token";
my $dbuser         = "root";
my $dbpass         = "*****";
my $dbport         = "3306";

my $listen_address = '127.0.0.1';
my $listen_port    = '1337';
my $listen_conns   = '100';

my $ssl            = 0;
my $ssl_certfile   = 'listener.crt';
my $ssl_keyfile    = 'listener.key';
my $ssl_version    = 'default';

GetOptions(
    # Help handler
    'help|h'       => \&handle_help,

    # SSL related options
    'ssl=i'        => \$ssl,
    'cert=s'       => \$ssl_certfile,
    'key=s'        => \$ssl_keyfile,

    # Listen options
    'address=s'    => \$listen_address,
    'port=i'       => \$listen_port,
    'conns=i'      => \$listen_conns,

    # MySQL options
    'dbhost=s'     => \$dbhost,
    'dbname=s'     => \$dbname,
    'dbtable=s'    => \$dbtable,
    'ipcol=s'      => \$ipcol,
    'tokencol=s'   => \$tokencol,
    'dbuser=s'     => \$dbuser,
    'dbpass=s'     => \$dbpass,
    'dbport=i'     => \$dbport,

    # Misc options
    'loglevel=i'   => \$loglevel

);

param_check($ssl, $ssl_certfile, $ssl_keyfile, $listen_address, $liste
+n_port, $listen_conns);

threads->new(\&update_tokens);

POE::Component::Server::TCP->new(
    # Listen options
    Address             => $listen_address,
    Port                => $listen_port,
    Concurrency         => $listen_conns,

    # 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)){
        logger("ERROR", "Connection from ${remote} with Session-ID ${s
+ession_id} denied by IP Policy");
        return undef;
    }

    if($ssl){
        eval { SSLify_Options($ssl_keyfile, $ssl_certfile, $ssl_versio
+n) };
        if($@){
            logger("ERROR", "Server unable to load key or certificate 
+file.");
            return undef;
        }

        my $ssl_socket = eval { Server_SSLify($socket) };
        if($@){
            logger("ERROR", "Server unable to make an SSL connection."
+);
            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
+");

    logger("WARN", "Client ${remote} connected with Session-ID ${sessi
+on_id}");
}

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}";

    if($auth{$session_id}){
        delete $auth{$session_id};
        logger("WARN", "Client ${remote} with Session-ID ${session_id}
+ logged out");
    }
    logger("WARN", "Client ${remote} with Session-ID ${session_id} dis
+connected");
}

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 =~ /^login(\s|$)/i){
        if (auth_check($session_id)){
            $client->put("${remote} with Session-ID ${session_id} Alre
+ady logged in!");
        } else {
            my @login = split /\s+/, $input;
            if(token_check($remote_ip, $login[1])){
                $auth{$session_id} = 1;
                $client->put("Logged in with Session-ID: ${session_id}
+!");
                logger("WARN", "Client ${remote} with Session-ID ${ses
+sion_id} logged in");
            } else {
                $client->put('Access denied!');
                $_[KERNEL]->yield("shutdown");
                logger("ERROR", "Client ${remote} with Session-ID ${se
+ssion_id} failed login attempt");
            }
        }
        return;
    }

    if ($input eq "quit") {
        $client->put("Goodbye ${remote}");
        $_[KERNEL]->yield("shutdown");
        return;
    }

    if (auth_check($session_id)){
        if ($input eq "ping") {
            $client->put("pong");
            return;
        }

        if ($input eq "logout") {
            delete $auth{$session_id};
            $client->put("Logged out from Session-ID: ${session_id}");
            logger("WARN", "Client ${remote} with Session-ID ${session
+_id} logged out");
            return;
        }

        if ($input eq "whoami") {
            $client->put("Your IP Address is ${remote_ip}");
            $client->put("Your communication port is ${remote_port}");
            return;
        }

        if ($input eq "help") {
            $client->put("Only can use quit if you want to exit");
            return;
        }

        logger("WARN",  "Client ${remote} Session-ID ${session_id}: ${
+input}");
    } else {
        logger("WARN", "Client ${remote} with Session-ID ${session_id}
+ tried input: ${input}");
        $client->put('Login required!');
    }
}

sub handle_client_error
{
    my ($syscall_name, $err_num, $err_str) = @_[ARG0..ARG2];
    logger("ERROR", "Client: ${err_num} - ${err_str}");
}

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}";

    logger("INFO", "Client ${remote} flushed");
}

sub handle_server_started
{
    logger("WARN", "Server [${listen_address}]:${listen_port} started"
+);
}

sub handle_server_stopped
{
    logger("WARN", "Server [${listen_address}]:${listen_port} stopped"
+);
}

sub handle_server_error
{
    my ($syscall_name, $err_num, $err_str) = @_[ARG0..ARG2];
    if($err_num){
        logger("ERROR", "Server: ${err_num} - ${err_str}");
    }
}

sub update_tokens
{
    my $dbi_dsn  = "DBI:mysql:database=${dbname};host=${dbhost};port=$
+{dbport}";
    my %sql_opts = ( PrintError => 0 );
    my @sql_conn = ($dbi_dsn, $dbuser, $dbpass, \%sql_opts);

    my $dbi_conn = DBI->connect(@sql_conn);
    if (!$dbi_conn){
        logger("FATAL", "Unable to connect to ${dbhost}:${dbport} - $D
+BI::errstr");
        logger("FATAL", "Retry in 60 seconds...");
        sleep 60;
    } else {
        logger("INFO", "Connected to ${dbhost}:${dbport}");
    }

    my $dbsel_stmt = $dbi_conn->prepare("SELECT ${ipcol}, ${tokencol} 
+FROM ${dbtable}");

    while (1){
        logger("INFO", "Running auth-update worker child process");

        unless ($dbi_conn->ping) {
            logger("FATAL", "Unable to connect to ${dbhost}:${dbport},
+ retry in 60 seconds");
            sleep 60;
            $dbi_conn = DBI->connect(@sql_conn);
        }

        if($dbsel_stmt->execute()){
            my %newallow;
            while (my @array = $dbsel_stmt->fetchrow_array){
                $newallow{$array[0]} = 1;
                if($token{$array[0]}){
                    if($token{$array[0]} ne $array[1]){
                        $token{$array[0]} = $array[1];
                        logger("INFO", "Token for $array[0] updated");
                    }
                } else {
                    $token{$array[0]} = $array[1];
                    logger("INFO", "Added token for IP $array[0]");
                }
            }

            for my $ip (keys %token){
                if(!$newallow{$ip}){
                    logger("INFO", "${ip} removed from allowed IP's");
                    delete $allowed{$ip};
                    delete $token{$ip};
                } else {
                    if(!client_allowed($ip)){
                        $allowed{$ip} = 1;
                        logger("INFO", "${ip} added to allowed IP's");
                    }
                }
            }

            logger("INFO", "Done auth-update worker child process");
        } else {
            logger("FATAL", "Cannot execute SQL Statement");
        }
        sleep 30;
    }
}

sub token_check
{
    my ($client_ip, $input) = @_;
    if (!defined $input || $input eq ''){
        return undef;
    } else {
        if ($input eq $token{$client_ip}){
            return 1;
        } else {
            return undef;
        }
    }
}

sub auth_check
{
    my $session_id = shift;
    return $auth{$session_id};
}

sub client_allowed
{
    my $ip = shift;
    return $allowed{$ip};
}

sub param_check
{
    my ($ssl, $ssl_certfile, $ssl_keyfile, $listen_address, $listen_po
+rt, $listen_conns) = @_;
    if($ssl){
        logger("INFO", "SSL support enabled");
        if(-e $ssl_certfile){
            logger("INFO", "SSL Certificate file loaded");
        } else {
            logger("FATAL", "SSL enabled and no certificate file found
+!");
            exit(1);
        }
        if(-e $ssl_keyfile){
            logger("INFO", "SSL Key file loaded");
        } else {
            logger("FATAL", "SSL enabled and no key file found!");
            exit(1);
        }
    } else {
        logger("INFO", "SSL support not enabled");
    }

    if($listen_address =~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$
+/ && (($1<=255 && $1 >= 0) && ($2<=255 && $2 >= 0) && ($3<=255 && $3 
+>= 0)  && ($4<=255 && $4 >= 0))){
        logger("INFO", "IPv4 Address parsed correctly: ${listen_addres
+s}");
    } else {
        logger("FATAL", "Invalid IPv4 Address provided: ${listen_addre
+ss}");
        exit(1);
    }
    if(($listen_port < 65536) && ($listen_port > 0)){
        logger("INFO", "Port number parsed correctly: ${listen_port}")
+;
    } else {
        logger("FATAL", "Invalid port number provided: ${listen_port}"
+);
        exit(1);
    }
    if($listen_conns >= -1){
        logger("INFO", "Simultaneous connections parsed correctly: ${l
+isten_conns}");
    } else {
        logger("FATAL", "Invalid simultaneous connections provided: ${
+listen_conns}");
        exit(1);
    }
}

sub logger {
    my ($level, $msg) = @_;
    my $numlevel = 0;
    if ($level eq 'FATAL') {
        $numlevel = 1;
    } elsif ($level eq 'ERROR') {
        $numlevel = 2;
    } elsif ($level eq 'WARN') {
        $numlevel = 3;
    } elsif ($level eq 'INFO') {
        $numlevel = 4;
    } elsif ($level eq 'DEBUG') {
        $numlevel = 5;
    } else {
        $numlevel = 4;
    }
    if ($numlevel <= $loglevel) {
        warn "$level: $msg\n";
    }
}

sub handle_help
{
    print "\nUsage ${0} [OPTS]\n\n";
    print "Available options:\n\n";
    print "General options:\n";
    print "    --help     => No arguments expected, will show this hel
+p text\n";
    print "    --loglevel => Number between 0 and 5 expected.\n";
    print "                  0 - DISABLED: Log disabled\n";
    print "                  1 - FATAL: Fatal logging only\n";
    print "                  2 - ERROR: Fatal and error logging\n";
    print "                  3 - WARN: Fatal, error and warn logging\n
+";
    print "                  4 - INFO: Fatal, error, warn and info log
+ging\n";
    print "                  5 - DEBUG: All logging\n";
    print "\nSSL Related options:\n";
    print "    --ssl      => Accepted values:\n";
    print "                  1 - Enable SSL support (cert and key) opt
+ion required\n";
    print "                  0 - Don't enable SSL support, only plain 
+text support\n";
    print "    --cert     => Certificate file path required for SSL en
+cription\n";
    print "    --key      => Certificate key file path required for SS
+L encription\n";
    print "\nConnection options:\n";
    print "    --address  => Listening address, default \"${listen_add
+ress}\"\n";
    print "    --port     => Listening port, default \"${listen_port}\
+"\n";
    print "    --conns    => Concurrent connections, default \"${liste
+n_conns}\"\n";
    print "\nMySQL options:\n";
    print "    --dbhost   => Database server IP, default \"${dbhost}\"
+\n";
    print "    --dbname   => Database table name, default \"${dbname}\
+"\n";
    print "    --dbtable  => MySQL table name, default \"${dbtable}\"\
+n";
    print "    --ipcol    => IP column name in MySQL table, default \"
+${ipcol}\"\n";
    print "    --tokencol => Token column name in MySQL table, default
+ \"${tokencol}\"\n";
    print "    --dbuser   => Database username, default \"${dbuser}\"\
+n";
    print "    --dbpass   => Database password, default \"${dbpass}\"\
+n";
    print "    --dbport   => Database server port number, default \"${
+dbport}\"\n";
    exit(0);
}

[download]

I'm not 100% sure about the handling of the thread element and if all is ok, but is working.

I don't know if it will be helpfuly for someone but as I got lot of help from perlmonks I want it to be here for everyone who wants to use it or use some parts of it

What I need now is some tips or something that can be improved, but for now, It's working in replacement to my old PHP api and is about 400-500% faster.

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

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


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others goofing around in the Monastery: (5)
As of 2024-04-23 21:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found