Heth at 15:55, 6 May 2010

2010-05-06T15:55:06Z

Heth at 15:54, 6 May 2010

2010-05-06T15:54:13Z

Heth at 15:50, 6 May 2010

2010-05-06T15:50:51Z

Heth: New page: #!/usr/bin/perl -w # 239.255.255.250:1900 use strict; use warnings; use Tk; use IO::Socket::Multicast qw(:all); use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET ...

2010-05-06T15:46:57Z

New page: <source lang=perl> #!/usr/bin/perl -w # 239.255.255.250:1900 use strict; use warnings; use Tk; use IO::Socket::Multicast qw(:all); use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET ...

New page

<source lang=perl>
#!/usr/bin/perl -w
# 239.255.255.250:1900
use strict;
use warnings;

use Tk;

use IO::Socket::Multicast qw(:all);
use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET SO_ERROR
inet_aton inet_ntoa sockaddr_in );;
use Time::HiRes qw ( time alarm sleep );

# Luk console vindue
BEGIN {
if ($^O eq 'MSWin32' ) {
require Win32::Console;
Win32::Console::Free();
}
}

## Initialise randomizer
srand;
# Main window oprettes
my $status = "Status: ";
my $packets = 0;
my $packetsSendSession = 0;
my $packetsSendTotal = 0;
my $BstartTimer;
my $packetData = ""; # Contains nonsens data for packet fill
for my $i (1..57) { $packetData=$packetData ."abcdefghijklmnopqrstuvwxyz"; }
my $packetToSend; # To contain Multicast Packet to be send
my $socket = IO::Socket::Multicast->new();
my $mw = new MainWindow();

$mw->title("Mercantec - MultiCast Sender");

##################
# Menu #
##################
my $Lstart = $mw->Label(-text => 'Send ');
my $Bstart = $mw -> Button(-text => "Start", -command =>\&Bstart,
-overrelief => 'sunken', -relief => 'raised',-padx => 20);
my $Bstop = $mw -> Button(-text => "Stop ", -command =>\&Bstop,
-overrelief => 'sunken', -relief => 'raised',
-padx => 20,-state => 'disabled');
#Status felt
my $Wstatus = $mw->Label (
-relief => 'sunken' ,
-borderwidth => 1 ,
-height => 1 ,
-width => 70 ,
-justify => 'right' ,
-anchor => 'w',
-textvariable => \$status );
my $Wpackets = $mw->Label (
-relief => 'sunken' ,
-borderwidth => 1 ,
-height => 1 ,
-width =>10 ,
-justify => 'left' ,
-textvariable => \$packets );

#Opret en menubar i objktet
my $mbar = $mw->Menu();
$mw->configure(-menu => $mbar);

#Hovedenmer i menuen
my $file = $mbar->cascade(-label=>"File", -underline=>0, -tearoff => 0);
my $help = $mbar->cascade(-label =>"Help", -underline=>0, -tearoff => 0);

## File Menu ##
$file -> command(-label =>"Status", -underline => 0,
-command => [\&saveClicked, "Status"],
-accelerator => "F3");
$file -> separator();
$file -> command(-label =>"Exit", -underline => 1,
-command => sub { exit } );

## Help ##
$help -> command(-label =>"About",
-command => [\&aboutClicked, "Open"],
-accelerator => "F9");
# Når er trykkes på F9 køres subrutinen aboutClicked()
$mw->bind ( "<F9>" , \&aboutClicked ) ;

###################
### LabelFrames ###
###################
## LFsender LabelFrame ##
my $IPadr = '226.1.2.3';
my $port = 7777;
my $ttl = 64;
my $LFsender = $mw->Labelframe(-text => 'Sender options',
-padx => 2,
-pady => 2);

