Terminal Chat Room

Question

Summary

I have written a pair of Perl scripts that form a UDP chat room allowing users to send messages over the internet with RSA encryption, making the messages imune to MITM attacks. The scripts include a server script and a client script, and works as would be expected with the clients connecting to the server with a user specified address and port number. As many clients can connect to one server as the server can keep in one hash. Once connected, each client is given a randomly generated nickname whick can be changed later. Users can interact by simply sending plaintext messages, or they can use the built-in commands.

This program is an updated version of the one found here. Since this version I have added many updates including:

• Cleanly handle users disconnecting
• 1024-bit RSA encryption of all messages
• Various built-in commands (listed below)
• Removed redundancies and tidied up code
• Unique nicknames for all clients
• Non-fatal error handling

Usage

perl server.pl -p 1337

perl client.pl -h localhost -p 1337

Built-in commands

Once connected, a public key exchange takes place and if it is successful the server adds you and your public key to the hash of users. Once connected, you can interact by sending plain text messages, or by using some of the built-in commands. These commands include:

/users - Lists all users currently connected to the server.

/exit - Allows for clean disconnect by removing client from server-side database.

/nick [name] - Changes the current users nickname (visible to all users) to [name]

/whisper [name] [message] - Send a message so it is only visible to one user

---

server.pl

#!/usr/bin/perl
# server.pl

use strict;
use warnings;
use IO::Socket::INET;
use Getopt::Long;
use Crypt::OpenSSL::RSA;
use Try::Tiny;

sub server_log {
    print " [", scalar localtime, "] ", join(" ", @_), "\n";
}

sub main {
    my %clients;
    my %clients_by_nick;
    my $MAXLEN = 1024;
    my $PORTNO;
    my $message;
    my @nick_chars = ("A".."Z", "a".."z", 0..9);

    GetOptions("port=i" => \$PORTNO);
    die "Need port!\n" unless defined $PORTNO;
    
    server_log "Generating key pair...";
    
    my $server_keys = Crypt::OpenSSL::RSA->generate_key(1024);
    my $public_as_string = $server_keys->get_public_key_string();
        
    my $sock = IO::Socket::INET->new(
        Proto       => 'udp',
        LocalPort   => $PORTNO
    ) or die "sock: $!";
    
    server_log "Waiting for users on $PORTNO...";

    while (my $address = $sock->recv($message, $MAXLEN)) {
        my $ipaddr      = gethostbyaddr($sock->peeraddr, AF_INET);
        my $port        = $sock->peerport;
        my $cur_client  = "$ipaddr:$port"; # Each connecting user is stored as a combination of their IP and port num as to ensure identifiers are unique
        my $whisper = 0;

        if (not exists $clients{$cur_client}) {
            my $nick_taken = 0;
            do {
                $clients{$cur_client}->{nick} .= $nick_chars[rand @nick_chars] for 1..8; # Only develops scaling issues after ~360 million million users try connecting
                
                for my $client (values %clients) {
                    if($client->{nick} eq $clients{$cur_client}->{nick}) {
                        if($client ne $clients{$cur_client}) {
                            server_log "Nick '$client->{nick}' already in use...";
                            $nick_taken = 1;
                        }
                    }
                }
            } while($nick_taken);
            
            $clients_by_nick{$clients{$cur_client}->{nick}} = $cur_client;
            $clients{$cur_client}->{port}                   = $port;
            $clients{$cur_client}->{address}                = $address;
            
            try {
                $clients{$cur_client}->{pub_key} = Crypt::OpenSSL::RSA->new_public_key($message);
            } catch {
                server_log "Bad key exchange, dropping user $ipaddr:$port...";
                delete $clients_by_nick{$clients{$cur_client}->{nick}};
                delete $clients{$cur_client};
            }; # Attempt key exchange, if it fails drop the connection
            
            next unless exists $clients{$cur_client};
            
            $sock->send($public_as_string, 0, $clients{$cur_client}->{address}) or die "send: $!";
            server_log "New successful connection from $ipaddr:$port, designated $clients{$cur_client}->{nick}";
            $message = "New user: $clients{$cur_client}->{nick}";
            
            for my $client (values %clients) {
                $_ = $client->{pub_key}->encrypt($message);
                $sock->send($_, 0, $client->{address}) or die "send: $!";
            }
            
            next;
        } else {
            my $bad_message = 0;
            
            try {
                $message = $server_keys->decrypt($message);
            } catch {
                server_log "Message not encrypted with our key, dropping user $ipaddr:$port...";
                $message = $clients{$cur_client}->{pub_key}->encrypt("You have been dropped for sending a malformed message");
                $sock->send($message, 0, $clients{$cur_client}->{address}) or die "send: $!";
                delete $clients_by_nick{$clients{$cur_client}->{nick}};
                delete $clients{$cur_client};
                $bad_message = 1;
            }; # If a message cannot be decrypted with the given key, drop the user
            
            next if $bad_message;
        }
        
        # MESSAGE PROCESSING
    
        if ($message =~ /\/nick (\w+)/) { # Try and change the users nickname if it's available
            my $nick_taken = 0;
            
            for my $client (values %clients) { # Determine if the nickname is taken
                if($client->{nick} eq $1) {
                    if($client ne $clients{$cur_client}) {
                        server_log "Nick '$client->{nick}' already in use...";
                        $nick_taken = 1;
                    }
                }
            }
            
            if($nick_taken) {
                $message = "Nick change faliure for user $clients{$cur_client}->{nick}";
            } else {
                $message = "Nick change: $clients{$cur_client}->{nick} -> $1";
                delete $clients_by_nick{$clients{$cur_client}->{nick}};
                $clients{$cur_client}->{nick} = $1;
                $clients_by_nick{$clients{$cur_client}->{nick}} = $cur_client;
            }
        } elsif ($message =~ /\/users/) { # Create a message containing all users in the hash
            server_log "User list request from user:", $clients{$cur_client}->{nick};
            $message = "Current users:";
            $whisper = 1;
            
            for my $client (values %clients) {
                $message = join "", $message, "\n", $client->{nick};
            }   
        } elsif ($message =~ /\/exit/) { # Catch a disconnecting user and then drop their info
            $message = join "", "Honourable suicide from client: ", $clients{$cur_client}->{nick};
            server_log "User disconnected gracefully: ", $clients{$cur_client}->{nick};
            
            delete $clients_by_nick{$clients{$cur_client}->{nick}};
            delete $clients{$cur_client};
        } elsif ($message =~ /\/whisper (\w+) (.*)/) { # Specify that a message should only be sent to a given user
            my $valid_nick = 0;
            $whisper = 1;
            $message = join "", "Whisper from ", $clients{$cur_client}->{nick}, ": ", $2;
            
            for my $client (values %clients) {
                if($client->{nick} eq $1) {
                    $valid_nick = 1;
                    $cur_client = $clients_by_nick{$client->{nick}};
                }
            }
            
            $message = "Failed whisper attempt to unknown user \'$1\'" unless $valid_nick;
            server_log $cur_client, $clients{$cur_client}->{nick}, $message;
        } else {
            $message = join "", $clients{$cur_client}->{nick}, ": ", $message;
        }
    
        # MESSAGE SENDING
    
        if($whisper) {
            $message = $clients{$cur_client}->{pub_key}->encrypt($message);
            $sock->send($message, 0, $clients{$cur_client}->{address}) or die "send: $!";
        } else {
            server_log $cur_client, $message;
            for my $client (values %clients) {
                $_ = $client->{pub_key}->encrypt($message);
                $sock->send($_, 0, $client->{address}) or die "send: $!";
            }
        }
    }
}

