#!/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: $iaddr\n"; socket(SOCKETH, PF_INET, SOCK_STREAM, $proto) or die "$!\n"; setsockopt(SOCKETH, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die "setsockopt: $!"; 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 = ; 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"; } } } #### 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