#IP address
$LFsender->Label( -text => "IP Address:", -width => 20, -anchor => 'w', -pady => 3)
->grid(-row=>0,-column=>0,-sticky=>'e',-in => $LFsender);
my $EIPadr = $LFsender->Entry(-width => 15, -textvariable => \$IPadr,
-validatecommand => \&validateIPadr,
-validate => 'focusout');
$EIPadr->grid(-row=>0,-column=>1,-sticky=>'w',-in => $LFsender);
#UDP port
$LFsender->Label( -text => "UDP Port:", -width => 20, -anchor => 'w', -pady => 3)
->grid(-row=>1,-column=>0,-sticky=>'e',-in => $LFsender);
my $Eport = $LFsender->Entry(-width => 5, -textvariable => \$port,
-validatecommand => \&validatePort,
-validate => 'focusout');
$Eport->grid(-row=>1,-column=>1,-sticky=>'w',-in => $LFsender);
#TTL
$LFsender->Label( -text => "Time-To-Live (TTL):", -width => 20, -anchor => 'w', -pady => 3)
->grid(-row=>2,-column=>0,-sticky=>'e',-in => $LFsender);
my $Ettl = $LFsender->Entry(-width => 3, -textvariable => \$ttl,
-validatecommand => \&validateTTL,
-validate => 'focusout');
$Ettl->grid(-row=>2,-column=>1,-sticky=>'w',-in => $LFsender);

#######################
# LFsize LabelFrame #
#######################
my $PACKETMINIMUMSIZE = 64; # Mindste tilladte pakke
my $PACKETMAXIMUMSIZE = 1500; # Største tilladte pakke
my $sizeMin = 100;
my $sizeMax = 1000;
my $size = 500;
my $sizeSelected = 'Constant';
my $LFsize = $mw->Labelframe(-text => 'Size of packets in Bytes',
-padx => 2,
-pady => 2);
#Labelframe SizeConstant inside Labelframe LFsize
my $LFsizeConstant = $LFsize->Labelframe(-padx => 2,-pady => 2);
$LFsizeConstant->grid(-row=>0,-column=>0,-pady => '2m', -padx => '2m');

my $RBsizeConstant = $LFsizeConstant->Radiobutton(
-text => 'Constant Packet Size',
-variable => \$sizeSelected,
-value => 'Constant',
-command => \&sizeConstantSelected,-padx => 0);
$LFsizeConstant->configure(-labelwidget => $RBsizeConstant);
my $Lsize = $LFsizeConstant->Label( -text => "Constant Size:", -width => 30,
-anchor => 'w', -pady => 3)
->grid(-row=>2,-column=>0,-sticky=>'e',-in => $LFsizeConstant);
my $Esize = $LFsizeConstant->Entry(-width => 5, -textvariable => \$size,
-validatecommand => \&validateSize,
-validate => 'focusout');
$Esize->grid(-row=>2,-column=>1,-sticky=>'w',-in => $LFsizeConstant);

#Labelframe SizeRandom inside Labelframe LFsize
my $LFsizeRandom = $LFsize->Labelframe(-padx => 2,-pady => 2);
$LFsizeRandom->grid(-row=>1,-column=>0,-pady => '2m', -padx => '2m');

my $RBsize = $LFsizeRandom->Radiobutton(
-text => 'Random Packet Size',
-variable => \$sizeSelected,
-value => 'Random',
-command => \&sizeRandomSelected,-padx => 0);
$LFsizeRandom->configure(-labelwidget => $RBsize);
my $LsizeMin = $LFsizeRandom->Label( -text => "Random Size Minimum:",
-width => 30,-anchor => 'w', -pady => 3)
->grid(-row=>0,-column=>0,-sticky=>'e',-in => $LFsizeRandom);
my $EsizeMin = $LFsizeRandom->Entry(-width => 5, -textvariable => \$sizeMin,
-validatecommand => \&validateSizeMin,
-validate => 'focusout');
$EsizeMin->grid(-row=>0,-column=>1,-sticky=>'w',-in => $LFsizeRandom);

my $LsizeMax = $LFsizeRandom->Label( -text => "Random Size Maximum:",
-width => 30,-anchor => 'w', -pady => 3)
->grid(-row=>1,-column=>0,-sticky=>'e',-in => $LFsizeRandom);
my $EsizeMax = $LFsizeRandom->Entry(-width => 5, -textvariable => \$sizeMax,
-validatecommand => \&validateSizeMax,
-validate => 'focusout');
$EsizeMax->grid(-row=>1,-column=>1,-sticky=>'w',-in => $LFsizeRandom);
## Default size Constant
sizeConstantSelected();

