r218@brr: dpavlin | 2007-11-14 22:54:48 +0100

 version bump [0.10]
 - added CWMP::Vendor module which implements simple vendor specific logic
   (this is beginning of example to change IP adress of CPE based on serial)

git-svn-id: https://perl-cwmp.googlecode.com/svn/trunk@202 836a5e1a-633d-0410-964b-294494ad4392

diff --git a/Makefile.PL b/Makefile.PL
index d1efc69..d34fa11 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,7 +3,7 @@ use lib './lib';
 use inc::Module::Install;
 
 name           'CWMP';
-version                '0.09';
+version                '0.10';
 license                'GPL';
 requires       'Net::Server';
 requires       'HTTP::Daemon';

diff --git a/bin/acs.pl b/bin/acs.pl
index b4b1e8e..6653653 100755 (executable)
--- a/bin/acs.pl
+++ b/bin/acs.pl
@@ -8,7 +8,10 @@ use strict;
 
 use lib './lib';
 use CWMP::Server;
+use CWMP::Session;
+use CWMP::Vendor;
 use Getopt::Long;
+use Data::Dump qw/dump/;
 
 my $port = 3333;
 my $debug = 0;
@@ -22,7 +25,6 @@ GetOptions(
        'store-plugin=s' => \$store_plugin,
 );
 
-
 my $server = CWMP::Server->new({
        port => $port,
        store => {
@@ -32,5 +34,8 @@ my $server = CWMP::Server->new({
        },
        debug => $debug,
 });
+
+CWMP::Vendor->add_triggers;
+
 $server->run();
 

diff --git a/bin/cpe-queue.pl b/bin/cpe-queue.pl
index c9f9c21..05dc602 100755 (executable)
--- a/bin/cpe-queue.pl
+++ b/bin/cpe-queue.pl
@@ -113,13 +113,10 @@ if ( $list ) {
 
        warn "injecting some tests commands\n";
 
-       $q->enqueue( 'SetParameterValues', {
-               'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
-#              'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1,
-       });
+       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );
 
        $q->enqueue( 'GetParameterValues', [
-               'InternetGatewayDevice.DeviceInfo.ProvisioningCode',
+               'InternetGatewayDevice.',
        ]);
 
 }

diff --git a/inc/Module/Install/PRIVATE.pm b/inc/Module/Install/PRIVATE.pm
index 455e153..bce76e4 100644 (file)
--- a/inc/Module/Install/PRIVATE.pm
+++ b/inc/Module/Install/PRIVATE.pm
@@ -18,7 +18,7 @@ sub my_targets {
 
 dump: all
        rm dump/* || true
-       ./bin/acs.pl -d -d -d --protocol-dump 2>&1 | tee log
+       ./bin/acs.pl -d -d -d -d 2>&1 | tee log
 
 html: \$(MAN1PODS) \$(MAN3PODS)
        test -d html || mkdir html

diff --git a/lib/CWMP/Request.pm b/lib/CWMP/Request.pm
index 1646cc1..b85892d 100644 (file)
--- a/lib/CWMP/Request.pm
+++ b/lib/CWMP/Request.pm
@@ -56,6 +56,7 @@ my $rules =  [
                        # Name/Value tags must be case insnesitive
                        my $value = (grep( /value/i, keys %$tag_hash ))[0];
                        $state->{Parameter}->{ _tag($tag_hash, 'Name', '_content') } = _tag($tag_hash, 'Value', '_content' );
+                       $state->{_trigger} = 'ParameterValue';
                },
 
 ];
@@ -151,7 +152,8 @@ sub parse {
        $state = {};
        $parser->parsestring( $xml );
        if ( my $trigger = $state->{_trigger} ) {
-               __PACKAGE__->call_trigger( $trigger, $state );
+               warn "### call_trigger( $trigger )\n";
+               $self->call_trigger( $trigger, $state );
        }
        # XXX don't propagate _trigger (useful?)
        delete( $state->{_trigger} );

diff --git a/lib/CWMP/Vendor.pm b/lib/CWMP/Vendor.pm
new file mode 100644 (file)
index 0000000..2cf6a01
--- /dev/null
+++ b/lib/CWMP/Vendor.pm
@@ -0,0 +1,123 @@
+package CWMP::Vendor;
+
+use strict;
+use warnings;
+
+
+use base qw/Class::Accessor/;
+__PACKAGE__->mk_accessors( qw/
+debug
+/ );
+
+#use Carp qw/confess/;
+use Data::Dump qw/dump/;
+
+=head1 NAME
+
+CWMP::Vendor - implement vendor specific logic into ACS server
+
+=head1 METHODS
+
+=head2 new
+
+  my $obj = CWMP::Vendor->new({
+       debug => 1
+  });
+
+=cut
+
+my $debug = 0;
+
+sub new {
+       my $class = shift;
+       my $self = $class->SUPER::new( @_ );
+
+       warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
+
+       $debug = $self->debug;
+
+       return $self;
+}
+
+my $cpe_faulty;
+
+my $serial2ip = {
+       'CP0636JT3SH' => '192.168.1.242',
+       'CP0644JTHJ4' => '192.168.1.253',
+};
+
+my ( $last_ip, $last_serial );
+
+sub state2serial {
+       my $state = shift;
+
+       my $serial = $state->{DeviceID}->{SerialNumber} || die "no serial?";
+       my $ip = $state->{Parameter}->{'.ExternalIPAddress'} || die "no ip?";
+
+       warn "## state2serial $serial $ip\n";
+
+       ( $last_ip, $last_serial ) = ( $ip, $serial );
+
+       return ( $serial, $ip );
+}
+
+sub add_triggers {
+
+       warn __PACKAGE__, "->add_triggers\n";
+
+CWMP::Request->add_trigger( name => 'Fault', callback => sub {
+       my ( $self, $state ) = @_;
+       warn "## Fault trigger state = ",dump( $self, $state );
+       die "can't map fault to serial!" unless $last_serial;
+       warn "ERROR: got Fault and ingoring $last_ip $last_serial\n";
+       $cpe_faulty->{$last_serial}++;
+});
+
+CWMP::Request->add_trigger( name => 'Inform', callback => sub {
+       my ( $self, $state ) = @_;
+
+       my ( $serial, $ip ) = state2serial( $state );
+
+       if ( $cpe_faulty->{$serial} ) {
+               warn "## Inform trigger from $ip $serial -- IGNORED\n"; # if $debug;
+               return;
+       }
+
+       warn "## Inform trigger from $ip $serial\n"; # if $debug;
+
+       my $found = 0;
+
+       warn "### serial2ip = ",dump( $serial2ip );
+
+       foreach my $target_serial ( keys %$serial2ip ) {
+
+               next unless $target_serial eq $serial;
+
+               $found++;
+
+               my $target_ip = $serial2ip->{$target_serial};
+
+               if ( $ip ne $target_ip ) {
+
+                       warn "CHANGE IP $ip to $target_ip for $serial\n";
+
+                       return; # FIXME
+
+                       my $q = CWMP::Queue->new({ id => $serial, debug => $debug }) || die "no queue?";
+
+                       $q->enqueue( 'SetParameterValues', {
+                               'InternetGatewayDevice.LANDevice.1.LANHostConfigManagement.IPInterface.1.IPInterfaceIPAddress' => $target_ip,
+                       });
+
+               } else {
+                       warn "IP $ip of $serial ok\n";
+               }
+       }
+
+       warn "UNKNOWN CPE $ip $serial\nadd\t'$serial' => '$ip',\n" unless $found;
+
+});
+
+}#add_triggers
+
+1;