IPDR

 view release on metacpan or  search on metacpan

lib/IPDR/Collection/CiscoSSL.pm  view on Meta::CPAN

package IPDR::Collection::CiscoSSL;

use warnings;
use strict;
use IO::Select;
use IO::Socket;
#use IO::Socket::SSL qw(debug3);
use IO::Socket::SSL;
use POSIX;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval clock_gettime clock_getres );

$SIG{CHLD}="IGNORE";

=head1 NAME

IPDR::Collection::CiscoSSL - IPDR Collection Client (Cisco Specification)

=head1 VERSION

Version 0.40

=cut

our $VERSION = '0.40';

=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 secure

    crypto ca trustpoint IPDR
      enrollment terminal 
      crl optional
      exit
    crypto ca authenticate IPDR
    <cut and paste your certficate key when promtped>
    quit

To generate a key pair (self signed cert and host key) use the following
openssl command

    openssl req -x509 -days 365 -newkey rsa:1024 -keyout hostkey.pem \
           -nodes -out hostcert.pem

You will be prompted to enter some information. If you wish you can just
leave them all blank (or default entries). Two files will be created
hostkey.pem and hostcert.pem, use these for the variables SSLKeyFile and
SSLCertFile respectively.

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. 

An example on how to use this module is shown below. It is relatively simple
use the different module for Cisco and CiscoSSL, all others use Client.

    #!/usr/local/bin/perl

    use strict;

lib/IPDR/Collection/CiscoSSL.pm  view on Meta::CPAN

				# remote sending needs to go here.
				if ( $self->{_GLOBAL}{'RemoteIP'} && $self->{_GLOBAL}{'RemotePort'} )
					{
					$self->_send_to_clear_destination(${$handles}{$handle}{'data'});
					}
				#

				waitpid($child,0);
				exit(0);
				}
			if ( ${$handles}{$handle}{'addr'} )
				{
				if ( $self->{_GLOBAL}{'complete_decoded_data'}{ ${$handles}{$handle}{'addr'} } )
					{ undef $self->{_GLOBAL}{'complete_decoded_data'}{ ${$handles}{$handle}{'addr'} }; }
				}
			delete ${$handles}{$handle};
			$self->{_GLOBAL}{'Selector'}->remove($handle);
			$handle->close();
			}
	
			if ( $link  )
				{
				${$handles}{$handle}{'data'}.=$dataset;
				${$handles}{$handle}{'addr'}=$handle->peerhost() if !${$handles}{$handle}{'addr'};
				${$handles}{$handle}{'port'}=$handle->peerport() if !${$handles}{$handle}{'port'};
				}
		}
	}
return 1;
}

sub ReturnPollTime
{
my ( $self ) = shift;
return $self->{_GLOBAL}{'PollTime'};
}

sub return_error
{
my ( $self ) = shift;
return $self->{_GLOBAL}{'ERROR'};
}

sub return_status
{
my ( $self ) = shift;
return $self->{_GLOBAL}{'STATUS'};
}

sub connect
{
my ( $self ) = shift;

if ( !$self->test_64_bit() && $self->{_GLOBAL}{'Force32BitMode'}==0 )
        {
	# if you forgot to run make test, this will clobber
	# your run anyway.
	die '64Bit support not available must stop.';
	}

my $lsn = IO::Socket::SSL->new
                        (
			SSL_key_file => $self->{_GLOBAL}{'SSLKeyFile'},
			SSL_cert_file => $self->{_GLOBAL}{'SSLCertFile'},
			Listen	  => 1024,
			LocalAddr => $self->{_GLOBAL}{'ServerIP'},
			LocalPort => $self->{_GLOBAL}{'ServerPort'},			
                        ReuseAddr => 1,
                        Proto     => 'tcp',
                        Timeout    => $self->{_GLOBAL}{'Timeout'}
                        );
if (!$lsn)
        {
        $self->{_GLOBAL}{'STATUS'}="Failed to bind to address '".$self->{_GLOBAL}{'ServerIP'}."' ";;
	$self->{_GLOBAL}{'STATUS'}.="and port '".$self->{_GLOBAL}{'ServerPort'};
        $self->{_GLOBAL}{'ERROR'}=$!;
        return 0;
        }

$self->{_GLOBAL}{'Handle'} = $lsn;
$self->{_GLOBAL}{'Selector'}=new IO::Select( $lsn );
$self->{_GLOBAL}{'STATUS'}="Success Connected";
return 1;
}

sub check_data_available
{
my ( $self ) = shift;

while ( $self->check_data_handles )
        { $self->get_data_segment(); }

$self->{_GLOBAL}{'STATUS'}="Socket Closed";
$self->{_GLOBAL}{'ERROR'}="Socket Closed";
}


sub check_data_handles
{
my ( $self ) = shift;
my ( @handle ) = $self->{_GLOBAL}{'Selector'}->can_read;
$self->{_GLOBAL}{'ready_handles'}=\@handle;
}

sub send_connection_header
{
my ( $self ) = shift;
my ( $handle ) = shift;
if ( !$handle ) { return 1; }
my ( $header ) = $self->{_GLOBAL}{'VendorID'};
if ( $self->{_GLOBAL}{'DEBUG'}>0 )
	{ $header.=" Debug Level ".$self->{_GLOBAL}{'DEBUG'}; }
$header.="\n";
syswrite($handle,$header,length($header));
return 1;
}

sub _process_docsis
{
my ( $self ) = shift;
my ( $host_ip ) = shift;

lib/IPDR/Collection/CiscoSSL.pm  view on Meta::CPAN

#                my ( $parent, $test ) = (split(/-/,$attribute))[0,1];
#			#next if $parent=~/direction/i;
#		next unless $inner_keys{ ${$template_data}{$version}{$attribute} };
#                        if ( $parent=~/^all/ )
#                                { $result{$subscriber}{ $test }=
#					$inner_keys{ ${$template_data}{$version}{$attribute} }; }
#                                else
#                                { $result{$subscriber}{$direction}{ $test }= 
#					$inner_keys{ ${$template_data}{$version}{$attribute} }; }
#                }


	$entry_count++;
        }

return %result;
}

sub _send_to_clear_destination
{
my ( $self ) = shift;
my ( $data ) = shift;
my ( $length_sent ) = 0;
my ( $send_size ) = 1000;

#RemoteSecure
#RemoteMulti
#print "Sending data is \n\n$data\n\n";

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.
	#
	my $child;
	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
							);
					}
				if ( !$lsr )
					{
					waitpid($child,0);
					exit(0);
					}
				$lsr->autoflush(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
	{
	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
		{
		$lsr = IO::Socket::INET->new
			(
			PeerAddr => $self->{_GLOBAL}{'RemoteIP'},
			PeerPort => $self->{_GLOBAL}{'RemotePort'},
			ReuseAddr => 1,
			Proto     => 'tcp',
			Timeout    => 5
			);
		}
	if (!$lsr)
		{
		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 ) )
		{
		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);
						}
					}
				}
		usleep($timer);
		}
	usleep(100000);
	$lsr->close();
	}

return 1;
}



( run in 1.060 second using v1.01-cache-2.11-cpan-39bf76dae61 )