###########################
# LFinterval LabelFrame #
###########################
my $intervalMin = 10;
my $intervalMax = 1000;
my $interval = 100;
my $intervalSelected = 'Constant';
my $LFinterval = $mw->Labelframe(-text => 'Interval between packets in Milli Seconds',
-padx => 2,
-pady => 2);

#Labelframe IntervalConstant inside Labelframe LFinterval
my $LFintervalConstant = $LFinterval->Labelframe(-padx => 2,-pady => 2);
$LFintervalConstant->grid(-row=>0,-column=>0,-pady => '2m', -padx => '2m');

my $RBintervalConstant = $LFintervalConstant->Radiobutton(
-text => 'Constant Packet Interval',
-variable => \$intervalSelected,
-value => 'Constant',
-command => \&intervalConstantSelected,-padx => 0);
$LFintervalConstant->configure(-labelwidget => $RBintervalConstant);
my $Linterval = $LFintervalConstant->Label( -text => "Constant Interval:", -width => 30,
-anchor => 'w', -pady => 3)
->grid(-row=>2,-column=>0,-sticky=>'e',-in => $LFintervalConstant);
my $Einterval = $LFintervalConstant->Entry(-width => 5, -textvariable => \$interval,
-validatecommand => \&validateInterval,
-validate => 'focusout');
$Einterval->grid(-row=>2,-column=>1,-sticky=>'w',-in => $LFintervalConstant);

#Labelframe IntervalRandom inside Labelframe LFinterval
my $LFintervalRandom = $LFinterval->Labelframe(-padx => 2,-pady => 2);
$LFintervalRandom->grid(-row=>1,-column=>0,-pady => '2m', -padx => '2m');

my $RBinterval = $LFintervalRandom->Radiobutton(
-text => 'Random Packet Interval',
-variable => \$intervalSelected,
-value => 'Random',
-command => \&intervalRandomSelected,-padx => 0);
$LFintervalRandom->configure(-labelwidget => $RBinterval);
my $LintervalMin = $LFintervalRandom->Label( -text => "Random Interval Minimum:",
-width => 30,-anchor => 'w', -pady => 3)
->grid(-row=>0,-column=>0,-sticky=>'e',-in => $LFintervalRandom);
my $EintervalMin = $LFintervalRandom->Entry(-width => 5, -textvariable => \$intervalMin,
-validatecommand => \&validateIntervalMin,
-validate => 'focusout');
$EintervalMin->grid(-row=>0,-column=>1,-sticky=>'w',-in => $LFintervalRandom);

my $LintervalMax = $LFintervalRandom->Label( -text => "Random Interval Maximum:",
-width => 30,-anchor => 'w', -pady => 3)
->grid(-row=>1,-column=>0,-sticky=>'e',-in => $LFintervalRandom);
my $EintervalMax = $LFintervalRandom->Entry(-width => 5, -textvariable => \$intervalMax,
-validatecommand => \&validateIntervalMax,
-validate => 'focusout');
$EintervalMax->grid(-row=>1,-column=>1,-sticky=>'w',-in => $LFintervalRandom);
## Default interval Constant
intervalConstantSelected();

##################
# Pack windows #
##################
$Lstart->grid(-row=>0,-column=>0,-sticky=>'e',-in => $mw);
$Bstart->grid(-row=>0,-column=>1,-sticky=>'e',-in => $mw);
$Bstop->grid(-row=>0,-column=>2,-sticky=>'e',-in => $mw);
$LFsender->grid(-row=>1,-column=>0,-sticky=>'w',-in => $mw, -padx => 25, -pady => 5);
$LFsize->grid(-row=>2,-column=>0,-sticky=>'w',-in => $mw, -padx => 25, -pady => 5);
$LFinterval->grid(-row=>3,-column=>0,-sticky=>'w',-in => $mw, -padx => 25, -pady => 5 );
$Wstatus->grid(-row=>4,-column=>0,-sticky=>"w",-in => $mw);
$Wpackets->grid(-row=>4,-column=>2,-sticky=>"e",-in => $mw);

