#!/usr/bin/perl
require 5.002;
use Socket;
use strict;
use Carp;
if ($ARGV[0] eq "--debug") {
  print "Warnings are enabled.\n";
  use warnings;
}
$| = 1;
 
my ($hostname,$port,$iaddr,$paddr,$proto,$line,$name);
 
$hostname= 'localhost';
$port = 2424;
$proto = getprotobyname('tcp');
 
$iaddr = inet_aton($hostname) or die "no host: $hostname\n";
$paddr = sockaddr_in($port, $iaddr) or die "port: $port - iaddr: $iadd
+r\n";

socket(SOCKETH, PF_INET, SOCK_STREAM, $proto) or die "$!\n";
setsockopt(SOCKETH, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die "se
+tsockopt: $!";
bind(SOCKETH, sockaddr_in($port, INADDR_ANY)) or die "bind: $!";
listen(SOCKETH, SOMAXCONN) or die "listen: $!";
 
print "Mercedes Server Open on port $port\n\n";
 
for ( ; $paddr = accept(Client,SOCKETH); close Client) {
        my($port,$iaddr) = sockaddr_in($paddr);
        $name = gethostbyaddr($iaddr,AF_INET);
 
        &spawn;
}
 
sub spawn {
        my $coderef = shift;
        my $pid;
 
        if (!defined($pid = fork)) {
                print "Cannot fork: $!";
                return;
        } elsif ($pid) {
                return;
        }
 
        open(STDIN, "<&Client") or die "can't dup client to stdin";
        open(STDOUT, ">&Client") or die "can't dup client to stdout";
################################################################
##### Per Connection Code #########

print "The Mercedes Project - 0.0.1 Pre-Alpha\n";
print "Copyright 2004 - Dan Casey\n\n";
 
while (1) {
        my ($clientreq);
        print ">";
        $clientreq = <STDIN>;
        chomp $clientreq;
 
        if (valid_req($clientreq) == 0) {
                print "OK\n";
        }else{
                print "Will not execute $clientreq\n";
        }
}
################################################################
}
 
 
 
 
sub valid_req() {
my (@valid_commands,@command);
 
@valid_commands = ("login","bye");
@command = (@_);
 
print "validating request for $command[0]\n";
 
        for (my $i=0;$i<@valid_commands;$i++) {
                if ($command[0] eq $valid_commands[$i]) {
                        print "$command[0] is a valid command\n";
                }else{
                        print "$command[0] is NOT $valid_commands[$i]\
+n";
                }
        }
 
}
[download]

#############################################
The output::
############

telnet 192.168.3.222 2424
Trying 192.168.3.222...
Connected to 192.168.3.222.
Escape character is '^]'.
The Mercedes Project - 0.0.1 Pre-Alpha
Copyright 2004 - Dan Casey
 
>sdf
validating request for sdf
 is NOT login
 is NOT bye
OK
[download]