Click here to Skip to main content
14,972,994 members
Articles / Programming Languages / Perl
Posted 1 May 2009

Tagged as


10 bookmarked

Perl Chat from scratch | P.I.C. Chat system

Rate me:
Please Sign up or sign in to vote.
4.33/5 (2 votes)
1 May 2009CPOL6 min read
This article is about creating a ready to run chat system in Perl scripting language.
P.I.C. Chat


So, let's get to the subject. First of all, I was never interested in chats or instant messengers and actually I don't know how they work. Maybe just a little. ;) I decided to build my own project to implement my own way and see how it will work. Ok, P.I.C. (Private Internet Communication) System is written in Perl, it uses Perl gtk2 module for every user interface and works with mysql database, it is designed for Linux systems and will not work on Windows. The main purpose of this paper is to show how we can create our own, very simple chat system.

And one more thing, I will not comment code too much because Perl syntax speaks for itself.

Let's take a look at the following scheme to understand the way it works.

P.I.C. Chat

Look, I'm sorry for my painting skills, I'm just not a professional. And one more thing, why Perl? Simply because I don't have much time to play around building it with C and it is a open source project. Anyway I know it should be done better, more secure and such. So, now you know how it works. All data which is sent to server from user or admin is processed and depends on information sent within request. Server performs some actions and sends results of these actions to the source sender. All data is encrypted with combined RC4 and rot47 algorithms. It's so simple ain't it? Let's see the code.

Using the Code

The first thing which you will see after decompressing the archive will be 2 files: one is icon and second is Installer. Be careful with icon file by the way, if you remove it - you will not be able to launch user / admin console. To get rid of such issue you need to look inside the code of generated files and remove one line from each. Hey, wait up mate, what generated files? That's it, stop, look at the installer:

P.I.C. Chat

All these fields that you can see you have to fill with data. There is no sense in describing each one of them, just hit 'About and Help' button and you'll see. I have mentioned about these generated files, so, after each file is filled with correct data, by hitting 'Generate files' button, you'll get 3 files: manager, client and server, already configured and ready to run. The content of these files is encrypted and functions which decrypt them look like this:

sub decry ($){ # base64 BTW
local($^W) = 0;
my $str = shift;my $res = "";
$str =~ tr|AZa-
z0-9+=/||cd;$str =~ s/=+$//;
$str =~ tr|A-Za-z0-9+/| -_|;
while ($str =~ /(.{1,60})/
gs) {my $len = chr(32 + length($1)*3/4);
$res .= unpack("u", $len . $1 ); }

So if you are afraid that I could put some evil shellcode inside, you can check the code like this:


Alright, so what happens when you hit 'Generate files' button?

$button->signal_connect(clicked=>sub {
$AutoRunFile = $ent->get_text;
$LogFile = $ent2->get_text;
$AdminIP = $ent3->get_text;
$MYSQLHost = $ent4->get_text;
$MYSQLLogin = $ent5->get_text;
$MYSQLPass = $ent6->get_text;
$MYSQLDatabase = $ent7->get_text;
$MYSQLTable = $ent8->get_text;
$ServerIP = $ent9->get_text;
$ServerPort = $ent10->get_text;
$ClientPort = $ent11->get_text;
$RC4Key = $ent12->get_text;
$ServerName = $ent13->get_text;
$Splitter = $ent14->get_text;

Your data is passed from each Gtk2::Entry widgets to an appropriate variable and then files are generated using data from you. As simple as 2+2. So we got 3 more files now. First, let's examine the user-side application. User Console:

P.I.C. Chat

So the first thing, it opens port and starts accepting incoming data by executing a simple function:

sub makeConnection {
$sockMain = IO::Socket::INET->new(LocalPort => $LISTEN_PORT, Proto => $proto) or
$buffEx->insert ($buffEx->get_end_iter, "sockMain: $@! \n");
Gtk2::Helper->add_watch ( fileno $sockMain, 'in',sub{
($fd,$condition,$fh) = @_;\&watch_callback($fh,$tview);},$sockMain);

I should point at a few elements here:

$buffEx->insert ($buffEx->get_end_iter, "sockMain: $@! \n");

This is responsible for logging any event, for example if there is a socket error, this function will print out in main window details about the error. The same happens with a non-error events, like successful login and such. The next element: watch_callback is responsible for processing any incoming data from the chat server and looks like this:

sub watch_callback {
my ($fh,$tview) = @_; my $msg;
int $i; $fh->recv($msg, $MAXLEN) or 
	$buffEx->insert ($buffEx->get_end_iter, "recv: $!\n");
my $buffer = $tview->get_buffer();
my $NewBuff = $NewTView2->get_buffer();
my $decRC4 = RC4( $pass, $msg );
my $decoded = rot47($decRC4);
my @words = split(/$J/, $decoded);
if($decoded eq "auth_nouser"){
$buffEx->insert ($buffEx->get_end_iter, 
	"you are not registered, please register to be able to use our chat :)\n");
}elsif($decoded eq "auth_notok") {
$buffEx->insert ($buffEx->get_end_iter, 
	"username or password incorrect, please try again!\n");
}elsif($decoded eq "auth_ok"){
$buffEx->insert ($buffEx->get_end_iter, 
	"Logged In! Please hit 'Update Users' Button to see user list ;)\n");
}elsif($decoded eq "reg_ok"){
$buffEx->insert ($buffEx->get_end_iter, 
	"Logged In and registered! Please hit 'Update Users' Button to see user
list ;)\n");
open (F5, ">>/etc/.P.I.C_DATA.txt"); print F5 cry($msg_send); close (F5);
}elsif($decoded eq "reg_notok") {
$buffEx->insert ($buffEx->get_end_iter, 
	"Account already in use! Try something different.\n");
}elsif($words[0] eq "users") {
$number_of_users = $words[1];
$buffEx->insert ($buffEx->get_end_iter, "Nr of users: $number_of_users\n");
$users_container .= $words[$i++];
$users_container .= "\n";
} @word = ($users_container =~ /(\w+)/g);
$xaxa = join "$J", @word[2..$number_of_users+2];
} elsif($words[0] eq "not_logged") {
print "not logged!\n";
$buffEx->insert ($buffEx->get_end_iter, 
	"You are not logged to the system. Please Log in.\n");
} elsif($words[0] eq "from_user") {
my $SourceUser = $words[1];
my $SourceMSG = $words[2];
my $Ready = "<$SourceUser> $SourceMSG";
}elsif($words[0] eq "banned_user") {
$buffEx->insert ($buffEx->get_end_iter, "You are banned!\n"); }else 
	{ &update_buffer($buffer,$decoded,0);
} return 1;

There are 2 main types of data, sent back from the server. Data with strategy information, like checking if you are logged, if you are not banned, are you authorized, user list and so on - this data gets formatted, split, manipulated, processed. And simple messages, which are simply transferred to update_buffer function, prints them in the main window. As you have seen, incoming data is encrypted with 2 types of algorithms: RC4 and rot47; like the outgoing too. Ok, I'm still talking about main window, but that is not the only window we got here. There is also another window.. what for, you'll probably ask. For communication only with one selected user! Functions, which send our message to all users look like this:

my $sock = IO::Socket::INET->new(Proto => $proto,PeerPort => 
	$SEND_PORT, PeerAddr => $server_host)
or $buffEx->insert ($buffEx->get_end_iter, "Creating socket: $!\n");
my $encoded0 = rot47("<$tag_send> $msg_send");
my $encRC4 = RC4( $pass, $encoded0 );
$sock->send($encRC4) or $buffEx->insert ($buffEx->get_end_iter, "send: $!\n");

Now, what is the difference between sending data to all and to only one selected? Here we go:

my $ReadyValue = substr($value, 0, -4); 
	# username, ex. john [+], where [+] means status online, we cut the last 4
#characters and got john
my $sock = IO::Socket::INET->new(Proto => $proto,PeerPort => 
	$SEND_PORT, PeerAddr => $server_host)or
$buffEx->insert ($buffEx->get_end_iter, "Creating socket: $!\n"); # socket stuff
my $encoded0 = rot47("to_user$J$ReadyValue$J$tag_send$J$msg_send"); # encryption
my $encRC4 = RC4( $pass, $encoded0 ); # and again
$sock->send($encRC4) or $buffEx->insert ($buffEx->get_end_iter, "send: $!\n"); # send!

Now, what our server does in both ways? To all users:

my $test;
my $dbh = DBI->connect("dbi:mysql:$db:$dbhost",$dbuser,$dbpass) ; # connect to mysql
my $sql_check = "select logged from $table where ip = '$remoteaddress'"; # sql query
my $sth_check = $dbh->prepare($sql_check); # prepare sql
$sth_check->execute or &SendStatus("Cannot check if user is logged!"); # execute sql
@row = $sth_check->fetchrow_array;
my $rowcheck = @row[$test]; # get data
if($rowcheck eq "true") { # if user is logged
my $dbh = DBI->connect("dbi:mysql:$db:$dbhost",$dbuser,$dbpass) ;
print "starting to send to everyone\n";
my $global_data;
my $data_int;
my $container_next;
my $int;
my $sql_fetch_ip = "select ip from $table";
my $sth_fetch_ip = $dbh->prepare($sql_fetch_ip);
$sth_fetch_ip->execute or &SendStatus("Problem while getting IPs list!");
while(@rowz = $sth_fetch_ip->fetchrow_array){
print @rowz; print "\n";
$global_data .= $rowz[$data_int];
$global_data .= "$J";
} @glob = split(/$J/, $global_data);
print @glob; print "\n";
my $sql_count_ip = "select count(*) from $table";
my $st_count_ip = $dbh->prepare($sql_count_ip);
while (@row_next = $st_count_ip->fetchrow_array){
$container_next .= $row_next[$int++];
} print "container_next: ".$container_next."\n";
my $UseIP = $glob[$data_int++];
if($UseIP == $remoteaddress) {goto nosend;}
my $sock3 = IO::Socket::INET->new(Proto => $proto, PeerPort => 
	$SEND_PORT, PeerAddr => $UseIP) ;
my $encoded0 = rot47("$decoded"); my $encRC4 = RC4( $RC4pass, $encoded0 );
$sock3->send("$encRC4") or &SendStatus ( "send $!");
print "send to: ".$UseIP."\n"; nosend: print "Sender's IP omitted\n"; }
} else {
&SendUserStatus("not_logged", $remoteaddress); print "not logged..\n";

Actually as you can see (I will not comment lines - it is too easy), the server gets all IPs from database and sends to each IP received message. Now probably you already know how this will look like in case of one user?

elsif ($words[0] eq "to_user"){
my $dbh = DBI->connect("dbi:mysql:$db:$dbhost",$dbuser,$dbpass) ;
my $UserName = $words[1]; my $DestAddr; my $test;
print "$UserName\n"; if(length($UserName) < 2){
&SendUserStatus("UserName too small!", $remoteaddress);
goto Endof;
my $sql_check = "select logged from $table where ip = '$remoteaddress'";
my $sth_check = $dbh->prepare($sql_check);
$sth_check->execute or &SendStatus ( "cant check if user ($remoteaddress) is logged");
@row = $sth_check->fetchrow_array; my $rowcheck = @row[$test];
if($rowcheck eq "true") {
my $tag_send = $words[2]; my $OrigMsg = $words[3];
my $sql_fetch_ip = "select ip from $table where name = '$UserName'";
my $sth_fetch_ip = $dbh->prepare($sql_fetch_ip);
$sth_fetch_ip->execute; my $data;
@row = $sth_fetch_ip->fetchrow_array;
$DestAddr = @row[$data];
my $sock3 = IO::Socket::INET->new(Proto => $proto, PeerPort => 
	$SEND_PORT, PeerAddr => $DestAddr) ;
my $encoded0 = rot47("from_user$J$tag_send$J$OrigMsg");
my $encRC4 = RC4( $RC4pass, $encoded0 );
$sock3->send("$encRC4") or &SendStatus ( "send $!");
print "Message sent to: $DestAddr\n";
} else {
&SendUserStatus("not_logged", $remoteaddress);
} }

And user-side application, when gets such line: from_user$J$tag_send$J$OrigMsg, will do the following:

} elsif($words[0] eq "from_user") {
my $SourceUser = $words[1];
my $SourceMSG = $words[2];
my $Ready = "<$SourceUser> $SourceMSG";

It will print a message in, so called, 'Private window'. To talk only with one selected user, we just need to select him from the user list. No double clicking, no extra windows, no useless stuff is required. There is no 'send message' button either, as I am thinking that no one actually uses them now, just type a message in message Entry and hit ENTER, that's all. That is how user-side part works, nothing special. Let's examine admin-side part now. Admin Console:

P.I.C. Chat

P.I.C. Chat

P.I.C. Chat

P.I.C. Chat

We got 4 TABs here. The first one is just like user-side proggie so there is no explanation needed. Next is logging window. Here you can see any logs: from admin console and from server. Logging system from console uses the same technique like user console, now how it's done with the server. Server has the following function:

sub SendStatus {
my($message) = @_;
my $master_sock = IO::Socket::INET->new(Proto => 
		$proto, PeerPort => $SEND_PORT, PeerAddr =>
my $encoded0 = rot47("l0g$J$message"); # $J in our case is 'splitter' - 
	':', so: 'l0g:Message'
my $encRC4 = RC4( $RC4pass, $encoded0 );

And let's see how anything is executed:

$sth->execute or &SendStatus 
	( "cannot execute mysql query while checking if user($login) exists!\n");

Server tries to execute mysql query, e.g. it checks if user exists. If everything is cool - that's cool, no need to worry. But, if there is some issue, it notifies admin about it. That's how things work. Now admin console's watch_callback function gets the message:

}elsif ($words[0] eq "l0g"){
$buffEx->insert ($buffEx->get_end_iter, $words[1]."\n");

The next picture presents how the chat administrator can see detailed statistics. A few code samples how it works. Alright, so we want to see how many users we have, who is online, who is not, who is banned, etc. We hit 'Update statistics' button and enjoy the result while script processes our command in the following way:

$mainbut->signal_connect("clicked" =>sub { # button clicked!
my $clearbuffer = $mainview->get_buffer; # clear each column
$clearbuffer->delete($clearbuffer->get_start_iter, $clearbuffer->get_end_iter); 
# actually our statistics window is
my $clearbuffer2 = $mainview2->get_buffer; 
# in the same number of columns we got in database
$clearbuffer2->delete($clearbuffer2->get_start_iter, $clearbuffer2->get_end_iter); 
# excluding first one, primary
my $clearbuffer3 = $mainview3->get_buffer; 
# it is done so to avoid the mess in the window
$clearbuffer3->delete($clearbuffer3->get_start_iter, $clearbuffer3->get_end_iter); 
# anyway it is not perfect now either
my $clearbuffer4 = $mainview4->get_buffer;
$clearbuffer4->delete($clearbuffer4->get_start_iter, $clearbuffer4->get_end_iter);
my $clearbuffer5 = $mainview5->get_buffer;
$clearbuffer5->delete($clearbuffer5->get_start_iter, $clearbuffer5->get_end_iter);
# after space has been prepared for incoming data we send the request to the server
my $sock3 = IO::Socket::INET->new(Proto => $proto, PeerPort => $SEND_PORT, PeerAddr => 
$server_host) ; #
#initialize socket
my $encoded0 = rot47("the_stats".$J."gimme"); # rot47 encryption
my $encRC4 = RC4( $pass, $encoded0 ); # RC4 encryption
$sock3->send("$encRC4"); # transmit request!

Server side:

elsif ($words[0] eq "the_stats"){ # first word of the command
if($remoteaddress eq $MASTER_IP) { # check if the request is done by admin
my $dbh = DBI->connect("dbi:mysql:$db:$dbhost",$dbuser,$dbpass) or
&SendStatus (" Detailed stats error - $DBI::errstr"); # connect to database
my $sql = "select * from $table"; # get them all!
my $sth = $dbh->prepare($sql); # prepare sql request....
$sth->execute or print "SQL Error: $DBI::errstr\n"; # execute!
while (@row = $sth->fetchrow_array) { #while getting data from DB
my $status; my $logged; my $banned; # some constants
if($row[5] eq "false"){$status = "OffLine"} elsif($row[5] eq "true")
	{$status = "OnLine"} # assign online value
if($row[4] eq "false"){$logged = "Logged OFF"} elsif($row[4] eq "true")
	{$logged = "Logged IN"} # assign logged
if($row[7] eq "false"){$banned = "Not Banned"} elsif($row[7] eq "true")
	{$banned = "Banned!"} # assign banned value
my $sock3 = IO::Socket::INET->new(Proto => $proto, PeerPort => 
	$SEND_PORT, PeerAddr => $MASTER_IP) ; #
socket init
my $encoded0 = rot47("the_stats$J".$row[1]."$J".$status."$J".$row[6]."$J".$logged.
	"$J".$banned); # encode data..
my $encRC4 = RC4( $RC4pass, $encoded0 ); # the same
$sock3->send("$encRC4") or &SendStatus ( "send $!"); 
	#send! actually sending data unless last user is fetched...[]
} } else { # if request came not from admin, notify admin about issue
&SendStatus ("Unprivileged user ($remoteaddress) tried to 
	execute admin command! ".$words[0]);
} }

Back to the source:

elsif ($words[0] eq "the_stats"){
my $buffExMain = $mainview->get_buffer(); # get buffer of every text widget / column
my $buffExMain2 = $mainview2->get_buffer();
my $buffExMain3 = $mainview3->get_buffer();
my $buffExMain4 = $mainview4->get_buffer();
my $buffExMain5 = $mainview5->get_buffer();
my $buffExMain6 = $mainview6->get_buffer();
$buffExMain->insert ($buffExMain->get_end_iter, "\t\t".$words[1]."\n"); 
	# insert appropriate value into each column...
$buffExMain2->insert ($buffExMain2->get_end_iter, "\t\t".$words[2]."\n");
$buffExMain3->insert ($buffExMain3->get_end_iter, "\t\t".$words[3]."\n");
$buffExMain4->insert ($buffExMain4->get_end_iter, "\t\t".$words[4]."\n");
$buffExMain5->insert ($buffExMain5->get_end_iter, "\t\t".$words[5]."\n");

Phew... Easy ain't it? I just love Perl language. What more to say, hope everything is clear enough so we can proceed to the next picture. Our last windows is in fact ... see this 'Select command' Label? That's right, our last windows is our command center for controlling chat server, So, there are not many commands available, we can make chat server sleep for some time, ban some user, reboot remote machine, shutdown remote machine, delete chat server from remote machine and so on. Let's see what happens when the button is pushed. But first, inside view:

my $ccbox = Gtk2::HBox->new;
my $ccframe = Gtk2::Frame->new("ARGV[1] (It can be Username): "); # that is our
my $ccentry = Gtk2::Entry->new(); # entry, where arguments are passed
my $ccframe2 = Gtk2::Frame->new("Select Command: "); # we are selecting command here
my @commands = qw/sUs_p3nd_eXecut1on b4n_thE_Imp0stEr p1c0fF re_sT4rT p0w3_R0fF dE_4Th/; 
# you can change it the way you want, i have wrote it this way to 
# make it not interfered with any other commands
$combobox = Gtk2::ComboBox->new_text;
for ($commands[0]) {
$combobox->append_text ($_."-| Sleep |- [time(minutes)] - [Reason]");} 
# appending command to combobox
for ($commands[1]) {
$combobox->append_text ($_."-| Ban |- [UserName] - [Reason]");}
for ($commands[2]) {$combobox->append_text (
	$_."-| ShutDown P.I.C. Server | - [Reason]");}
for ($commands[3]) {$combobox->append_text ($_."-| Reboot Remote Machine |- [Reason]");}
for ($commands[4]) {$combobox->append_text 
	($_."-| Shutdown Remote Machine |- [Reason]");}
for ($commands[5]) {$combobox->append_text ($_."-| Delete P.I.C server | - [Reason]");}
$combobox->set_active(0); $ccframe2->add($combobox);$ccbox->pack_start($ccframe2,1,1,1);
my $ccbox_next = Gtk2::HBox->new; # another 2 arguments entries...
my $ccframe_next = Gtk2::Frame->new("ARGV[2]: ");
my $ccentry_next = Gtk2::Entry->new();
my $ccframe_next2 = Gtk2::Frame->new("ARGV[3]: ");
my $ccentry_next2 = Gtk2::Entry->new();

... Button pressed...

my $transmition = Gtk2::Button->new_from_stock
	("[ Transmit Command to P.I.C. Server ]");
$transmition->signal_connect("clicked" =>sub {
my $username = $ccentry->get_text(); # get text from each entry widget
my $argument1 = $ccentry_next->get_text();
my $argument2 = $ccentry_next2->get_text();
$cmdone = $combobox->get_active_text; # get command from combobox
@w = split(/-/, $cmdone); #ged rid of splitter '-'
my $joincmd = $w[0].$J.$username.$J.$argument1.$J.$argument2; 
	# join command with arguments separated with our
my $sock3 = IO::Socket::INET->new(Proto => $proto, PeerPort => $SEND_PORT, 
	PeerAddr => $server_host) ;
my $encoded0 = rot47("$joincmd");
my $encRC4 = RC4( $pass, $encoded0 );
$sock3->send("$encRC4"); # Transmit!

Server side:

elsif ($words[0] eq "b4n_thE_Imp0stEr"){ 
	# if admin want to ban user ... and so on all the way down...
if($remoteaddress eq $MASTER_IP) {
my $User2Ban = $words[1];
my $Reason = $words[2];
my $dbh = DBI->connect("dbi:mysql:$db:$dbhost",$dbuser,$dbpass) or
&SendStatus ("Ban error - $DBI::errstr");
my $sql = "update $table set banned = 'true', logged = 'false', 
	online = 'false' where name = '$User2Ban'";
my $sth = $dbh->prepare($sql);
$sth->execute or &SendStatus ("Ban error - $DBI::errstr");
&NotifyAllUsers("User $User2Ban has been banned. Reason: $Reason"); 
	# send message from server to each user
} else {
&SendStatus ("Unprivileged user ($remoteaddress) 
	tried to execute admin command! ".$words[0]);
}elsif ($words[0] eq "re_sT4rT"){
if($remoteaddress eq $MASTER_IP) {
my $Reason = $words[1];
&NotifyAllUsers("Server machine is going to reboot. Reason: $Reason");
system ("reboot"); die("Rebooting Machine!\n");
} else {
&SendStatus ( "Unprivileged user ($remoteaddress) 
	tried to execute admin command! ".$words[0]);
} elsif ($words[0] eq "p0w3_R0fF"){
if($remoteaddress eq $MASTER_IP) {
my $Reason = $words[1];
&NotifyAllUsers("Server machine is going offline. Reason: $Reason");
system("poweroff"); die("Machine OFFLINE!\n");
} else {
&SendStatus ( "Unprivileged user ($remoteaddress) 
	tried to execute admin command! ".$words[0]);

etc. So, is it clear? I think it is. That is probably the most simple example of a chat system ever. I hope you will find it kind of interesting to play with, maybe you will have some of your own ideas, own functions to add. There are in fact a lot of things that could be added. The main disadvantage of this kind of chat is that it needs external IP. But, it was not my intention to create here a fully working and professional chat system anyway. If you will get some ideas about extending the project, let me know. P.S. There one more thing I haven't mentioned about. To make user and admin consoles look the way you want on you system, there is one pretty nice line to edit:

Gtk2::Rc->parse ('/usr/share/themes/Qt/gtk-2.0/gtkrc');

Just place a path to your theme there and chat will look like you want it to. :)


  • 30th April, 2009: Initial version


This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


About the Author

Software Developer ORM
Poland Poland

Comments and Discussions

-- There are no messages in this forum --