### resize behaviour
$mw->gridRowconfigure (0,-weight => 1);
$mw->gridRowconfigure (1,-weight => 2);
$mw->gridRowconfigure (2,-weight => 3);

MainLoop;

####################
# Event Handlers #
####################
sub aboutClicked {
my ($opt) = @_;
$mw->messageBox(-message => "MultiCast Sender version 1.0\nHenrik Thomsen 2007\n\n\nheth\@mercantec.dk",
-title => "About");
}

sub intervalRandomSelected {
## Deselect Constant interval LabelFrame Widgets
$Linterval->configure(-state => 'disabled' );
$Einterval->configure(-state => 'disabled' );
## Select Random interval LabelFrame Widgets
$LintervalMin->configure(-state => 'active' );
$EintervalMin->configure(-state => 'normal' );
$LintervalMax->configure(-state => 'active' );
$EintervalMax->configure(-state => 'normal' );

}
sub intervalConstantSelected {
## Select Constant interval LabelFrame Widgets
$Linterval->configure(-state => 'active' );
$Einterval->configure(-state => 'normal' );
## Select Random interval LabelFrame Widgets
$LintervalMin->configure(-state => 'disabled' );
$EintervalMin->configure(-state => 'disabled' );
$LintervalMax->configure(-state => 'disabled' );
$EintervalMax->configure(-state => 'disabled' );

}

sub sizeRandomSelected {
## Deselect Constant size LabelFrame Widgets
$Lsize->configure(-state => 'disabled' );
$Esize->configure(-state => 'disabled' );
## Select Random size LabelFrame Widgets
$LsizeMin->configure(-state => 'active' );
$EsizeMin->configure(-state => 'normal' );
$LsizeMax->configure(-state => 'active' );
$EsizeMax->configure(-state => 'normal' );

}
sub sizeConstantSelected {
## Select Constant interval LabelFrame Widgets
$Lsize->configure(-state => 'active' );
$Esize->configure(-state => 'normal' );
## Select Random interval LabelFrame Widgets
$LsizeMin->configure(-state => 'disabled' );
$EsizeMin->configure(-state => 'disabled' );
$LsizeMax->configure(-state => 'disabled' );
$EsizeMax->configure(-state => 'disabled' );

}

sub SOL_IP { 0; };
sub IP_TOS { 1; };

sub Bstart {
$status="Multicast sending.....";
$Bstop->configure(-state=>'normal');
$Bstart->configure(-state=>'disabled');
$packetsSendSession = 1;
if ( validateSize() && validateSizeMin() && validateSizeMax() &&
validateInterval() && validateIntervalMin() && validateIntervalMax() &&
validateIPadr() && validatePort() && validateTTL()) {
$socket->mcast_ttl($ttl);
#$socket->setsockopt($socket, SOL_IP, IP_TOS(), pack("I*", 32) ) || die "setsockopt: $!\n";;
#$socket->setsockopt($socket, 0,1, pack("I*", 32) ) || die "setsockopt: $!\n";;
$socket->sockopt(1,pack("I*",32));
#->sockopt('IP_TOS' => '24');
#$socket->setsockopt(IPPROTO_UDP,'IP_TOS',32) || die "setsockopt $!\n";
#Build first packet to be send.....
my $thisPacketSize = findPacketSize() - 20 - 8 - 26;
$packetToSend = pack("iFa$thisPacketSize",$packetsSendSession,time(),$packetData);
$BstartTimer = $Bstart->after(findInterval(),\&sendPacket);
}
}

sub Bstop {
$packetsSendTotal += $packetsSendSession;
$status = "Multicast afsluttet. Der er ialt sendt $packetsSendTotal pakker.";
$Bstart->configure(-state=>'normal');
$Bstop->configure(-state=>'disabled');
if ( $Bstart->afterInfo($BstartTimer)) {
$BstartTimer->cancel();
}
}

sub sendPacket {
$packetsSendSession++;
#Send packet that was packed before. (Dont spend time building packet
#after timer trigged)
$socket->mcast_send($packetToSend,"$IPadr:$port");
# Build Packet to send. (Size - 20 bytes IP - 8 bytes UDP - 26 bytes
# for number of packet and HiRes timestamp)
# Packets contains packetnumber,HiRes time, fill data
my $thisPacketSize = findPacketSize() - 20 - 8 - 26;
$packetToSend = pack("iFa$thisPacketSize",$packetsSendSession,time(),$packetData);
$packets = "$packetsSendSession";
$BstartTimer = $Bstart->after(findInterval(),\&sendPacket);
}