main(@ARGV);

client.pl

#!/usr/bin/perl
# client.pl

use strict;
use warnings;
use IO::Socket::INET;
use Crypt::OpenSSL::RSA;
use Getopt::Long;


$SIG{INT} = $SIG{TERM} = \&terminate;

sub main {
    my ($port, $host);
    my $MAXLEN  = 1024;
    my $message;
    
    print "Generating keys...\n";
    
    my $client_keys = Crypt::OpenSSL::RSA->generate_key(1024);
    my $public_as_string = $client_keys->get_public_key_string();

    GetOptions( "port=i" => \$port,
                "host=s" => \$host);

    die "Need Port!\n" unless defined $port;
    die "Need host!\n" unless defined $host;
    
    print "Opening socket...\n";

    $main::sock = IO::Socket::INET->new(
                Proto       => 'udp',
                PeerPort    => $port,
                PeerAddr    => $host
            ) or die "sock: $!\n";
            
    print "Trying server...\n";
    
    $main::sock->send($public_as_string) or die "send: $!\n";
    $main::sock->recv($message, $MAXLEN) or die "recv: $!\n";
    $main::server_key = Crypt::OpenSSL::RSA->new_public_key($message) or &terminate("Server sent invalid key\n");
    
    print "Got server key!\n";

    $main::parent = fork();
    
    &terminate unless defined $main::parent;

    if($main::parent) { # Parent
        while(<>) {
            chomp;
            if($_ =~ /\/exit/) {
                &terminate;
            }
            $_ = $main::server_key->encrypt($_);
            $main::sock->send($_) or die "send: $!\n";
        }
    } else { # Child
        while(1) {
            $main::sock->recv($message, $MAXLEN) or die "recv: $!\n";
            $message = $client_keys->decrypt($message);
            print "$message\n";
            next;
        }
    }
}

sub terminate {
    if($main::parent) {
        $_ = $main::server_key->encrypt("/exit");
        $main::sock->send($_) or die "Server died before I did! :(\n";
        die "Terminating!\n";
    }
    print "@_\n";
    die "\n"; # Kill the child quietly. Shh...
}

main(@ARGV);

---

The code works well and is at a level I am reasonably happy with, but I feel like there is plenty of room for improvement. I have sorted all my questions in order of importance.

Concerns:

• Are there any redundancies I can remove?
• Are there any easier or better ways to achieve what I am trying to do?
• Am I using any bad Perl practices here?
• How can I make my code look less messy?

Note:

Answer 1

After a quick glance, I think there are a few things you can improve. This is by far not a complete list.

Are there any redundancies I can remove?

• There are no real redundancies that I can see, but I think the code would benefit greatly from using a bunch of subs instead of this huge main thing.

Am I using any bad Perl practices here?

• You should not explicitly use $_. Either indent the code better and just put the expression in directly, or use a different variable. I prefer this.

  $sock->send(
    $client->{pub_key}->encrypt($message), 
    0,
    $client->{address}
  ) or die "send: $!";
  

• You are also escaping / in your regular expression in this code:

  if($_ =~ /\/exit/) {
    &terminate;
  }
  

  Instead, use m// explicitly, and use a different quote delimiter. Pick one of below, or any other you like. There is also no need to mention $_ here, as it will implicitly match on $_ anyway.

  m!/!;
  m|/|;
  m{/};
  m(/);
  m m/m; # don't do that one!
  

• In the same example as above, you are using the ampersand & to call your function. That tells Perl to ignore prototypes on the sub. Since you don't have any, you don't need it. Even if you had them, you'd probably not want it either. Don't use that. You can do terminate() to make it more readable (though the parens are optional).

• You have $main::sock and others, that are neither declared with my nor our. I have not run your code, but that looks wrong. I think you want to make package variables, which would be done with our. But since there is no package defined, everything is in the main package anyway, so you don't really need $main::foo or $::foo. It's the same as $foo.

  $ perl -E '$foo=1; say $main::foo;'
  1
  

  If you add use strict; to that, it will fail.

  $ perl -wE  'use strict; $foo=1; say $main::foo;'
  Global symbol "$foo" requires explicit package name at -e line 1.
  Execution of -e aborted due to compilation errors.
  

  I am not sure why in your case it works without breaking. I believe it should break.

How can I make my code look less messy?

See above. Besides that, a dispatch table instead of the huge if/elseif/else block would be nice. Take a look at Higher Order Perl by Mark Jason Dominus, it's available as a free pdf file nowadays. There is a whole chapter about those.

Answer 2

Your code of course can be improved, here are some quick wins:

1. Order imports alphabetically, this helps readability/maintainability, exclude use warnings; and use strict; from this rule, they are pragmas.

2. Use multiple small subs instead of a single huge main sub. Long subs are hard to maintain, for instance move 'Generating keys' section to a sub with the same name; so that the code be self documented, same applies for each section which you highlighted by an extra comment

3. Define constants as read only or in a constant pragma

4. Naming of variables can be enhanced a lot, for instance $public_as_string is not a well chosen name, a better name could be '$public_key', you missed the word key, which gave the reader an impression that you mean an access modifier (because that's not possible in Perl, some developers follow bad practices by preceeding it in variables' names), and also no need to add string word, it is scalar as appearing from $ usage in the variable.

5. You have a lot of nested blocks in your code, this should be avoided, one easy solution would be to use a sub to contain your inner block, this sub should have a descriptive name about its responsibility.

6. Your horizontal width of code is very big, in old days it was preferred that the width never be more than 80 characters, nowadays which large screens, I would recommend setting its maximum between 100 and 120. This can be easily solved because most of your horizontal width is wasted in comments and breakable lines.

7. Avoid using $_ in long nested structures, this cause ambiguity in reading and maintenance, store it in a well named variable, imagine the status where the code reader is trying to check the scope to understand what $_ stands for in the the nested current scope. You should write a code that human can easily understand, not just for machines to understand.

8. die, return, next and last are very important keywords which affect the flow of the logic. It is much better to place them as first words in their statements. So instead of x or die; change it to die unless x;, this enhances the readability and the understanding of the flow without having to move the eyes to the end of line. While skimming through a code, importance of statements' portions decreases while moving horizontally and human minds are very aggressive to jump to next line.

9. You don't need to precede your subs' calls with &, for instance &terminate, that is not needed in your case, especially that you don't have signatures, and that in most cases it is better to avoid using signatures

10. Your code indentation and formatting can be improved in many places, for instance when you made the assignment of $whisper you didn't follow the same = sign placement pattern

11. Messaging processing should be separated to multiple sub, instead of having multiple if else blocks. Extra Hint: Given the small size of your application there is no need to use design patterns here, but if you notice that blocks getting more complex logic, many design patterns may be very handy to use, no need to mention them now for you, it is just a hint in case your application size increased

12. Instead of using / in regular expression (and/or matching, substituting), use a different quote delimiter other than /. Regular expression are relatively hard to read by nature, any small improvement in their readability has huge impact in their final form.

13. Always declare variables using my or our. I can see that you have some without my or our! Wondering how use strict and use warnings pragmas passed something like this for you without breaking your code !

14. It is much better to use logging dedicated modules instead of just using prints, they give you lot of out of the box features which may help you in debugging, storing, and skimming through logs by specifying the fine grain of the log for instance.