Difference between revisions of "Perl Multicast Sender example"

#!/usr/bin/perl -w
# Author : heth@mercantec.dk
# Method : Quick and dirty - no responsibility whatsoever by author   
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;
  }
}