# Find tidsintervallet mellem pakkerne
sub findInterval {
if ( $intervalSelected eq 'Constant' ) {
return $interval;
} else {
return int($intervalMin + ( rand() * ($intervalMax - $intervalMin) ));
}
}

sub findPacketSize {
if ( $sizeSelected eq 'Constant' ) {
return $size;
} else {

return int($sizeMin + ( rand() * ($sizeMax - $sizeMin) ));
}
}

##########################
# Validate user input #
#########################
sub validateSize {
if ( $size =~ /^\d+$/ ) {
if ( ($size < $PACKETMINIMUMSIZE ) || ( $size > $PACKETMAXIMUMSIZE ) ) {
Bstop(); # Stop sending
$Esize->configure(-background => 'red');
$status = "ERROR: Packet size should be an integer between $PACKETMINIMUMSIZE and $PACKETMAXIMUMSIZE Bytes";
return 0;
} else {
$status = '';
$Esize->configure(-background => 'white');
return 1;
}
} else {
Bstop();
$Esize->configure(-background => 'red');
$status = "ERROR: Packet size should be an integer between $PACKETMINIMUMSIZE and $PACKETMAXIMUMSIZE Bytes";
return 0;
}
}

sub validateSizeMin {
if ( $sizeMin =~ /^\d+$/ ) {
if ( $sizeMin > $sizeMax ) {
Bstop(); # Stop sending
$EsizeMin->configure(-background => 'red');
$status = "ERROR: Minimum packetsize should be less than maximum packetsize";
return 0;
}

if ( ($sizeMin < $PACKETMINIMUMSIZE ) || ( $sizeMin > $PACKETMAXIMUMSIZE ) ) {
Bstop(); # Stop sending
$EsizeMin->configure(-background => 'red');
$status = "ERROR: Minimum packet size should be an integer between $PACKETMINIMUMSIZE and $PACKETMAXIMUMSIZE Bytes";
return 0;
} else {
$status = '';
$EsizeMin->configure(-background => 'white');
return 1;
}
} else {
Bstop();
$EsizeMin->configure(-background => 'red');
$status = "ERROR: Minimum packet size should be integer an between $PACKETMINIMUMSIZE and $PACKETMAXIMUMSIZE Bytes";
return 0;
}
}

sub validateSizeMax {
if ( $sizeMax =~ /^\d+$/ ) {
if ( ($sizeMax < $PACKETMINIMUMSIZE ) || ( $sizeMax > $PACKETMAXIMUMSIZE ) ) {
Bstop(); # Stop sending
$EsizeMax->configure(-background => 'red');
$status = "ERROR: Maximum packet size should be an integer between $PACKETMINIMUMSIZE and $PACKETMAXIMUMSIZE Bytes";
return 0;
} else {
$status = '';
$EsizeMax->configure(-background => 'white');
return 1;
} if ( $sizeMax < $sizeMin ) {
Bstop(); # Stop sending
$EsizeMax->configure(-background => 'red');
$status = "FEJL: Maximum packetsize should be larger than minimum packetsize";
return 0;
}
} else {
Bstop();
$EsizeMax->configure(-background => 'red');
$status = "ERROR: Maximum packet size should be an integer between $PACKETMINIMUMSIZE and $PACKETMAXIMUMSIZE Bytes";
return 0;
}
}
sub validateInterval {
if ( $interval =~ /^\d+$/ ) {
$status = '';
return 1;
} else {
Bstop(); # Stop sending
$status = "ERROR: Packetinterval should be an integer in milliseconds";
return 0;
}
}

sub validateIntervalMin {
if ( $intervalMin =~ /^\d+$/ ) {
if ( $intervalMin > $intervalMax ) {
Bstop(); # Stop sending
$status = "ERROR: Minimum packetinterval should be less than maximum packetinterval";
return 0;
} else {
$status = '';
return 1;
}
} else {
Bstop();
$status = "ERROR: Packetinterval should be an integer in milliseconds";
return 0;
}
}

