Perl gondok

lenne egy kis problema ezzel a progival. server-cliens architecturat hasznal.
vegulis csomagokat kuld egy bizonyos IP cimere/portra. az egyetlen problema vele,
hogy ha megadok egy bizonyos idot nem addig kuldi a csomagokat a megadott intervalumnak megfeleloen,
hanem egyszerre mindent. esetleg egy Perl guru ranezne? koszi

server:
#!/usr/bin/perl -w

#
# VoIP Traffic Generator - Server
# Created By: Bruno Benchimol
#
# Testado em:
# Linux - Debian 3.0 - perl v5.6.1
# FreeBSD 5.4 - perl v5.8
#
# Should work on any perl v5.x
#
# Version: v0.1b
#

use IO::Socket::INET;
use Getopt::Long;

print " >>>> VoIP Traffic Generator <<<<\n";
print " Server Mode - by Bruno Benchimol \n";

if (@ARGV < 1) {
print "Not enough parameters.\n\n";
print "Usage: --port, -p port to bind server\n";
exit(-1);
}

GetOptions("port|p=i" => \$port);

# Create a new socket
$Socket = new IO::Socket::INET->new (LocalPort=> $port,
Proto=> 'udp');
print "\nReady to accept connections on port $port...\n";

$count=0;
# never close server
while(1)
{
$Socket->recv($text,1470);
$count++;

# process summary information if status is found in msg
if($text =~ /status/)
{
($text, $packets) = split (/,/, $text);
# discard last packet since its a "summary packet" (small data)
$count--;
print "Packets expected: $packets\n";
print "Packets Received: $count\n";
$packetloss = ($packets - $count);
$packetlossperc = ($packetloss / $packets) * 100;
print "Packet Loss: $packetloss ($packetlossperc%)\n";
# reset packet counter
$count=0;
}
}

client:
#!/usr/bin/perl -w

# VoIP Traffic Generator - Client

# Created By: Bruno Benchimol

#

# Testado em:

# Linux - Debian 3.0 - perl v5.6.1

# FreeBSD 5.4 - perl v5.8

#

# Should work on any perl v5.x

#

# Version: v0.1b

use Time::HiRes qw(usleep ualarm gettimeofday);

use IO::Socket::INET;

use Getopt::Long;

print " >>>> VoIP Traffic Generator <<<<\n";

print " Client Mode - by Bruno Benchimol \n";

sub QueryStatistics

{

# Create a new socket

$Socket=new IO::Socket::INET->new (PeerPort=>$port,

Proto=>'udp',

PeerAddr=>$peer)

or die "Couldnt connect to host $peer on port $port using udp\n";

$smsg="status,$_[0]";

if(!$Socket->send($smsg))

{

print "Socket failed to send data !!!\n";

}

}

# Send 1 second burst!

sub SendBurst

{

# Create a new socket

$Socket=new IO::Socket::INET->new (PeerPort=>$port,

Proto=>'udp',

PeerAddr=>$peer)

or die "Couldnt connect to host $peer on port $port using udp\n";

$count_duration=0;

$duration = $_[0];

$count=0;

$pps=$_[1];

# calculte inter-packet time (in microseconds)

$sleep_time = (1/$pps)*100;

while($count_duration < $duration)

{

# reset inner counter so it will run again

$count = 0;

while($count < $pps)

{

if(!$Socket->send($msg))

{

print "Socket failed to send data !!!\n";

}

$count++;

# microseconds sleep time

Time::HiRes::usleep($sleep_time);

}

$count_duration++;

}

}

sub usage

{

print <

--size, -s payload size of udp packet (bytes)

--pps, -k packets per second

--time, -t time of the duration of test (seconds)

--streams, -m number of parallel connections (streams)

--port, -p port to connect

--host, -h ip to connect

END

}

## >>>>>> Main Program <<<<<

if (@ARGV < 6)

{

print "\nNot enough arguments.\n";

usage();

exit(-1);

}

# parameters

GetOptions ("size|s=i" => \$udp_payload_size,

"pps|k=i" => \$packet_per_second,

"time|t=i" => \$duration_test,

"streams|m=i" => \$maxfork,

"port|p=i" => \$port,

"host|h=s" => \$peer);

print "\nConnecting to $peer on $port, crafting UDP packets with payload of $udp_payload_size bytes, sending $packet_per_second packets per second, test will run for $duration_test seconds and has $maxfork streams. \n\n";

# udp payload size in bytes

$msg = "";

for ($i=0 ; $i < $udp_payload_size; $i++) {

$msg .= ".";

}

# expected number of packets to send

$totalpackets = $packet_per_second * $duration_test * $maxfork;

$ifork=0;

print "Spawning childrens processes ...\n";

while ($ifork < $maxfork)

{

if (fork) {

# parent do almost nothing

$ifork++;

} else {

# child send burst

&SendBurst($duration_test, $packet_per_second);

exit(0);

}

}

print "Waiting on childrens to finish ...\n";

print "Total Packets expected to be sent: " . $totalpackets;

# wait childrens to finish

wait();

print "\nTraffic Sent, now making server dump statistics on screen, wait...\n";

sleep(1);

&QueryStatistics($totalpackets);

print "Done, Check Server Screen.\n";

exit(0);