lib/CWMP/Vendor.pm

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;
}

our $cpe_faulty;

my $serial2ip = {
        'CP0636JT3SH' => '10.0.0.1',
        'CP0644JTHJ4' => '10.0.0.2',
        'CP0624BH55U' => '10.0.0.3',
};

my ( $last_ip, $last_serial );

=head2 state2serial

  my $serial = state2serial( $state );

=cut

sub state2serial {
        my $state = shift;

        my $serial = $state->{DeviceID}->{SerialNumber} || die "no DeviceID.SerialNumber in ",dump($state);
        my $ip =
                $state->{Parameter}->{'.ExternalIPAddress'} ||
                $state->{Parameter}->{
                        # fix for firmware 5.3.3.4 which returns full path
                        ( grep { m/\.ExternalIPAddress/ } keys %{ $state->{Parameter} } )[0]
                } ||
                die "no .ExternalIPAddress in ",dump($state);

        warn "## state2serial $serial $ip\n" if $debug;

        ( $last_ip, $last_serial ) = ( $ip, $serial );

        return ( $serial, $ip );
}

=head2 add_triggers

Install all custom triggers

  CWMP::Vendor->add_triggers;

=cut

sub add_triggers {

        warn __PACKAGE__, "->add_triggers\n" if $debug;

CWMP::Request->add_trigger( name => 'Fault', callback => sub {
        my ( $self, $state ) = @_;
        warn "## Fault trigger state = ",dump( $self, $state ) if $debug;
        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 ) if $debug;

        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;
1	package CWMP::Vendor;
2
3	use strict;
4	use warnings;
5
6
7	use base qw/Class::Accessor/;
8	__PACKAGE__->mk_accessors( qw/
9	debug
10	/ );
11
12	#use Carp qw/confess/;
13	use Data::Dump qw/dump/;
14
15	=head1 NAME
16
17	CWMP::Vendor - implement vendor specific logic into ACS server
18
19	=head1 METHODS
20
21	=head2 new
22
23	my $obj = CWMP::Vendor->new({
24	debug => 1
25	});
26
27	=cut
28
29	my $debug = 0;
30
31	sub new {
32	my $class = shift;
33	my $self = $class->SUPER::new( @_ );
34
35	warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
36
37	$debug = $self->debug;
38
39	return $self;
40	}
41
42	our $cpe_faulty;
43
44	my $serial2ip = {
45	'CP0636JT3SH' => '10.0.0.1',
46	'CP0644JTHJ4' => '10.0.0.2',
47	'CP0624BH55U' => '10.0.0.3',
48	};
49
50	my ( $last_ip, $last_serial );
51
52	=head2 state2serial
53
54	my $serial = state2serial( $state );
55
56	=cut
57
58	sub state2serial {
59	my $state = shift;
60
61	my $serial = $state->{DeviceID}->{SerialNumber} \|\| die "no DeviceID.SerialNumber in ",dump($state);
62	my $ip =
63	$state->{Parameter}->{'.ExternalIPAddress'} \|\|
64	$state->{Parameter}->{
65	# fix for firmware 5.3.3.4 which returns full path
66	( grep { m/\.ExternalIPAddress/ } keys %{ $state->{Parameter} } )[0]
67	} \|\|
68	die "no .ExternalIPAddress in ",dump($state);
69
70	warn "## state2serial $serial $ip\n" if $debug;
71
72	( $last_ip, $last_serial ) = ( $ip, $serial );
73
74	return ( $serial, $ip );
75	}
76
77	=head2 add_triggers
78
79	Install all custom triggers
80
81	CWMP::Vendor->add_triggers;
82
83	=cut
84
85	sub add_triggers {
86
87	warn __PACKAGE__, "->add_triggers\n" if $debug;
88
89	CWMP::Request->add_trigger( name => 'Fault', callback => sub {
90	my ( $self, $state ) = @_;
91	warn "## Fault trigger state = ",dump( $self, $state ) if $debug;
92	die "can't map fault to serial!" unless $last_serial;
93	warn "ERROR: got Fault and ingoring $last_ip $last_serial\n";
94	$cpe_faulty->{$last_serial}++;
95	});
96
97	CWMP::Request->add_trigger( name => 'Inform', callback => sub {
98	my ( $self, $state ) = @_;
99
100	my ( $serial, $ip ) = state2serial( $state );
101
102	if ( $cpe_faulty->{$serial} ) {
103	warn "## Inform trigger from $ip $serial -- IGNORED\n" if $debug;
104	return;
105	}
106
107	warn "## Inform trigger from $ip $serial\n" if $debug;
108
109	my $found = 0;
110
111	warn "### serial2ip = ",dump( $serial2ip ) if $debug;
112
113	foreach my $target_serial ( keys %$serial2ip ) {
114
115	next unless $target_serial eq $serial;
116
117	$found++;
118
119	my $target_ip = $serial2ip->{$target_serial};
120
121	if ( $ip ne $target_ip ) {
122
123	warn "CHANGE IP $ip to $target_ip for $serial\n";
124
125	return; # FIXME
126
127	my $q = CWMP::Queue->new({ id => $serial, debug => $debug }) \|\| die "no queue?";
128
129	$q->enqueue( 'SetParameterValues', {
130	'InternetGatewayDevice.LANDevice.1.LANHostConfigManagement.IPInterface.1.IPInterfaceIPAddress' => $target_ip,
131	});
132
133	} else {
134	warn "IP $ip of $serial ok\n";
135	}
136	}
137
138	warn "UNKNOWN CPE $ip $serial\nadd\t'$serial' => '$ip',\n" unless $found;
139
140	});
141
142	}#add_triggers
143
144	1;