sub validateIntervalMax {
if ( $intervalMax =~ /^\d+$/ ) {
if ( $intervalMax < $intervalMin ) {
Bstop(); # Stop sending
$status = "ERROR: Maximum packetinterval should be larger than minimum packetinterval";
return 0;
} else {
$status = '';
return 1;
}
} else {
Bstop();
$status = "ERROR: Packetinterval should be an integer in milliseconds";
return 0;
}
}
sub validateIPadr {
if ( $IPadr =~ /^(\d+).(\d+).(\d+).(\d+)$/ ) {
if (($1 >= 224 ) && ($1 <= 239) && ($2 <= 255) &&
($3 <= 255) && ($4 <= 255) ) {
$status = '';
return 1;
}
}
Bstop();
$status = "ERROR: Multicast IP address should be between 224.0.0.0 and 239.255.255.255";
return 0;
}

sub validatePort {
if ( $port =~ /^\d+$/ ) {
if ( $port > 65535 || $port < 1) {
Bstop(); # Stop sending
$status = "ERROR: UDP port number should be an integer between 1 and 65535";
return 0;
} else {
$status = '';
return 1;
}
} else {
Bstop();
$status = "ERROR: UDP port number should be an integer between 1 and 65535";
return 0;
}
}
sub validateTTL {
if ( $ttl =~ /^\d+$/ ) {
if ( $ttl > 255 || $ttl < 1) {
Bstop(); # Stop sending

$status = "ERROR: Time-To-Live (TTL) should be an integer between 1 and 255";
return 0;
} else {
$status = '';
return 1;
}
} else {
Bstop();
$status = "ERROR: Time-To-Live (TTL) should be an integer between 1 and 255";
return 0;
}
}
</source>

← Older revision		Revision as of 15:55, 6 May 2010
Line 544:		Line 544:
	}		}
	</source>		</source>
		+	[[Category:Perl]]

@@ Line 1: / Line 1: @@
 <source lang=perl>
 #!/usr/bin/perl -w
-# 239.255.255.250:1900
+# Author : heth@mercantec.dk
 use strict;
 use warnings;
 use Tk;
 use IO::Socket::Multicast qw(:all);
 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET SO_ERROR

@@ Line 390: / Line 390: @@
        return 0;
      } else {
-       $status = '';
+       $status = "";
        $Esize->configure(-background => 'white');
        return 1;
@@ Line 417: / Line 417: @@
        return 0;
      } else {
-       $status = '';
+       $status = "";
        $EsizeMin->configure(-background => 'white');
        return 1;
@@ Line 437: / Line 437: @@
        return 0;
      } else {
-       $status = '';
+       $status = "";
        $EsizeMax->configure(-background => 'white');
        return 1;
@@ Line 455: / Line 455: @@
 sub validateInterval {
    if ( $interval =~ /^\d+$/ ) {
-     $status = '';
+     $status = "";
      return 1;
    } else {
@@ Line 471: / Line 471: @@
        return 0;
      } else {
-       $status = '';
+       $status = "";
        return 1;
+     }
@@ Line 488: / Line 488: @@
        return 0;
      } else {
-       $status = '';
+       $status = "";
        return 1;
+     }
@@ Line 501: / Line 501: @@
      if (($1 >= 224 ) && ($1 <= 239) && ($2 <= 255) &&
           ($3 <= 255) && ($4 <= 255) ) {
-         $status = '';
+         $status = "";
          return 1;
+     }
@@ Line 517: / Line 517: @@
        return 0;
      } else {
-       $status = '';
+       $status = "";
        return 1;
+     }
@@ Line 534: / Line 534: @@
        return 0;
      } else {
-       $status = '';
+       $status = "";
        return 1;
+     }

Perl Multicast Sender example - Revision history

Heth at 15:55, 6 May 2010

Heth at 15:54, 6 May 2010

Heth at 15:50, 6 May 2010

Heth: New page: #!/usr/bin/perl -w # 239.255.255.250:1900 use strict; use warnings; use Tk; use IO::Socket::Multicast qw(:all); use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET ...