Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Re: Client-Server app

by radu (Initiate)
on Oct 02, 2018 at 13:28 UTC ( #1223399=note: print w/replies, xml ) Need Help??


in reply to Client-Server app

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

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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1223399]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (8)
As of 2020-10-19 16:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (205 votes). Check out past polls.

    Notices?