IPDR
view release on metacpan or search on metacpan
lib/IPDR/Collection/Client.pm view on Meta::CPAN
package IPDR::Collection::Client;
use warnings;
use strict;
use IO::Select;
use IO::Socket;
use IO::Socket::SSL qw(debug3);
use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);
use Time::localtime;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval clock_gettime clock_getres );
use Math::BigInt;
$SIG{CHLD}="IGNORE";
=head1 NAME
IPDR::Collection::Client - IPDR Collection Client
=head1 VERSION
Version 0.41
=cut
our $VERSION = '0.41';
=head1 SYNOPSIS
This is a IPDR module primarily written to connect and collect data
using IPDR from a Motorola BSR6400 CMTS. Some work is still required.
It is not very pretty code, nor perhaps the best approach for some of
the code, but it does work and will hopefully save time for other people
attempting to decode the IPDR protocol (even using the specification it
is hard work).
An example configuration for Cisco is
cable metering destination 192.168.1.1 5000 192.168.1.2 4000 1 15 non-secure
The IP addresses and ports specified are those of a collector that
the CMTS will send data to. The Cisco implementation does not provide
all IPDR functionality. Setting up a secure connection is not too difficult
(this release does not support it) from a collector point of view however
the Cisco implementation for secure keys is somewhat painful.
This Cisco module opens a socket on the local server waiting for a connection
from a Cisco router.
An example configuration for Motorola BSR is
ipdr enable
ipdr collector 192.168.1.1 5000 3
ipdr collector 192.168.1.2 4000 2
The IP addresses and ports specicified are those of a collector that will
connect to the CMTS. You can have multiple collectors connected but only
the highest priority collector will receive data, all others will received
keep alives.
The Client module makes a connection to the destination IP/Port specified.
An example on how to use this module is shown below. It is relatively simple
use the different module for Cisco, all others use Client.
#!/usr/local/bin/perl
use strict;
use IPDR::Collection::Client;
lib/IPDR/Collection/Client.pm view on Meta::CPAN
}
}
$ipdrcreationtime = ctime();
$header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>";
$header .= "<IPDRDoc ";
$header .= "xmlns=\"http://www.ipdr.org/namespaces/ipdr\" ";
$header .= "xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" ";
$header .= "xsi:schemaLocation=\"DOCSIS-3.1-B.0.xsd\" ";
$header .= "docId=\"CEABBE99-0000-0000-0000-000000000000\" ";
$header .= "creationTime=\"".$ipdrcreationtime."\" ";
$header .= "IPDRRecorderInfo=\"$ipdrrecorder\" ";
$header .= "version=\"99.99\">";
$footer .= "<IPDRDoc.End count=\"".scalar( keys %{$data_pointer})."\" endTime=\"".$ipdrcreationtime."\"/>";
$footer .= "</IPDRDoc>";
$complete = $header.$xml.$footer;
return $complete;
}
sub _send_to_clear_destination
{
my ( $self ) = shift;
my ( $data ) = shift;
my ( $length_sent ) = 0;
my ( $send_size ) = 1000;
my $child;
if ( $self->{_GLOBAL}{'RemoteMulti'} )
{
# Multi remote needs to fork out the sending so it can
# do all the destinations at once otherwise it *may*
# take a while to get through any number of
# destinations set.
#
# Multiple destination is set to the follow
#
# Destination IP:Destination Port:Destination Speed,
#
# if using secure then you need to make sure the
# keys are the same for each destination host.
#
foreach my $destination ( split(/,/,$self->{_GLOBAL}{'RemoteMulti'}) )
{
if ($child=fork)
{ } elsif (defined $child)
{
my ( $remoteip, $remoteport, $remotespeed ) = (split(/:/,$destination))[0,1,2];
if ( !$remoteip || !$remoteport )
{
waitpid($child,0);
exit(0);
}
if ( !$remotespeed )
{
$remotespeed=10;
}
my $lsr;
if ( $self->{_GLOBAL}{'RemoteSecure'} )
{
$lsr = IO::Socket::SSL->new
(
PeerAddr => $remoteip,
PeerPort => $remoteport,
SSL_key_file => $self->{_GLOBAL}{'SSLKeyFile'},
ReuseAddr => 1,
Proto => 'tcp',
Timeout => 5
);
}
else
{
$lsr = IO::Socket::INET->new
(
PeerAddr => $remoteip,
PeerPort => $remoteport,
ReuseAddr => 1,
Proto => 'tcp',
Timeout => 5
);
}
# $lsr->autoflush(0);
if ( !$lsr )
{
waitpid($child,0);
exit(0);
}
my $selector = new IO::Select( $lsr );
my $timer = (1/($remotespeed/8) )*$send_size;
my $print_status = 1;
my $chunk;
while ( length($data)>0 && (my @ready = $selector->can_write ) )
{
foreach my $write ( @ready )
{
if ( $write == $lsr )
{
#print "handle is '$write'\n";
if ( length($data)<=$send_size)
{
#print "ASending '$data'\n\n\n";
$print_status = print $write $data;
$data = "";
}
else
{
$chunk = substr($data,0,$send_size);
$print_status = print $write $chunk;
#print "BSending '$chunk'\n\n\n";
$data = substr($data,$send_size,length($data)-$send_size);
}
}
}
# Timer added for remotesendspeed. Useful for management networks with limited
# speed, such as 10mb/s or even t1/e1 speeds of 1.6/2 Mbp/s
usleep($timer);
#print "Ending pass for send.\n";
}
usleep(100000);
$lsr->close();
waitpid($child,0);
exit(0);
}
}
}
else
{
if ($child=fork)
{ } elsif (defined $child)
{
my $lsr;
if ( $self->{_GLOBAL}{'RemoteSecure'} )
{
$lsr = IO::Socket::SSL->new
(
PeerAddr => $self->{_GLOBAL}{'RemoteIP'},
PeerPort => $self->{_GLOBAL}{'RemotePort'},
SSL_key_file => $self->{_GLOBAL}{'SSLKeyFile'},
ReuseAddr => 1,
Proto => 'tcp',
Timeout => 5
);
}
else
{
#print "Remote IP is '".$self->{_GLOBAL}{'RemoteIP'}."'\n";
#print "Remote Port is '".$self->{_GLOBAL}{'RemotePort'}."'\n";
$lsr = IO::Socket::INET->new
(
PeerAddr => $self->{_GLOBAL}{'RemoteIP'},
PeerPort => $self->{_GLOBAL}{'RemotePort'},
ReuseAddr => 1,
Proto => 'tcp',
Timeout => 5
);
}
if (!$lsr)
{
waitpid($child,0);
return 0;
}
# $lsr->autoflush(0);
my $selector = new IO::Select( $lsr );
my $timer = (1/($self->{_GLOBAL}{'RemoteSpeed'}/8) )*$send_size;
my $chunk;
my $print_status = 1;
while ( length($data)>0 && (my @ready = $selector->can_write ) && $print_status )
{
foreach my $write ( @ready )
{
if ( $write == $lsr )
{
#print "handle is '$write'\n";
if ( length($data)<=$send_size)
{
print "ASending '$data'\n\n\n";
$print_status = print $write $data;
# we need the last data chunk
#$padding = $data;
$data = "";
# we need the final write handle.
}
else
{
$chunk = substr($data,0,$send_size);
$print_status = print $write $chunk;
print "BSending '$chunk'\n\n\n";
$data = substr($data,$send_size,length($data)-$send_size);
}
}
}
usleep($timer);
}
# ok so why does this work ?
( run in 1.442 second using v1.01-cache-2.11-cpan-39bf76dae61 )