package COPS::Client; use warnings; use strict; use IO::Select; use IO::Socket; use IO::Handle; =head1 NAME COPS::Client - COPS Protocol - Packet Cable Client =head1 VERSION Version 0.04 =cut our $VERSION = '0.04'; =head1 SYNOPSIS This module provides a simple COPS client for managing Packet Cable Multi Media sessions for CMTS. It should provide all the neccessary functionality to enable a service provider to deploy, manage and control service flows within their network. This does not maintain a connection to the CMTS but issue the configured command, get the response and then close the TCP connection. I am working on a stateful Client however this is not yet available. As basic initial use of the module is as follows my $cops_client = new COPS::Client ( [ ServerIP => '192.168.0.1', ServerPort => '3918', Timeout => 2, DataHandler => \&display_data ] ); $cops_client->set_command("set"); $cops_client->subscriber_set("ipv4","172.20.1.1"); $cops_client->gate_specification_add( [ Direction => 'Downstream', DSCPToSMark => 0, Priority => 0, PreEmption => 0, Gate_Flags => 0, Gate_TOSField => 0, Gate_TOSMask => 0, Gate_Class => 0, Gate_T1 => 0, Gate_T2 => 0, Gate_T3 => 0, Gate_T4 => 0 ] ); $cops_client->classifier_add( [ Classifier_Type => 'Classifier', Classifier_Priority => 64, Classifier_SourceIP => "172.20.1.1", ] ); $cops_client->envelope_add ( [ Envelope_Type => "authorize,reserve,commit", Service_Type => 'DOCSIS Service Class Name', ServiceClassName => 'S_down' ] ); $cops_client->connect(); $cops_client->check_data_available(); This will connect to a CMTS on IP 192.168.0.1 and apply a PCMM gate to the subscriber with IP address 172.20.1.1 and apply the service class S_down. It should be noted not all CMTS support all the functions available, so if the COPS request is failing for you remove opaque_set, timebase_set or volume_set and try again. You may also get a very cryptic error if an envelope or classifier is incorrectly configured. =head1 EXPORT There are no exports. =head1 FUNCTIONS new set_command subscriber_set gate_specification_add classifier_add envelope_add rks_set decode_radius_attribute volume_set timebase_set opaque_set =head2 new The new function initialises the module and sets the CMTS IP, Port and the data handling function which gets called if a RTP message is received. The parameters are ServerIP - The IP address of the CMTS to connect to ServerPort - The port that the Packet Cable service is running on. There is no default value however most server implementations use port 3918, so this should be set to that Timeout - This is a timeout parameter for the connection to the CMTS. It has a default of 5 so can be omitted. DataHandler - This should be set to point to a local function to handle any data returned by a COPS message sent. The function will accept 2 variables as input the first is the module point, the second is a point to a hash containing any data returned. An example of use would be. my $cops_client = new COPS::Client ( [ ServerIP => '192.168.0.1', ServerPort => '3918', Timeout => 2, DataHandler => \&display_data ] ); sub display_data { my ( $self ) = shift; my ( $data ) = shift; print "Report Datagram sent.\n\n"; foreach my $name ( sort { $a cmp $b } keys %{$data} ) { print "Attribute Name is '$name' value is '${$data}{$name}'\n"; } } =head2 set_command This command sets the type of command to be sent in the connection. It can be one of 4 types as follows set - Meaning GateSet delete - Meaning GateDelete info - Meaning GateInfo synch - Meaning Synch Request An example of use is $cops_client->set_command ( "set" ); The command specified must match *Exactly* otherwise it will be ignored. It appears Cisco CMTS do NOT respond to Synch requests. Cisco have been asked to respond to this query but no information has been forthcoming. =head2 subscriber_set This function sets the subscriber ID to be used. The subcriber ID can be either an IPV4 or IPV6 address. If you use an IPV6 address it *MUST* be fully qualified. The function takes two parameters the first specifies which IPVx to use, the second is the IPVx value. An example of use is $cops_client->subscriber_set("ipv4","172.20.1.1"); The subscriber ID is required for 99% of all COPS messages. =head2 gate_specification_add This function builds a gate with the attributes specified. Possible attributes are Direction - This can be 'Upstream' or 'Downstream' only. If specified this overrides Gate_Flags as direction is one bit of the Gate_Flags parameter. Priority - This is a value of 0 to 7. If specified this overrides Gate_Class as Priority is 3 bits of that parameter. PreEmption - This has a value of 0 or 1. This allows this gate to take bandwidth from any other gates already set against this subscriber. If specified this overrides Gate_Class as this is 1 bit of that parameter. DSCPToSMark - This has a value of 0 or 1 Priority - This has a value between 0 and 255 and should determine the priority of the gate. Gate_Flags - This field is broken down into 2 used bits and 6 unused bits. Bit 0 - Direction. 0 is Downstream 1 is Upstream If you use the Direction parameter this is set for you. Bit 1 - DSCP/TOS Field 0 is enable 1 is overwrite GateTOSField - IP TOS and Precedence value. GateTOSMask - IP TOS Mask settings GateClass - This field is broken down into 8 bits as follows Bit 0-2 - Priority of 0-7 Bit 3 - PreEmption bit Bit 4-7 - Configurable but should default 0 Gate_T1 - Gate T1 timer Gate_T2 - Gate T2 timer Gate_T3 - Gate T3 timer Gate_T4 - Gate T4 timer An example of use would be $cops_client->gate_specification_add( [ Direction => 'Downstream', DSCPToSMark => 0, Priority => 0, PreEmption => 0, Gate_Flags => 0, Gate_TOSField => 0, Gate_TOSMask => 0, Gate_Class => 0, Gate_T1 => 0, Gate_T2 => 0, Gate_T3 => 0, Gate_T4 => 0 ] ); =head2 classifier_add This function adds a classifier to the COPS request being sent and supports normal and extended classifiers. The function requires two types of parameters depending on the type of classifier specified. To specify the correct classifier the attribute Classifier_Type can be used as follows Classifier_Type - This should be 'Classifier' or 'Extended' Classifier_Type 'Classifier' attributes are as follows Classifier_IPProtocolId - This is a standard IP protocol number. You can set this to 0 or omit this and a default of 0 will be used. Classifier_TOSField - The TOSField of the IP packets to match. You can set this to 0 or omit this and a default of 0 will be used. Classifier_TOSMask - The TOSMask of the IP packets to match. you can set this to 0 or omit this and a default of 0 will be used. Classifier_SourceIP - This should be set to the source IP address of the associated flow. If you have a device attached to the cable modem such as a PC, then you should use the IP of that device, not that of the cable modem. Classifier_DestinationIP - This is the destination IP of the flow. It can be a wildcard of 0. If you omit this then a default 0 will be used. Classifier_SourcePort - The source port of the flow. If you omit this then a default of 0 will be used. Classifier_DestinationPort - This is the destination port of the flow. If you omit this then a default if 0 will be used. Classifier_Priority - The priority of this Classifier. If you have multiple Classifiers then this determines the order they are checked. An example of use would be $cops_client->classifier_add( [ Classifier_Type => 'Classifier', Classifier_Priority => 64, Classifier_SourceIP => "172.20.1.1", ] ); This sets up a Standard classifier with a priority of 64, Source IP of 172.20.1.1,any port and a wildcard destination address any port. Classifier_Type 'Extended' attributes are as follows EClassifier_IPProtocolId - This is a standard IP protocol number. You can set this to 0 or omit this and a default of 0 will be used. EClassifier_TOSField - The TOSField of the IP packets to match. You can set this to 0 or omit this and a default of 0 will be used. EClassifier_TOSMask - The TOSMask of the IP packets to match. you can set this to 0 or omit this and a default of 0 will be used. EClassifier_SourceIP - This should be set to the source IP address of the associated flow. If you have a device attached to the cable modem such as a PC, then you should use the IP of that device, not that of the cable modem. With an extended classifier you can also specify a network address. EClassifier_SourceMask - This is the associated netmask for the SourceIP specified. EClassifier_DestinationIP - This is the destination IP of the flow. It can be a wildcard of 0. If you omit this then a default 0 will be used. With an extended classifier you can also specify a network address. EClassifier_DestinationMask - This is the associated netmask for the DestinationIP specified. EClassifier_SourcePortStart - The start source port of the flow. If you omit this then a default of 0 will be used. EClassifier_SourcePortEnd - The end source port of the flow. If both the start and end ports are 0 then all ports are matched. EClassifier_DestinationPortStart - The start destination port of the flow. If you omit this then a default of 0 will be used. EClassifier_DestinationPortEnd - The end destination port of the flow. If both the start and end ports are 0 then all ports are matched. EClassifier_ClassifierID - An extended classifier must have numerical ID and it should unique per classifier per gate. It can range from 1 to 65535 (16bit) EClassifier_Priority - The priority of this Classifier. If you have multiple Classifiers then this determines the order they are checked. EClassifier_State - This determines if this classifier is Inactive or Active, values 0 and 1 respectively. EClassifier_Action - This has 4 possible values 0 - Means Add - This is the default if not specified. 1 - Replace 2 - Delete 3 - No Change An example of use would be $cops_client->classifier_add( [ Classifier_Type => 'Extended', EClassifier_Priority => 64, EClassifier_SourceIP => "172.20.1.1", EClassifier_ClassifierID => 100, EClassifier_State => 1 ] ); This sets up an Extended classifier with a priority of 64, Source IP of 172.20.1.1,any port and a wildcard destination address any port. The ID is set to 100 and it is set to State 1 which is Active. =head2 envelope_add This function adds the correct envelope type to the gate. All the possible parameters can not be detailed here as it would this man page *VERY* long. I may add them in the future. The Attributes that are *ALWAYS* required at Envelope_Type - This specifies the type of request and is managed by three bits (LSB first), lowest value 1 highest value 7 0 - Authorize - Value 1 1 - Reserve - Value 2 2 - Commit - Value 4 This is a string and should be one/more of the following authorize reserve commit Service_Type - This determines the type of service that the gate will apply. By specifying the Service_Type and Envelope_Type this determines the additional parameters required. The following values are valid for Service_Type Flow Spec DOCSIS Service Class Name Best Effort Service Non-Real-Time Polling Service Real-Time Polling Service Unsolicited Grant Service Unsolicited Grant Service with Activity Detection Downstream There is an example of each one in the examples directory examples/profiles/ An example of use would be $cops_client->envelope_add ( [ Envelope_Type => "authorize reserve commit", Service_Type => 'DOCSIS Service Class Name', ServiceClassName => 'S_down' ] ); This sets up the Envelope to be authorized, reserved and committed. It contains a Service Class Name (this should be configured on the CMTS already) and it has been named as S_down. If the specified ServiceClassName is incorrect or does not correspond to the direction specified an error will be returned. =head2 rks_set This function add a Reporting server to the COPS request. You can have a primary and secondary Reporting server and events, such as volume quota reached, time reached should be report to the Reporting server configured. All Reporting server messages are via the RADIUS protocol. This rks_set only supports IPV4 addressing. As part of a RKS request you can also specify unique indentifiers that will be sent in the Reporting request for each specific gate created. The Gate ID is not sent in the reporting request so some external management system will need to track these. The variables you can set in an RKS configuration are as follows PRKS_IPAddress - This is the PRIMARY (PRKS) reporting server IP address. It should be specified as an IP, hostnames are not supported and only IPV4 is available. PRKS_Port - This is the Port that reporting messages are sent to. The protocol used is RADIUS so the standard 1813 port should be used if a default RADIUS server configuration is to be used. PRKS_Flags - Ignore, further work is required, however if you understand this usage it is available to be set. SRKS_IPAddress - This is the SECONDARY (SRKS) reporting server IP address. This is ONLY used if the primary is considered down. It should be specified as an IP, hostnames are not supported and only IPV4 is available. SRKS_Port - This is the Port that reporting messages are sent to for the SECONDARY reporting server. SRKS_Flags - Ignore, further work is required, however if you understand this usage it is available to be set. Billing Correlation Identification BCID_TimeStamp - This is a 32bit number and EPOCH is a good use here. BCID_ElementID - This is an eight (8) character entry and should be alphanumeric only to be supported by all vendors. BCID_TimeZone - This is an eight(8) character entry and specifies the timezone of the entry. BCID_EventCounter - This is a 32bit number and can be anything within that range. This could be an auto-increment in a table, so allowing GateID to be linked back later. An example of use would be my $timer=time(); $cops_client->rks_set ( [ PRKS_IPAddress => '192.168.50.2', PRKS_Port => 2000, PRKS_Flags => 0, SRKS_IPAddress => 0, SRKS_Port => 0, SRKS_Flags => 0, BCID_TimeStamp => $timer, BCID_ElementID => '99999999', BCID_TimeZone => '00000000', BCID_EventCounter => 12347890 ] ); You can omit fields which are not used and they will default to 0, but for completeness are included above. =head2 decode_radius_attribute This function takes the output from FreeRadius 2.1.9 and expands it where possible. The supported attributes are CableLabs-Event-Message CableLabs-QoS-Descriptor When called this function returns the converted attribute into a hash of the attributes found and decoded. An example of use would be my %return_data; $cops_client->decode_radius_attribute("CableLabs-Event-Message", " 0x00034c163b873939393939393939303030303030303000bc69f2000700022020203232323200312b3030303030300000002b32303130303631343135313233382e3032330000000080000400", \%return_data); Note the 0x is required at the beginning so validity checking will pass. The %return_data has should then contain the following keys with values. EventMessageVersionID - 3 TimeZone - 1+000000 Status - 0 AttributeCount - 4 SequenceNumber - 43 BCID_TimeZone - 00000000 EventObject - 0 ElementType - 2 EventMessageType - 7 BCID_Timestamp - 1276525447 BCID_ElementID - 99999999 BCID_EventCounter - 12347890 EventMessageTypeName - QoS_Reserve Priority - 128 ElementID - ' 2222' EventTime - 20100614151238.023 =head2 volume_set This functions adds a volume limit to the gate being sent. You should be aware the CMTS may not stop traffic flowing through the gate when the limit is reached, implementation dependent, however should send a RKS notification. The only attribute for this function is VolumeLimit - This is a 64bit number and is the number of bytes allowed through the gate. An example of use would be $cops_client->volume_set( [ VolumeLimit => 3000000000 ] ); This would set the volume to 3Gigabytes. =head2 timebase_set This function add a time limit to the gate being sent. You should be aware the CMTS may not stop traffifc flowing through the gate when the limit is reached, implementation dependent, however should sent a RKS notification. The only attribute for this function is TimeLimit - This is a 32bit number and is the number of seconds the gate should remain active. An example of use would be $cops_client->timebase_set( [ TimeLimit => 60 ] ); This would set the time limit to 60 seconds. =head2 opaque_set This function allows you to add arbitary data to the COPS message sent which *may* be recorded against the gate by the remote CMTS. The only attribute for this function is OpaqueData - This be any data, although keeping it to something humanly readable is probably a good idea. An example of use would be $cops_client->opaque_set( [ OpaqueData => 'a test string' ] ); This would add 'a test string' as Opaque data to the gate. =head2 Summary This is very much a 'work in progress'. =cut sub new { my $self = {}; bless $self; my ( $class , $attr ) =@_; my ( %template ); my ( %current_data ); my ( %complete_decoded_data ); my ( %handles ); $self->{_GLOBAL}{'DEBUG'}=0; while (my($field, $val) = splice(@{$attr}, 0, 2)) { $self->{_GLOBAL}{$field}=$val; } $self->{_GLOBAL}{'STATUS'}="OK"; if ( !$self->{_GLOBAL}{'VendorID'} ) { $self->{_GLOBAL}{'VendorID'}="Generic Client"; } if ( !$self->{_GLOBAL}{'ServerIP'} ) { die "ServerIP Required"; } if ( !$self->{_GLOBAL}{'ServerPort'} ) { die "ServerPort Required"; } if ( !$self->{_GLOBAL}{'KeepAlive'} ) { $self->{_GLOBAL}{'KeepAlive'}=60; } if ( !$self->{_GLOBAL}{'Timeout'} ) { $self->{_GLOBAL}{'Timeout'}=5; } if ( !$self->{_GLOBAL}{'ListenIP'} ) { $self->{_GLOBAL}{'ListenIP'}=""; } if ( !$self->{_GLOBAL}{'ListenPort'} ) { $self->{_GLOBAL}{'ListenPort'}=""; } if ( !$self->{_GLOBAL}{'ListenServer'} ) { $self->{_GLOBAL}{'ListenServer'}=0; } if ( !$self->{_GLOBAL}{'RemotePassword'} ) { $self->{_GLOBAL}{'RemotePassword'}=""; } if ( !$self->{_GLOBAL}{'RemoteSpeed'} ) { $self->{_GLOBAL}{'RemoteSpeed'}=10; } if ( !$self->{_GLOBAL}{'TMPDirectory'} ) { $self->{_GLOBAL}{'TMPDirectory'}="/tmp/"; } $self->{_GLOBAL}{'data_ack'}=0; $self->{_GLOBAL}{'TRANSACTION_COUNT'}=1; $self->{_GLOBAL}{'ERROR'}="" ; $self->{_GLOBAL}{'data_processing'}=0; $self->{_GLOBAL}{'current_command'}=""; $self->{_GLOBAL}{'Classifier_Encoded'}=""; $self->{_GLOBAL}{'Envelope_Encoded'}=""; $self->{_GLOBAL}{'TimeLimit'}=""; $self->{_GLOBAL}{'VolumeLimit'}=""; $self->{_GLOBAL}{'OpaqueData'}=""; $self->{_GLOBAL}{'RKS_Encoded'}=""; $self->{_GLOBAL}{'template'}= \%template; $self->{_GLOBAL}{'current_data'}= \%current_data; $self->{_GLOBAL}{'complete_decoded_data'} = \%complete_decoded_data; $self->{_GLOBAL}{'Listener_HandlesP'}= \%handles; return $self; } sub disconnect { my ( $self ) = shift; if ( $self->{_GLOBAL}{'Handle'} ) { $self->{_GLOBAL}{'Handle'}->close(); } return 1; } sub connect { my ( $self ) = shift; my $lsn = IO::Socket::INET->new ( PeerAddr => $self->{_GLOBAL}{'ServerIP'}, PeerPort => $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}{'LocalIP'}=$lsn->sockhost(); $self->{_GLOBAL}{'LocalPort'}=$lsn->sockport(); $self->{_GLOBAL}{'Handle'} = $lsn; $self->{_GLOBAL}{'Selector'}=new IO::Select( $lsn ); $self->{_GLOBAL}{'STATUS'}="Success Connected"; if ( $self->{_GLOBAL}{'ListenServer'} ) { # we should do a fork here so the listener can wait for commands # how we signal when data is ready not sure. my $child; if ($child=fork) {} elsif (defined $child) { my $lsn2 = IO::Socket::INET->new ( Listen => 1024, LocalAddr => $self->{_GLOBAL}{'ListenIP'}, LocalPort => $self->{_GLOBAL}{'ListenPort'}, ReuseAddr => 1, Proto => 'tcp', Timeout => $self->{_GLOBAL}{'Timeout'} ); if ( !$lsn2) { $self->{_GLOBAL}{'STATUS'}="Failed to bind to address '".$self->{_GLOBAL}{'ListenIP'}."' "; $self->{_GLOBAL}{'STATUS'}.="and port '".$self->{_GLOBAL}{'ListenPort'}; $self->{_GLOBAL}{'ERROR'}=$!; exit(0); } $self->{_GLOBAL}{'Listen_LocalIP'}=$lsn2->sockhost(); $self->{_GLOBAL}{'Listen_LocalPort'}=$lsn2->sockport(); $self->{_GLOBAL}{'Listen_Handle'} = $lsn2; $self->{_GLOBAL}{'Listen_Selector'}=new IO::Select( $lsn2 ); $self->{_GLOBAL}{'Listen_STATUS'}="Success Connected"; $self->check_listeners_available(); exit(0); } } return 1; } sub connect_flush { my ( $self ) = shift; undef $self->{_GLOBAL}{'LocalIP'}; undef $self->{_GLOBAL}{'LocalPort'}; undef $self->{_GLOBAL}{'Handle'}; undef $self->{_GLOBAL}{'Selector'}; undef $self->{_GLOBAL}{'STATUS'}; return 1; } sub connected { my ( $self ) = shift; return $self->{_GLOBAL}{'Selector'}; } sub check_data_handles { my ( $self ) = shift; my ( @handle ) = $self->{_GLOBAL}{'Selector'}->can_read; if ( !@handle ) { $self->{_GLOBAL}{'ERROR'}="Not Connected"; } $self->{_GLOBAL}{'ready_handles'}=\@handle; } sub get_data_segment { my ( $self ) = shift; my ( $header ); my ( $buffer ) = ""; my ( $dataset ) ; my $link; my ( $version, $type, $session, $flags, $length ); my ( $handles ) = $self->{_GLOBAL}{'ready_handles'}; foreach my $handle ( @{$handles} ) { $link = sysread($handle,$buffer,1024); if ( !$buffer ) { $handle->close(); return 1; } print "Read buffer size of '".length($buffer)."'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $self->{_GLOBAL}{'data_received'} .=$buffer; $self->{_GLOBAL}{'last_handle'}=$handle; } $self->{_GLOBAL}{'data_processing'}=1; } sub check_listener_handles { my ( $self ) = shift; my ( @handle ) = $self->{_GLOBAL}{'Listen_Selector'}->can_read; if ( !@handle ) { $self->{_GLOBAL}{'ERROR'}="Not Connected"; return 0; } print "Handles available as '".@handle."'\n"; $self->{_GLOBAL}{'Listener_Handles'}=\@handle; return 1; } sub check_listeners_available { my ( $self ) = shift; while ( $self->check_listener_handles ) { print "Checking handles.\n"; $self->get_listener_connect(); } $self->{_GLOBAL}{'STATUS'}="Socket Closed"; $self->{_GLOBAL}{'ERROR'}="Socket Closed"; } sub get_listener_connect { my ( $self ) = shift; my ( $dataset ) = ""; my ( $handles ) = $self->{_GLOBAL}{'Listener_HandlesP'}; my ( $current_handles ) = $self->{_GLOBAL}{'Listener_Handles'}; foreach my $handle ( @{$current_handles} ) { print "Handle is '$handle'\n" if $self->{_GLOBAL}{'DEBUG'}>5; if ( $handle==$self->{_GLOBAL}{'Listen_Handle'} ) { my $new = $self->{_GLOBAL}{'Listen_Handle'}->accept; $self->{_GLOBAL}{'Listen_Selector'}->add($new); } else { my $link = 0; $dataset=""; $link = sysread($handle,$dataset,1024); if ( !$link ) { my $child; ${$handles}{$handle}{'data'}.=$dataset; if ($child=fork) { } elsif (defined $child) { print "rmote address is '".${$handles}{$handle}{'addr'}."'\n" if $self->{_GLOBAL}{'DEBUG'}>5; print "rmote port is '".${$handles}{$handle}{'port'}."'\n" if $self->{_GLOBAL}{'DEBUG'}>5; if ( !${$handles}{$handle}{'data'} ) {} else { my $tmp_filename="COPS_".time().rand(5000); print "Writing data to '".$self->{_GLOBAL}{'TMPDirectory'}."/".$tmp_filename."-data'\n"; if ( open (__FILE,">".$self->{_GLOBAL}{'TMPDirectory'}."/".$tmp_filename."-data") ) { print __FILE ${$handles}{$handle}{'data'}; close __FILE; } if ( open (__FILE,">".$self->{_GLOBAL}{'TMPDirectory'}."/".$tmp_filename."-lock") ) { close (__FILE); } } foreach my $handler ( keys %{$handles} ) { if ( $handler ne $handle ) { delete ${$handles}{$handler}; } } if ( !${$handles}{$handle} ) { waitpid($child,0); exit(0); } 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}{'Listen_Selector'}->remove($handle); $handle->close(); } if ( $link ) { print "Got data set as '$dataset'\n"; ${$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 check_data_available { my ( $self ) = shift; $self->{_GLOBAL}{'data_sync'}=0; while ( $self->check_data_handles && $self->{_GLOBAL}{'ERROR'}!~/not connected/i ) { $self->get_data_segment(); while ( $self->{_GLOBAL}{'data_processing'}==1 ) { my $message = $self->{_GLOBAL}{'data_received'}; $self->decode_message_type(); if ( length($message)==0 || $self->{_GLOBAL}{'message_opcode'}=~/^null$/i ) { $self->{_GLOBAL}{'data_processing'}=0; } if ( $self->{_GLOBAL}{'DEBUG'}>0 ) { if ( $self->{_GLOBAL}{'message_client_id'} ) { print "Client is is '".$self->{_GLOBAL}{'message_client_id'}."'\n\n\n\n"; } for($a=0;$a{_GLOBAL}{'message_opcode'}=~/^opn$/i ) { print "OPN Message received, sending CAT message.\n" if $self->{_GLOBAL}{'DEBUG'}>0; my ( $response ) = $self->encode_cops_object(10,1, pack("N",30) ); $response.=$self->encode_cops_object(15,1, pack("N",30) ); my ( $cops_message ) = $self->encode_cops_message( 1,0,7,$self->{_GLOBAL}{'message_client_id'}, $response); $self->{_GLOBAL}{'major_client_id'} = $self->{_GLOBAL}{'message_client_id'}; $self->send_message($cops_message); } if ( $self->{_GLOBAL}{'message_opcode'}=~/^req$/i ) { print "REQ message received.\n" if $self->{_GLOBAL}{'DEBUG'}>0; $self->{_GLOBAL}{'message_client_handle'} = $self->{_GLOBAL}{'message'}{'Handle'}{'Handle'}; if ( $self->get_command()=~/^set$/ ) { my $subscriber_ip=$self->subscriber_get(); my $handle_object = $self->encode_handle_object($self->{_GLOBAL}{'message_client_handle'}); my $context_object = $self->encode_context_object( 8, 0 ); my $temp = pack("nn",1,1); my $decision_object = $self->encode_decision_object ( 1, $temp); my $gate_command = $self->encode_sub_transaction_id(4,rand(4095)); my $amid_command = $self->encode_sub_amid(1,1); my $subscriber_command = $self->encode_sub_subscriber_id( $self->subscriber_type(),$subscriber_ip); my $gate_id; if ( $self->get_gate_id() ) { $gate_id = $self->encode_gate_id (); } my $total_object; $total_object = $self->gate_specification_get(); $total_object.= $self->envelope_get(); $total_object.= $self->classifier_get(); $total_object.= $self->rks_get(); if ( $self->volume_get() ) { $total_object.= $self->volume_get(); } if ( $self->timebase_get() ) { $total_object.= $self->timebase_get(); } if ( $self->opaque_get() ) { $total_object.= $self->opaque_get(); } my $decision2_object = $self->encode_decision_object ( 4, $gate_command. $amid_command. $subscriber_command. $gate_id. $total_object ); my $data_block = $handle_object.$context_object.$decision_object.$decision2_object; my ( $cops_message ) = $self->encode_cops_message( 1,0,2, 32778, $data_block); $self->send_message($cops_message); } if ( $self->get_command()=~/^info$/ ) { my $subscriber_ip=$self->subscriber_get(); my $handle_object = $self->encode_handle_object($self->{_GLOBAL}{'message_client_handle'}); my $context_object = $self->encode_context_object( 8, 0 ); my $temp = pack("nn",1,1); my $decision_object = $self->encode_decision_object ( 1, $temp); my $gate_command = $self->encode_sub_transaction_id(7,rand(4095)); my $amid_command = $self->encode_sub_amid(1,1); my $subscriber_command = $self->encode_sub_subscriber_id( $self->subscriber_type(),$subscriber_ip); my $gate_id = $self->encode_gate_id (); my $decision2_object = $self->encode_decision_object ( 4, $gate_command. $amid_command. $subscriber_command. $gate_id ); my $data_block = $handle_object.$context_object.$decision_object.$decision2_object; my ( $cops_message ) = $self->encode_cops_message( 1,0,2, 32778, $data_block); $self->send_message($cops_message); } if ( $self->get_command()=~/^delete$/ ) { my $subscriber_ip=$self->subscriber_get(); my $handle_object = $self->encode_handle_object($self->{_GLOBAL}{'message_client_handle'}); my $context_object = $self->encode_context_object( 8, 0 ); my $temp = pack("nn",1,1); my $decision_object = $self->encode_decision_object ( 1, $temp); my $gate_command = $self->encode_sub_transaction_id(10,rand(4095)); my $amid_command = $self->encode_sub_amid(1,1); my $subscriber_command = $self->encode_sub_subscriber_id( $self->subscriber_type(),$subscriber_ip); my $gate_id = $self->encode_gate_id (); my $decision2_object = $self->encode_decision_object ( 4, $gate_command. $amid_command. $subscriber_command. $gate_id ); my $data_block = $handle_object.$context_object.$decision_object.$decision2_object; my ( $cops_message ) = $self->encode_cops_message( 1,0,2, 32778, $data_block); $self->send_message($cops_message); } if ( $self->get_command()=~/^synch$/i ) { print "Entere SYNC HERE!!!!!!\n" if $self->{_GLOBAL}{'DEBUG'}>0; my $subscriber_ip=$self->subscriber_get(); my $handle_object = $self->encode_handle_object($self->{_GLOBAL}{'message_client_handle'}); my $context_object = $self->encode_context_object( 8, 0 ); my $temp = pack("nn",1,1); my $decision_object = $self->encode_decision_object ( 1, $temp); my $gate_command = $self->encode_sub_transaction_id(20,rand(4095)); my $amid_command = $self->encode_sub_amid(1,1); my $synch_id = $self->encode_synch_id(); my $subscriber_command = $self->encode_sub_subscriber_id( $self->subscriber_type(),$subscriber_ip); my $decision2_object = $self->encode_decision_object ( 4, $gate_command. $amid_command. $synch_id ); my $data_block = $handle_object.$context_object.$decision2_object; my ( $cops_message ) = $self->encode_cops_message( 1,0,5, 32778, $data_block); $self->{_GLOBAL}{'wait_for_SSC'}=1; $self->send_message($cops_message); } } if ( $self->{_GLOBAL}{'message_opcode'}=~/^rpt$/i ) { my %returned_data; my $classifier_count = 0; my $data_block = $self->{_GLOBAL}{'message'}{'Client Specific Info'}{'Handle'}; while ( length($data_block)> 0 ) { my ( $sub_length,$major, $minor) = unpack("nCC",$data_block); my $data_part = substr($data_block,4,$sub_length-4); my $type = $self->object_type_decode($major,$minor); print "Sub batch data block length '".$sub_length."'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "Major is '$major' minor is '$minor' type is '$type'\n" if $self->{_GLOBAL}{'DEBUG'}>0; if ( $type=~/^transaction identifier$/i ) { my ( $mtid, $gate_command ) = $self->decode_transaction_identifier( $data_part ); my ( $gate_transform ) = $self-> decode_gate_actions( $gate_command ); print "Transaction ID is '$mtid' gate command '$gate_command' was '$gate_transform'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $returned_data{'MM_GateCommandType'} = $gate_transform; $returned_data{'MM_TransactionId'} = $mtid; } if ( $type=~/^Gate Identifier$/i ) { my ( $gate_id ) = $self->decode_gate_id ($data_part); $returned_data{'GateId_GateIdentifier'} = $gate_id; print "Gate ID is '$gate_id'\n" if $self->{_GLOBAL}{'DEBUG'}>0; } if ( $type=~/^Application Manager Identifier$/i ) { my ( $amidat, $amidam ) = $self->decode_application_manager_identifier( $data_part ); $returned_data{'AMID_ApplicationManagerIDApplicationType'}=$amidat; $returned_data{'AMID_ApplicationManagerIDApplicationManagerTag'}=$amidam; } if ( $type=~/^Classifier$/i ) { print "\n\n\nEntering Classifier Decode\n\n\n\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; my $classifier_array = $self->classifier_arrays(1); my $unpacker=""; foreach my $class_entry ( @{${$classifier_array}} ) { my $type_c = $self->attribute_pack($class_entry); $unpacker.=$type_c; } my @temp=unpack($unpacker,$data_part); my $class_prefix=$type."_".$classifier_count."_"; my $attribute_count =0; foreach my $class_entry ( @{${$classifier_array}} ) { my $class_name = $class_prefix.$class_entry; if ( $class_entry=~/IP$/ ) { $temp[$attribute_count]=$self->_IpIntToQuad($temp[$attribute_count]); } $returned_data{$class_name}=$temp[$attribute_count]; $attribute_count++; } $class_prefix=$type."_Count"; $returned_data{$class_prefix}++; $classifier_count++; } if ( $type=~/^Gate Specification$/ ) { print "\n\n\nEntering Gate Specification Decode\n\n\n\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; my $gate_array = $self->gate_array(); my $unpacker=""; my $attribute_count =0; foreach my $gate_entry ( @{${$gate_array}} ) { my $type_g = $self->attribute_pack($gate_entry); $unpacker.=$type_g; } my @temp=unpack($unpacker,$data_part); my $gate_prefix = $type."_"; $gate_prefix=~s/ //g; foreach my $gate_entry ( @{${$gate_array}} ) { my $gate_name = $gate_prefix.$gate_entry; $returned_data{$gate_name}=$temp[$attribute_count]; $attribute_count++; } } if ( $type=~/^Event-Generation-Info$/i ) { print "\n\nEntering Event Generation Info Decode\n\n\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; my $event_array = $self->rks_array(); my $unpacker=""; my $attribute_count =0; foreach my $event_entry ( @{${$event_array}} ) { my $event_g = $self->attribute_pack($event_entry); if ( $event_g=~/^string/ig ) { my ( $name, $number ) = (split(/-/,$event_g))[0,1]; $event_g="A[$number]"; } $unpacker.=$event_g; } my @temp=unpack($unpacker,$data_part); foreach my $event_entry ( @{${$event_array}} ) { if ( $event_entry=~/_IP/g ) { $temp[$attribute_count] = $self->_IpIntToQuad($temp[$attribute_count]); } $returned_data{$event_entry}=$temp[$attribute_count]; $attribute_count++; } } if ( $type=~/^Time Based Usage Limit$/i ) { my $time = unpack ("N",$data_part); $returned_data{'TimeBasedUsageLimit'}=$time; print "Time found set is '$time'\n"; } if ( $type=~/^Gate Time Info$/i ) { my $time = unpack("N",$data_part); $returned_data{'GateTimeInfo'} = $time; } if ( $type=~/^Gate Usage Info$/i ) { if ( $self->{_GLOBAL}{'DEBUG'}>0 ) { print "Length of decode is '".length($data_part)."'\n"; for($a=0;$adecode_64bit_number($data_part); $returned_data{'GateUsageInfo'}=$data_transfer; } if ( $type=~/^Gate State$/i ) { my ( $state, $reason ) = unpack("nn",$data_part); $returned_data{'GateState_State_Number'} = $state; $returned_data{'GateState_Reason_Number'} = $reason; $returned_data{'GateState_State_Description'} = $self->gate_states($state); $returned_data{'GateState_Reason_Description'} = $self->gate_reasons($reason); } if ( $type=~/^Packet Cable Error$/i ) { my ( $error, $sub_error ) = unpack("nn",$data_part); $returned_data{'PacketCableError_Main_Number'}= $error; $returned_data{'PacketCableError_Main_Description'}= $self->packetcable_errors($error); $returned_data{'PacketCableError_Sub_Number'}= $sub_error; foreach my $env_codes ( grep { /^current_Envelope/ } keys %{$self->{_GLOBAL}} ) { my $temp = $env_codes; $temp=~s/current_Envelope_/Error_/g; $returned_data{$temp}= $self->{_GLOBAL}{$env_codes}; } } $data_block = substr($data_block,$sub_length,length($data_block)-$sub_length); } $self->{_GLOBAL}{'DataHandler'}->( $self, \%returned_data ); if ( !$self->{_GLOBAL}{'wait_for_SSC'} ) { if ( $self->{_GLOBAL}{'ListenServer'}==0 ) { return 1; } } } if ( $self->{_GLOBAL}{'message_opcode'}=~/^ssc$/i ) { $self->{_GLOBAL}{'wait_for_SSC'}=0; if ( $self->{_GLOBAL}{'ListenServer'}==0 ) { return 1; } } if ( $self->{_GLOBAL}{'message_opcode'}=~/^ka$/i ) { print "KA Message received, sending KA message.\n" if $self->{_GLOBAL}{'DEBUG'}>0; my ( $cops_message ) = $self->encode_cops_message_no_payload( 1,0,9,$self->{_GLOBAL}{'message_client_id'} ); $self->send_message($cops_message); } } } return 1; } sub encode_handle_object { my ( $self ) = shift; my ( $data ) = shift; my $handle_object = $self->encode_cops_object( 1,1,$data ); return $handle_object; } sub encode_context_object { my ( $self ) = shift; my ( $rtype ) = shift; my ( $mtype ) = shift; my ( $enc_rtype ) = pack("n",$rtype); my ( $enc_mtype ) = pack("n",$mtype); my $context_object = $self->encode_cops_object( 2,1, $enc_rtype.$enc_mtype); return $context_object; } sub encode_decision_object { my ( $self ) = shift; my ( $sub_command ) = shift; my ( $data ) = shift; my ( $pad ) = 0; my ($stub_pri, $sub_sec) = (split(/\./,sprintf("%f",length($data)/4)))[0,1]; if ( $stub_pri ==0 && $sub_sec>0 ) { $pad = 4 - length($data); } if ( $stub_pri > 0 && $sub_sec<1 ) { my $temp = $stub_pri*4; $pad = $temp - length($data); } for ( $a=0; $a<$pad; $a++) { $data.=pack("C",0); } print "Length of data is '".length($data)."'\n\n\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; my $decision_object = $self->encode_cops_object( 6, $sub_command , $data); return $decision_object; } sub encode_sub_classifier { my ( $self ) = shift; my ( $data ) = shift; my ( $packed ) = ""; my ( $classifier_array ); if ( ${$data}{'Classifier_Type'}=~/^classifier$/i ) { $packed .= pack("CC",6,1); $classifier_array = $self->classifier_arrays(1); } if ( ${$data}{'Classifier_Type'}=~/^extended$/i ) { $packed .= pack("CC",6,2); $classifier_array = $self->classifier_arrays(2); } $packed.=$self->general_pack( $data, $classifier_array ); if ( $self->{_GLOBAL}{'DEBUG'}>4 ) { print "Classifier ENCODER \n\n\n\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; for($a=0;$a 0 && $align <4 ) { print "Align is '$align'\n" if $self->{_GLOBAL}{'DEBUG'}>0; for ( my $tmp=0; $tmp<$align; $tmp ++ ) { print "Adding '$tmp'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $string.=pack("C",0); } print "Finished alignment\n\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; } print "Length of output is '".length($string)."'\n" if $self->{_GLOBAL}{'DEBUG'}>0; my ( $length ) = pack("n",(length($string)+2)); return $string; } sub encode_synch_id { my ( $self ) = shift; my ( $packed ) = ""; $packed = pack("CC",18,1); $packed.= pack("CCCC",1,0,1,0); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub encode_gate_id { my ( $self ) = shift; my ( $data ) = shift; my ( $packed ) = ""; $packed = pack("CC",4,1); $packed .= pack("N", $self->get_gate_id() ); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub encode_time_limit { my ( $self ) = shift; my ( $data ) = shift; my ( $packed ) = ""; $packed = pack("CC",10,1); $packed .= pack("N",$data); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub encode_byte_limit { my ( $self ) = shift; my ( $data ) = shift; my ( $packed ) = ""; $packed = pack("CC",9,1); if ( !$data ) { $data=0; } $packed .= $self->encode_64bit_number($data); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub encode_sub_traffic { my ( $self ) = shift; my ( $data ) = shift; my ( $packed ) = ""; my $type = $self->envelope_type ( ${$data}{'Service_Type'} ); my @parts = (split(/,/,$type))[0,1,2]; $packed = pack("CC", $parts[1], $parts[2]); ${$data}{'Type'} = $self->Envelope_Type_remap(${$data}{'Envelope_Type'}); ${$data}{'Envelope'} = ${$data}{'Type'}; my $envelope_header = $self->envelope_header( $parts[2] ); $packed.=$self->general_pack( $data, $envelope_header ); my $auth = ${$data}{'Type'} & 0x01; my $reserved = ${$data}{'Type'} & 0x02; my $commit = ${$data}{'Type'} & 0x04; print "Auth is '$auth'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "Reserved is '$reserved'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "Commit is '$commit'\n" if $self->{_GLOBAL}{'DEBUG'}>0; if ( $auth > 0 ) { print "\n\nENTERING AUTH PHASE\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; $packed.=$self->encode_envelope( $parts[2], "Envelope_authorize_", $data ); } if ( $reserved > 0 ) { print "\n\nENTERING RESERVED PHASE\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; $packed.=$self->encode_envelope( $parts[2], "Envelope_reserve_", $data ); } if ( $commit > 0 ) { print "\n\nENTERING COMMIT PHASE\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; $packed.=$self->encode_envelope( $parts[2], "Envelope_commit_", $data ); } if ( $self->{_GLOBAL}{'DEBUG'}>4 ) { print "Envelope ENCODER \n\n\n\n\n"; for($a=0;$aenvelope_array( $number ); $result.=$self->general_pack( $data, $envelope_main, $type ); return $result; } sub encode_sub_amid { my ( $self ) = shift; my ( $app_type ) = shift; my ( $man_tag ) = shift; my ( $packed ) = pack("CCnn", 2,1,$app_type, $man_tag); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub encode_sub_subscriber_id { my ( $self ) = shift; my ( $type ) = shift; my ( $ip ) = shift; my ( $convert_ip ) = $self->_IpQuadToInt($ip); my ( $packed ) = pack("CCN", 3,$type,$convert_ip); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub encode_sub_transaction_id { my ( $self ) = shift; my ( $gate_command ) = shift; my ( $trans_id ) = shift; my ( $packed ) = pack("CCnn", 1,1,$trans_id,$gate_command); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub encode_sub_decision { my ( $self ) = shift; my ( $snum ) = shift; my ( $stype ) = shift; my ( $data ) = shift; my ( $pad ) = 0; my ($stub_pri, $sub_sec) = (split(/\./,sprintf("%f",length($data)/4)))[0,1]; if ( $stub_pri ==0 && $sub_sec>0 ) { $pad = 4 - length($data); } if ( $stub_pri > 0 && $sub_sec<1 ) { my $temp = $stub_pri*4; $pad = $temp - length($data); } for ( $a=0; $a<$pad; $a++) { $data.=pack("C",0); } my ( $length ) = length ($data)+2; my $sub_decision = pack("nCCN",$length, $snum, $stype, $data); return $sub_decision; } sub send_message { my ( $self ) = shift; my ( $message ) = shift; if ( !$self->{_GLOBAL}{'Handle'} ) { return 0; } my ( $length_sent ); eval { local $SIG{ALRM} = sub { die "alarm\n" }; alarm 1; $length_sent = syswrite ( $self->{_GLOBAL}{'Handle'}, $message ); alarm 0; }; print "length sent is '$length_sent'\n" if $self->{_GLOBAL}{'DEBUG'}>0; if ( $@=~/alarm/i ) { return 0; } print "Sending message of size '".length($message)."'\n" if $self->{_GLOBAL}{'DEBUG'}>0; if ( $self->{_GLOBAL}{'DEBUG'}>4 ) { for($a=0;$a{_GLOBAL}{'current_gate_id'} = $gate_id; return 1; } sub get_gate_id { my ( $self ) = shift; if ( !$self->{_GLOBAL}{'current_gate_id'} ) { return ""; } return $self->{_GLOBAL}{'current_gate_id'}; } sub set_command { my ( $self ) = shift; my ( $command ) = shift; $self->{_GLOBAL}{'current_command'} = $command; return 1; } sub get_command { my ( $self ) = shift; return $self->{_GLOBAL}{'current_command'}; } sub clear_command { my ( $self ) = shift; $self->{_GLOBAL}{'current_command'}=""; return 1; } sub envelope_add { my ( $self ) = shift; my ( $data ) = shift; my ( %test ) ; while (my($field, $val) = splice(@{$data}, 0, 2)) { my $temp = "current_Envelope_".$field; $self->{_GLOBAL}{$temp} = $val; $test{$field}= $val; } my $encode_envelope = $self->encode_sub_traffic(\%test); $self->{_GLOBAL}{'Envelope_Encoded'} = $encode_envelope; return 1; } sub envelope_get { my ( $self ) = shift; if ( $self->{_GLOBAL}{'Envelope_Encoded'} ) { return $self->{_GLOBAL}{'Envelope_Encoded'}; } return ""; } sub classifier_add { my ( $self ) = shift; my ( $data ) = shift; my ( %test ); while (my($field, $val) = splice(@{$data}, 0, 2)) { $test{$field}= $val; } my $encode_classifier = $self->encode_sub_classifier ( \%test ); $self->{_GLOBAL}{'Classifier_Encoded'} .= $encode_classifier; return 1; } sub classifier_clear { my ( $self ) = shift; $self->{_GLOBAL}{'Classifier_Encoded'} = ""; } sub classifier_get { my ( $self ) = shift; if ( $self->{_GLOBAL}{'Classifier_Encoded'} ) { return $self->{_GLOBAL}{'Classifier_Encoded'}; } return ""; } sub subscriber_set { my ( $self ) = shift; my ( $subscriber_type ) = shift; my ( $ip ) = shift; if ( $subscriber_type=~/^ipv4$/i ) { print "Entry IP is '$ip'\n" if $self->{_GLOBAL}{'DEBUG'}>0; my ( $test ) = $self->_IpQuadToInt($ip); $ip = $self->_IpIntToQuad($test); print "Exit IP is '$ip'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $self->{_GLOBAL}{'cpe_device_type'}=$subscriber_type; $self->{_GLOBAL}{'cpe_device_ip'}=$ip; } if ( $subscriber_type=~/^ipv6$/i ) { my @ipv6 = split(/:/,$ip); my $test = ""; if ( scalar(@ipv6)!=8 ) { print "IPv6 entry invalid, full address required.\n" if $self->{_GLOBAL}{'DEBUG'}>0; return 1; } foreach my $ipv6_seg ( @ipv6 ) { my $testa = hex($ipv6_seg); $test .= pack("n",$testa); } $self->{_GLOBAL}{'cpe_device_type'}=$subscriber_type; $self->{_GLOBAL}{'cpe_device_ip'}=$test; } return 1; } sub subscriber_type { my ( $self ) = shift; if ( !$self->{_GLOBAL}{'cpe_device_type'} ) { return 0; } if ( $self->{_GLOBAL}{'cpe_device_type'}=~/^ipv4$/ ) { return 1; } if ( $self->{_GLOBAL}{'cpe_device_type'}=~/^ipv6$/ ) { return 2; } return 0; } sub subscriber_clear { my ( $self ) = shift; $self->{_GLOBAL}{'cpe_device_ip'}=""; $self->{_GLOBAL}{'cpe_device_type'}=0; return 1; } sub subscriber_get { my ( $self ) = shift; if ( !$self->{_GLOBAL}{'cpe_device_ip'} ) { return $self->_IpIntToQuad(0); } return $self->{_GLOBAL}{'cpe_device_ip'}; } sub get_error { my ( $self ) = shift; return $self->{_GLOBAL}{'ERROR'}; } sub decode_message_type { my ( $self ) = shift; my ( $decode_data ) = $self->{_GLOBAL}{'data_received'}; $self->{_GLOBAL}{'message_count'}=0; if ( !$decode_data ) { $self->{_GLOBAL}{'message_opcode'} = "NULL"; return 1; } my ( $vflags, $v2, $client_id, $total_length ) = unpack("CCnN",$decode_data); my ( $version ) = $vflags; $version >>= 4; $version = $version & 0x0F; $vflags = $vflags & 0x0F; my ( $opcode ) = $self->decode_cops_operations( $v2 ); print "Version is '$version' flags is '$vflags'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "Opcode is '$opcode'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "client id is '$client_id'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "New total length is '$total_length'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "Length of dd '".length($decode_data)."\n" if $self->{_GLOBAL}{'DEBUG'}>0; $decode_data = substr ( $decode_data, 8, $total_length-8 ); if ( $self->{_GLOBAL}{'DEBUG'}>0 ) { for($a=0;$a{_GLOBAL}{'DEBUG'}>0; while ( length($decode_data)> 0 ) { $decode_data = $self-> decode_cops_message ( $decode_data ); } print "all cops messages decoded.\n" if $self->{_GLOBAL}{'DEBUG'}>0; $self->{_GLOBAL}{'message_client_id'} = $client_id; $self->{_GLOBAL}{'message_opcode'} = $opcode; $self->{_GLOBAL}{'data_received'} = substr( $self->{_GLOBAL}{'data_received'}, $total_length, length($self->{_GLOBAL}{'data_received'})-$total_length); return 1; } sub decode_cops_message { my ( $self ) = shift; my ( $data ) = shift; my ( $total_length, $cnum, $ctype ) = unpack("nCC",$data); print "Cops message length is '$total_length'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $cnum = $self->decode_c_num_type ( $cnum ); $ctype = $self->decode_c_num_type ( $ctype ); print "Cnum is '$cnum'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "CType is '$ctype'\n" if $self->{_GLOBAL}{'DEBUG'}>0; print "Total length is '$total_length'\n" if $self->{_GLOBAL}{'DEBUG'}>0; my $message = substr($data,4, $total_length-4 ); print "Pre length data is '".length($message)."'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $self->{_GLOBAL}{'message'}{ $cnum }{$ctype } = $message; print "Length of message is '".length($self->{_GLOBAL}{'message'}{ $cnum }{$ctype })."'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $data = substr($data,$total_length, length($data)-$total_length ); return $data; } sub decode_cops_operations { my ( $self ) = shift; my ( $opcode ) = shift; my %opcodes = ( '1' => 'REQ', '2' => 'DEC', '3' => 'RPT', '4' => 'DRQ', '5' => 'SSQ', '6' => 'OPN', '7' => 'CAT', '8' => 'CC', '9' => 'KA', '10' => 'SSC' ); return $opcodes{$opcode}; } sub decode_c_num_type { my ( $self ) = shift; my ( $opcode ) = shift; my %cnumtypes = ( '1' => 'Handle', '2' => 'Context', '3' => 'In Interface', '4' => 'Out Interface', '5' => 'Reason Code', '6' => 'Decision', '7' => 'LPDP Decision', '8' => 'Error', '9' => 'Client Specific Info', '10' => 'Keep-Alive Timer', '11' => 'PEP Identification', '12' => 'Report Type', '13' => 'PDP Redirect Address', '14' => 'Last PDP Address', '15' => 'Accounting Timer', '16' => 'Message Integrity' ); return $cnumtypes{$opcode}; } sub decode_gate_actions { my ( $self ) = shift; my ( $transcode ) = shift; my ( %transaction_ids ) = ( '1' => 'GATE-ALLOC', '2' => 'GATE-ALLOC-ACK', '3' => 'GATE-ALLOC-ERR', '4' => 'GATE-SET', '5' => 'GATE-SET-ACK', '6' => 'GATE-SET-ERR', '7' => 'GATE-INFO', '8' => 'GATE-INFO-ACK', '9' => 'GATE-INFO-ERR', '10' => 'GATE-DELETE', '11' => 'GATE-DELETE-ACK', '12' => 'GATE-DELETE-ERR', '13' => 'GATE-OPEN', '14' => 'GATE-CLOSE' ); return $transaction_ids{$transcode} if $transaction_ids{$transcode}; } sub encode_gate_ids { my ( $self ) = shift; my ( $transcode ) = shift; my ( %transaction_ids ) = ( 'GATE-ALLOC' => '1', 'GATE-ALLOC-ACK' => '2', 'GATE-ALLOC-ERR' => '3', 'GATE-SET' => '4', 'GATE-SET-ACK' => '5', 'GATE-SET-ERR' => '6', 'GATE-INFO' => '7', 'GATE-INFO-ACK' => '8', 'GATE-INFO-ERR' => '9', 'GATE-DELETE' => '10', 'GATE-DELETE-ACK' => '11', 'GATE-DELETE-ERR' => '12', 'GATE-OPEN' => '13', 'GATE-CLOSE' => '14' ); return $transaction_ids{$transcode} if $transaction_ids{$transcode}; } sub classifier_arrays { my ( $self ) = shift; my ( $type ) = shift; my ( @classifiers ) = ( [], [ "Classifier_IPProtocolId", "Classifier_TOSField", "Classifier_TOSMask", "Classifier_SourceIP", "Classifier_DestinationIP", "Classifier_SourcePort", "Classifier_DestinationPort", "Classifier_Priority", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte" ], [ "EClassifier_IPProtocolId", "EClassifier_TOSField", "EClassifier_TOSMask", "EClassifier_SourceIP", "EClassifier_SourceMask", "EClassifier_DestinationIP", "EClassifier_DestinationMask", "EClassifier_SourcePortStart", "EClassifier_SourcePortEnd", "EClassifier_DestinationPortStart", "EClassifier_DestinationPortEnd", "EClassifier_ClassifierID", "EClassifier_Priority", "EClassifier_State", "EClassifier_Action", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte" ] ); return \$classifiers[$type]; } sub packetcable_errors { my ( $self ) = shift; my ( $error ) = shift; my ( @errors ) = ( "", "Insufficient resources", "Unknown Gate ID", "Unknown", "Unknown", "Unknown", "Missing Required Object", "Invalid Object", "Volume based usage limit exceeded", "Time based usage limit exceeded", "Session Class Limit Exceeded", "Undefined Service Class Name", "Incompatible Envelope", "Invalid subscriber identifier", "Unauthorized AMID", "Number of Classifiers not supported", "Policy Exception", "Invalid field value in object", "Transport Error", "Unknown gate command", "DOCSIS 1.0 CM", "Number of SIDs exceeded in CM", "Number of SIDs exceeded in CMTS", "Unauthorized PSID", "No state for PDPD", "Unsupport Sync Type", "State data incomplete", ); if (!$errors[$error]) { return "Other, unspecified error"; } return $errors[$error]; } sub gate_states { my ( $self ) = shift; my ( $state_no ) = shift; my ( @states ) = ( "", "Idle/Closed", "Auhorized", "Reserved", "Committed", "Committed Recovery" ); if ( !$states[$state_no] ) { return "Unknown"; } return $states[$state_no]; } sub gate_reasons { my ( $self ) = shift; my ( $reason ) = shift; my ( @reasons ) = ( "", "Close Initiated by CMTS because of reservation reassignment", "Close Initiated by CMTS because of lack of DOCSIS responses", "Close Initiated by CMTS because of timer T1 expiry", "Close Initiated by CMTS because of timer T2 expiry", "Inactivity timer (T3) expired", "Close Initiated by CMTS because of a lack of reservation maintenance", "Gate state unchanged, but volume limit reached", "Close Initiated by CMTS because of timer T4 expiry", "Gate State unchanged, but timer T2 expiry caused reservation reduction", "Gate State unchanged, but time limit reached", "Close Initiated by PS or CMTS, volume limit reached", "Close Initiated by PS or CMTS, time limit reached", "Close Initiated by CMTS, other" ); if ( !$reasons[$reason] ) { return "Other"; } return $reasons[$reason]; } sub gate_array { my ( $self ) = shift; my ( @gate_headers ) = ( [ "Gate_Flags", "Gate_TOSField", "Gate_TOSMask", "Gate_Class", "Gate_T1", "Gate_T2", "Gate_T3", "Gate_T4" ] ); return \$gate_headers[0]; } sub rks_array { my ( $self ) = shift; my ( @rks_headers ) = ( [ "PRKS_IPAddress", "PRKS_Port", "Reserved", "Reserved", "SRKS_IPAddress", "SRKS_Port", "Reserved", "Reserved", "BCID_TimeStamp", "BCID_ElementID", "BCID_TimeZone", "BCID_EventCounter" ] ); return \$rks_headers[0]; } sub rks_set { my ( $self ) = shift; my ( $data ) = shift; my ( %test ); while (my($field, $val) = splice(@{$data}, 0, 2)) { $test{$field}= $val; } my $rks_encoded = $self->rks_encode(\%test); $self->{_GLOBAL}{'RKS_Encoded'} = $rks_encoded; return 1; } sub rks_clear { my ( $self ) = shift; $self->{_GLOBAL}{'RKS_Encoded'} = ""; return 1; } sub rks_encode { my ( $self ) = shift; my ( $data ) = shift; my ( $packed ) = ""; my ( $done_pack ) =0; $packed = pack("CC",8,1); my ( $rks_headers ) = $self->rks_array(); $packed .= $self->general_pack ( $data, $rks_headers ); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub rks_get { my ( $self ) = shift; if ( $self->{_GLOBAL}{'RKS_Encoded'} ) { return $self->{_GLOBAL}{'RKS_Encoded'}; } return ""; } sub opaque_clear { my ( $self ) = shift; $self->{_GLOBAL}{'OpaqueData'}=""; return 1; } sub opaque_set { my ( $self ) = shift; my ( $data ) = shift; my ( %test ); my ( $encoded ) = ""; while (my($field, $val) = splice(@{$data}, 0, 2)) { $test{$field}= $val } if ( $test{'OpaqueData'} ) { $encoded = pack("CC",11,1); $encoded.= $self->align_string( $test{'OpaqueData'} ); my ( $length ) = pack("n",(length($encoded)+2)); $encoded= $length.$encoded; } $self->{_GLOBAL}{'OpaqueData'} = $encoded; return 1; } sub timebase_set { my ( $self ) = shift; my ( $data ) = shift; my ( %test ) ; my ( $timer_encode ); while (my($field, $val) = splice(@{$data}, 0, 2)) { $test{$field}= $val } if ( $test{'TimeLimit'}>0 ) { $timer_encode = $self->encode_time_limit( $test{'TimeLimit'} ); } $self->{_GLOBAL}{'TimeLimit'} = $timer_encode; return 1; } sub timebase_clear { my ( $self ) = shift; $self->{_GLOBAL}{'TimeLimit'} = ""; return 1; } sub volume_set { my ( $self ) = shift; my ( $data ) = shift; my ( %test ) ; my ( $timer_encode ); while (my($field, $val) = splice(@{$data}, 0, 2)) { $test{$field}= $val } if ( $test{'VolumeLimit'}>0 ) { $timer_encode = $self->encode_byte_limit( $test{'VolumeLimit'} ); } $self->{_GLOBAL}{'TimeLimit'} = $timer_encode; return 1; } sub volume_clear { my ( $self ) = shift; $self->{_GLOBAL}{'TimeLimit'} = ""; return 1; } sub opaque_get { my ( $self ) = shift; if ( $self->{_GLOBAL}{'OpaqueData'} ) { return $self->{_GLOBAL}{'OpaqueData'}; } return ""; } sub volume_get { my ( $self ) = shift; if ( $self->{_GLOBAL}{'VolumeLimit'} ) { return $self->{_GLOBAL}{'VolumeLimit'}; } return ""; } sub timebase_get { my ( $self ) = shift; if ( $self->{_GLOBAL}{'TimeLimit'} ) { return $self->{_GLOBAL}{'TimeLimit'}; } return ""; } sub gate_specification_add { my ( $self ) = shift; my ( $data ) = shift; my ( %test ); while (my($field, $val) = splice(@{$data}, 0, 2)) { $test{$field}= $val; } my ( $priority ) =0; my ( $preemption ) =0; foreach my $field ( keys %test ) { my $val = $test{$field}; print "Gate key is '$field' value is '$val'\n" if $self->{_GLOBAL}{'DEBUG'}>0; if ( $field=~/^direction$/i ) { if (!$test{'Gate_Flags'}) { $test{'Gate_Flags'}=0; } $test{'Gate_Flags'}=$test{'Gate_Flags'} & 0xFE; if ( $val=~/^downstream$/i ) { $test{'Gate_Flags'}=$test{'Gate_Flags'} & 0xFE; } if ( $val=~/^upstream$/i ) { $test{'Gate_Flags'}=$test{'Gate_Flags'} & 0xFE; $test{'Gate_Flags'}=$test{'Gate_Flags'} + 0x01; } } if ( $field=~/^dscptosmark$/i ) { if ( !$test{'Gate_Flags'} ) { $test{'Gate_Flags'}=0; } $test{'Gate_Flags'} = $test{'Gate_Flags'} & 0xFD; $val = $val & 0x01; $val = $val << 1; $val = $val & 0x02; $test{'Gate_Flags'} = $test{'Gate_Flags'} + $val; } if ( $field=~/^priority$/i ) { if ( !$test{'Gate_Class'} ) { $test{'Gate_Class'}=0; } $val = $val & 0x07; $priority = $val; } if ( $field=~/^preemption$/i ) { if ( $test{'Gate_Class'} ) { $test{'Gate_Class'}=0; } $val = $val & 0x01; $val = $val << 3; $val = $val & 0x08; $preemption = $val; } if ( $priority || $preemption ) { $test{'Gate_Class'} = $test{'Gate_Class'} & 0xF0; $test{'Gate_Class'} = $test{'Gate_Class'} + $priority; $test{'Gate_Class'} = $test{'Gate_Class'} + $preemption; } } my $encode_gate_spec = $self->encode_sub_gate_spec ( \%test ); $self->{_GLOBAL}{'Gate_Specification_Encoded'} = $encode_gate_spec; return 1; } sub gate_specification_clear { my ( $self ) = shift; $self->{_GLOBAL}{'Gate_Specification_Encoded'} = ""; } sub gate_specification_get { my ( $self ) = shift; if ( $self->{_GLOBAL}{'Gate_Specification_Encoded'} ) { return $self->{_GLOBAL}{'Gate_Specification_Encoded'}; } return ""; } sub encode_sub_gate_spec { my ( $self ) = shift; my ( $data ) = shift; my ( $packed ) = ""; $packed = pack("CC",5,1); my ( $gate_headers ) = $self->gate_array(); $packed.= $self->general_pack( $data, $gate_headers ); my ( $length ) = pack("n",(length($packed)+2)); return $length.$packed; } sub envelope_type { my ( $self ) = shift; my ( $part ) = shift; my ( %types ) = ( "None" => "None,0,0", "Flow Spec"=> "Flow Spec,7,1", "DOCSIS Service Class Name"=> "DOCSIS Service Class Name,7,2", "Best Effort Service" => "Best Effort Service,7,3", "Non-Real-Time Polling Service" => "Non-Real-Time Polling Service,7,4", "Real-Time Polling Service" => "Real-Time Polling Service,7,5", "Unsolicited Grant Service" => "Unsolicited Grant Service,7,6", "Unsolicited Grant Service with Activity Detection" => "Unsolicited Grant Service with Activity Detection,7,7", "Downstream" => "Downstream,7,8" ); return $types{$part}; } sub envelope_header { my ( $self ) = shift; my ( $part ) = shift; my ( @headers ) = ( # There is no 7-0 [ ], # 7-1 # Flow Spec [ "Envelope", "Service Number", "Reserved1Byte", "Reserved1Byte" ], # 7-2 # DOCSIS Service Class Name [ "Envelope", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte", "ServiceClassName" ], # 7-3 # Best Effort Service [ "Envelope", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte" ], # 7-4 # Non-Real_time Polling Service [ "Envelope", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte" ], # 7-5 # Real_time Polling Service [ "Envelope", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte" ], # 7-6 # Unsolicited Grant Sevice [ "Envelope", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte" ], # 7-7 # Unsolicited Grant Service with Activity Detection [ "Envelope", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte" ], # 7-8 # Downstream Service [ "Envelope", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte" ] ); return \$headers[$part]; } sub envelope_array { my ( $self ) = shift; my ( $part ) = shift; my ( @envelopes ) = ( # There is no 7-0 [ ], # 7-1 [ "Token Bucket Rate", "Token Bucket Size", "Peak Data Rate", "Minimum Policed Unit", "Maximum Packet Size", "Rate", "Slack Term" ], # 7-2 # A little unsure here. [ ], # 7-3 [ "Traffic Priority", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte", "Request Transmission Policy", "Maximum Sustained Traffic Rate", "Maximum Traffic Burst", "Minimum Reserved Traffic Rate", "Assumed Minimum Reserved Traffic Rate Packet Size", "Reserved1Byte", "Reserved1Byte" ], # 7-4 [ "Traffic Priority", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte", "Request Transmission Policy", "Maximum Sustained Traffic Rate", "Maximum Traffic Burst", "Minimum Reserved Traffic Rate", "Assumed Minimum Reserved Traffic Rate Packet Size", "Maximum Concatenated Burst", "Nominal Polling Interval", "Required Attribute Mask", "Forbidden Attribute Mask" ], # 7-5 [ "Request Transmission Policy", "Maximum Sustained Traffic Rate", "Maximum Traffic Burst", "Minimum Reserved Traffic Rate", "Assumed Minimum Reserved Traffic Rate Packet Size", "Maximum Concatenated Burst", "Nominal Polling Interval", "Tolerated Poll Jitter", "Required Attribute Mask", "Forbidden Attribute Mask" ], # 7-6 [ "Request Transmission Policy", "Unsolicited Grant Size", "Grants Per Interval", "Reserved1Byte", "Nominal Grant Interval", "Tolerated Grant Jitter", "Required Attribute Mask", "Forbidden Attribute Mask" ], # 7-7 [ "Request Transmission Policy", "Unsolicited Grant Size", "Grants Per Interval", "Reserved1Byte", "Nominal Grant Interval", "Tolerated Grant Jitter", "Nominal Polling Interval", "Tolerated Poll Jitter" ], # 7-8 [ "Traffic Priority", "Reserved1Byte", "Reserved1Byte", "Reserved1Byte", "Maximum Sustained Traffic Rate", "Maximum Traffic Burst", "Minimum Reserved Traffic Rate", "Assumed Minimum Reserved Traffic Rate Packet Size", "Reserved1Byte", "Reserved1Byte", "Maximum Downstream Latency" ] ); return \$envelopes[$part]; } sub attribute_pack { my ( $self ) = shift; my ( $attribute ) = shift; my ( %attributes ) = ( "Assumed Minimum Reserved Traffic Rate Packet Size" => 'n', "Forbidden Attribute Mask" => 'N', "Grants Per Interval" => 'C', "Maximum Concatenated Burst" => 'n', "Maximum Downstream Latency" => 'N', "Maximum Packet Size" => 'N', "Maximum Sustained Traffic Rate" => 'N', "Maximum Traffic Burst" => 'N', "Minimum Policed Unit" => 'N', "Minimum Reserved Traffic Rate" => 'N', "Nominal Grant Interval" => 'N', "Nominal Polling Interval" => 'N', "Peak Data Rate" => 'N', "Rate" => 'N', "Request Transmission Policy" => 'N', "Required Attribute Mask" => 'N', "Reserved1Byte" => 'C', "Reserved2Bytes" => 'n', "Reserved3Bytes" => 'Cn', "Slack Term" => 'N', "Token Bucket Rate" => 'N', "Token Bucket Size" => 'N', "Tolerated Grant Jitter" => 'N', "Tolerated Poll Jitter" => 'N', "Traffic Priority" => 'C', "Unsolicited Grant Size" => 'n', "Envelope" => 'C', "Service Number" => 'C', "String" => 'String', "ServiceClassName" => 'String', "Gate_Flags" => 'C', "Gate_TOSField" => 'C', "Gate_TOSMask" => 'C', "Gate_Class" => 'C', "Gate_T1" => 'n', "Gate_T2" => 'n', "Gate_T3" => 'n', "Gate_T4" => 'n', "Classifier_IPProtocolId" => 'n', "Classifier_TOSField" => 'C', "Classifier_TOSMask" => 'C', "Classifier_SourceIP" => 'N', "Classifier_DestinationIP" => 'N', "Classifier_SourcePort" => 'n', "Classifier_DestinationPort" => 'n', "Classifier_Priority" => 'C', "EClassifier_IPProtocolId" => 'n', "EClassifier_TOSField" => 'C', "EClassifier_TOSMask" => 'C', "EClassifier_SourceIP" => 'N', "EClassifier_SourceMask" => 'N', "EClassifier_DestinationIP" => 'N', "EClassifier_DestinationMask" => 'N', "EClassifier_SourcePortStart" => 'n', "EClassifier_SourcePortEnd" => 'n', "EClassifier_DestinationPortStart" => 'n', "EClassifier_DestinationPortEnd" => 'n', "EClassifier_ClassifierID" => 'n', "EClassifier_Priority" => 'C', "EClassifier_State" => 'C', "EClassifier_Action" => 'C', "PRKS_IPAddress" => 'N', "PRKS_Port" => 'n', "PRKS_Flags" => 'C', "Reserved" => 'C', "SRKS_IPAddress" => 'N', "SRKS_Port" => 'n', "SRKS_Flags" => 'C', "Reserved" => 'C', "BCID_TimeStamp" => 'N', "BCID_ElementID" => 'String-8', "BCID_TimeZone" => 'String-8', "BCID_EventCounter" => 'N', "RADIUS_EventMessageVersionID" => 'n', "RADIUS_BCID_Timestamp" => 'N', "RADIUS_BCID_ElementID" => 'String-8', "RADIUS_BCID_TimeZone" => 'String-8', "RADIUS_BCID_EventCounter" => 'N', "RADIUS_EventMessageType" => 'n', "RADIUS_ElementType" => 'n', "RADIUS_ElementID" => 'String-8', "RADIUS_TimeZone" => 'String-8', "RADIUS_SequenceNumber" => 'N', "RADIUS_EventTime" => 'String-18', "RADIUS_Status" => 'N', "RADIUS_Priority" => 'C', "RADIUS_AttributeCount" => 'n', "RADIUS_EventObject" => 'C', "RADIUS_QosStatus" => 'N', "RADIUS_ServiceClassName" => 'String-16' ); return $attributes{$attribute}; } sub decode_transaction_identifier { my ( $self ) = shift; my ( $data ) = shift; my ( $mmtid, $gate_command ) = unpack("nn",$data); return ($mmtid,$gate_command); } sub decode_application_manager_identifier { my ( $self ) = shift; my ( $data ) = shift; my ( $amidat, $amidam ) = $self->decode_transaction_identifier($data); return ($amidat, $amidam); } sub decode_subscriber_id { my ( $self ) = shift; my ( $data ) = shift; my ( $sub_id ) = unpack("N",$data); my ( $sub_ip ) = $self->_IpIntToQuad($sub_id); return ( $sub_id, $sub_ip ); } sub decode_gate_id { my ( $self ) = shift; my ( $data ) = shift; my ( $gate_id ) = unpack("N",$data); return $gate_id; } sub object_type_decode { my ( $self ) = shift; my ( $major ) = shift; my ( $minor ) = shift; my ( @object_types ) = ( # Nothing at 0 [], # Transaction Identifier 1 [ "", "Transaction Identifier" ], # Application Manager Identifier 2 [ "", "Application Manager Identifier" ], # Subscriber Identifier 3 [ "", "Subscriber Identifier" ], # Gate Identifier 4 [ "", "Gate Identifier" ], # Sub routines for decode done up to here. # Gate Specification 5 [ "", "Gate Specification" ], # Classifier 6 [ "", "Classifier", "Extended Classifier" ], # Traffic Profile 6 [ "", "Flow Spec", "DOCSIS Service Class Name", "Best Effort Service", "Non-Real-Time Polling Service", "Real-Time Polling Service", "Unsolicited Grant Service", "Unsolicited Grant Service with Activity Detection", "Downstream" ], # Event-Generation-Info 7 [ "", "Event-Generation-Info", ], # Volume Based Usage Limit [ "", "Volume Based Usage Limit" ], # Time Based Usage Limit [ "", "Time Based Usage Limit" ], # Opaque Data [ "", "Opaque Data" ], # Gate Time Info [ "", "Gate Time Info" ], # Gate Usage Info [ "", "Gate Usage Info" ], # Packet Cable Error [ "", "Packet Cable Error" ], # Gate State [ "", "Gate State" ], # Version Info [ "", "Version Info" ], # Policy Server Identifier [ "", "Policy Server Identifier" ], # Synch Options [ "", "Synch Options" ], # Msg Receipt Key [ "", "Msg Receipt Key" ] ); return $object_types[$major][$minor]; } sub Envelope_Type_remap { my ( $self ) = shift; my ( $envelope_setting ) = shift; my ( $envelope_type ) = 0; my ( @types ) = qw [ authorize:1 reserve:2 commit:4 ]; foreach my $find_type ( @types ) { my ( $name, $number ) = (split(/:/,$find_type))[0,1]; if ( $envelope_setting=~/$name/ig ) { print "Debug envelope number is '$number'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $envelope_type+=$number; } } return $envelope_type; } sub encode_cops_message_no_payload { my ( $self ) = shift; my ( $version ) = shift; my ( $flags ) = shift; my ( $opcode ) = shift; my ( $clienttype ) = shift; my ( $data ) = ""; my ( $header_v ) = ( ($version<<4) | $flags ); my ( $data_block ) = pack("CCn",$header_v,$opcode,$clienttype); my ( $length ) = pack("N",length($data)+8); $data_block.=$length.$data; return $data_block; } sub encode_cops_message { my ( $self ) = shift; my ( $version ) = shift; my ( $flags ) = shift; my ( $opcode ) = shift; my ( $clienttype ) = shift; my ( $data ) = shift; my ( $header_v ) = ( ($version<<4) | $flags ); my ( $data_block ) = pack("CCn",$header_v,$opcode,$clienttype); my ( $length ) = pack("N",length($data)+8); $data_block.=$length.$data; return $data_block; } sub encode_cops_object { my ( $self ) = shift; my ( $cnum ) = shift; my ( $ctype ) = shift; my ( $data ) = shift; my ( $align ) = 0; if ( !$data) { $data=""; } $align = length($data) % 4; print "Length of data is '".length($data)."' alignment requried is '$align'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $align = 4 - $align; if ( $align > 0 && $align <4 ) { print "Align is '$align'\n" if $self->{_GLOBAL}{'DEBUG'}>0; for ( my $tmp=0; $tmp<$align; $tmp ++ ) { print "Adding '$tmp'\n" if $self->{_GLOBAL}{'DEBUG'}>0; $data.=pack("C",0); } print "Finished alignment\n\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; } my ( $length ) = length($data)+4; my ( $data_block ) = pack("nCC",$length,$cnum,$ctype); $data_block.=$data; return $data_block; } sub generate_subscriber_id { my ( $self ) = shift; my ( $ip ) = shift; my ( $cops_object ) = ""; $cops_object = $self->encode_cops_object( 2,1, $self->_IpQuadToInt($ip) ); return $cops_object; } sub generate_gate_id { my ( $self ) = shift; my ( $id ) = shift; my ( $cops_object ) = ""; $cops_object = $self->encode_cops_object( 2,1, pack("N",$id) ); return $cops_object; } sub generate_transaction_id { my ( $self ) = shift; my ( $command ) = shift; print "\n\ntransaction id is '".$self->encode_gate_ids($command)."'\n\n\n" if $self->{_GLOBAL}{'DEBUG'}>0; $command = pack("nn",$self->{_GLOBAL}{'TRANSACTION_COUNT'} , $self->encode_gate_ids($command) ); $self->{_GLOBAL}{'TRANSACTION_COUNT'}++; my ( $cops_object ) = $self->encode_cops_object( 1,1, $command ); return $cops_object; } sub generate_decision { my ( $self ) = shift; my ( $type ) = shift; my ( $command ) = shift; my ( $flags ) = shift; my ( $payload ) = pack("nn", $command, $flags ); my ( $cops_object ) = $self->encode_cops_object( 6,$type, $payload ); return $cops_object; } sub decode_radius_attribute { # This has only been tested with the output of # FreeRadius 2.1.9 # The required perl code is included. # my ( $self ) = shift; my ( $radius_name ) = shift; my ( $radius_value ) = shift; my ( $data_return ) = shift; my ( $rad_position ) = $self->_decode_radius_attributes($radius_name); my ( $radius_array ) = $self->_decode_radius_attribute_layout( $rad_position ); if ( !$radius_array ) { return 0; } $radius_value = (split(/x/,$radius_value))[1]; if ( !$radius_value) { return 0; } my ( $radius_value_packed ) = ""; # This a bit of a hack. for (my $a=0;$aattribute_pack($rad_a); my $type_v = 0; my $name = ""; my $data = ""; my $true_length = 0; if ( $type_a=~/^string/i ) { my ( $name_s, $length_s ) = (split(/-/,$type_a))[0,1]; $data = substr($radius_value_packed,0,$length_s); $radius_value_packed = substr( $radius_value_packed, $length_s, length($radius_value_packed)-$length_s); } else { $data = unpack( $type_a, $radius_value_packed); if ( $type_a=~/^n$/ ) { $true_length=2; } if ( $type_a=~/^N$/ ) { $true_length=4; } if ( $type_a=~/^C$/ ) { $true_length=1; } $radius_value_packed = substr( $radius_value_packed, $true_length, length($radius_value_packed)-$true_length); } $rad_a=~s/^RADIUS_//g; ${$data_return}{$rad_a}=$data; if ( $rad_a=~/^EventMessageType$/i ) { ${$data_return}{'EventMessageTypeName'}=$self->_decode_radius_message_type($data); } $data=""; $true_length=0; } return 1; } sub _decode_radius_attributes { my ( $self ) = shift; my ( $radius_name ) = shift; my ( %types ) = ( 'CableLabs-Event-Message' => 0, 'CableLabs-QoS-Descriptor' => 1 ); return $types{$radius_name}; } sub _decode_radius_attribute_layout { my ( $self ) = shift; my ( $part ) = shift; my ( @headers ) = ( # CableLabs-Event-Message [ "RADIUS_EventMessageVersionID", "RADIUS_BCID_Timestamp", "RADIUS_BCID_ElementID", "RADIUS_BCID_TimeZone", "RADIUS_BCID_EventCounter", "RADIUS_EventMessageType", "RADIUS_ElementType", "RADIUS_ElementID", "RADIUS_TimeZone", "RADIUS_SequenceNumber", "RADIUS_EventTime", "RADIUS_Status", "RADIUS_Priority", "RADIUS_AttributeCount", "RADIUS_EventObject" ], # CableLabs-QoS-Descriptor [ "RADIUS_QosStatus", "RADIUS_ServiceClassName" ] ); return \$headers[$part]; } sub _decode_radius_message_type { my ( $self ) = shift; my ( $message ) = shift; my ( @message_types ) = ( "Reserved", "Signaling_Start", "Signaling_Stop", "Database_Query", "Intelligent_Peripheral_Usage_Start", "Intelligent_Peripheral_Usage_Stop", "Service_Instance", "QoS_Reserve", "QoS_Release", "Service_Activation", "Service_Deactivation", "Media_Report", "Signal_Instance", "Interconnect_(Signaling)_Start", "Interconnect_(Signaling)_Stop", "Call_Answer", "Call_Disconnect", "Time_Change", "18_Missed", "QoS_Commit", "Media_Alive", "Conference_Party_Change" ); if ( $message_types[$message] ) { return $message_types[$message]; } return "Unknown"; } sub _IpQuadToInt { my ($self)= shift; my($Quad) = shift; if ( !$Quad ) { return 0; } my($Ip1, $Ip2, $Ip3, $Ip4) = split(/\./, $Quad); my($IpInt) = (($Ip1 << 24) | ($Ip2 << 16) | ($Ip3 << 8) | $Ip4); return($IpInt); } sub _IpIntToQuad { my ( $self ) = shift; my($Int) = shift; my($Ip1) = $Int & 0xFF; $Int >>= 8; my($Ip2) = $Int & 0xFF; $Int >>= 8; my($Ip3) = $Int & 0xFF; $Int >>= 8; my($Ip4) = $Int & 0xFF; return("$Ip4.$Ip3.$Ip2.$Ip1"); } sub decode_64bit_number { # see comments on 64bit stuff. my ( $self ) = shift; my ( $message ) = shift; my ($part1,$part2) = unpack("NN",$message); $part1 = $part1<<32; $part1+=$part2; return $part1; } sub encode_64bit_number { # It seems Q does not work, well not for me # and this is the quickest way to fix it. # You STILL NEED 64 BIT SUPPORT!! my ( $self ) = shift; my ( $number ) = shift; # any bit to 64bit number in. my($test1) = $number & 0xFFFFFFFF; $number >>= 32; my($test2) = $number & 0xFFFFFFFF; my $message = pack("NN",$test2,$test1); return $message; } sub general_pack { my ( $self ) = shift; my ( $data ) = shift; my ( $array_pointer ) = shift; my ( $prefix ) = shift; my ( $packed ) = ""; if ( !$prefix ) { $prefix=""; } foreach my $env_c ( @{${$array_pointer}} ) { my $type_c = $self->attribute_pack($env_c); my $type_v = 0; my $type_push = $prefix.$env_c; if ( $env_c=~/^reserved/i ) { print "Reserved type found.\n" if $self->{_GLOBAL}{'DEBUG'}>0; $packed.=pack("C",0); } if ( $type_c=~/^string/i ) { my ( $type, $numlen ) = (split(/-/,$type_c))[0,1]; if ( !$numlen ) { $packed.=$self->align_string(${$data}{$type_push}); } else { $packed.=pack("A[$numlen]",${$data}{$type_push}); } } if ( $type_c!~/^string/i && $env_c!~/^reserved/i ) { if ( !${$data}{$type_push} ) { $type_v=0; } else { if ( $env_c=~/IP/ ) { $type_v = $self->_IpQuadToInt(${$data}{$type_push}); } else { $type_v = ${$data}{$type_push}; } } $packed.=pack( $type_c , $type_v ); } print "General Encoder Name us '$env_c' value is '$type_v' type is '$type_c'\n" if $self->{_GLOBAL}{'DEBUG'}>0; } return $packed; } =cut sub function2 { } =head1 AUTHOR shamrock@cpan.org, C<< >> =head1 BUGS - Sync messages to Cisco CMTS do not seem to work. I have tried alternative formats, headers, etc but to no avail. They do work to Motorola and Aris. I have raised this with Cisco but do not expect a response any time soon. If anyone has a packet trace with a working Synch using a Cisco CMTS that would be useful. - The different traffic profiles need work, see examples/profiles. The following examples produce an 'Unspecified error' and may be down to the values being used. If any one can help with the values that should be used, packet trace, then I can look at improving their use. Flow Spec Non-Real-Time Polling Service Real-Time Polling Service Unsolicited Grant Service Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT Please do email me if you have any issues so they can be looked at as soon as possible. You can find documentation for this module with the perldoc command. perldoc COPS::Client You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2012 shamrock@cpan.org, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of COPS::Client