use CWMP::Parser;
use CWMP::Methods;
use CWMP::Store;
+use CWMP::Vendor;
#use Devel::LeakTrace::Fast;
return $self;
}
-my $vendor_data = {
- 'InternetGatewayDevice.ManagementServer.PeriodicInformEnable' => 1,
- 'InternetGatewayDevice.ManagementServer.PeriodicInformInterval' => 17,
- 'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
-};
-
-our $set_tried;
-
-sub vendor_hook {
- my ( $self, $uid, $stored, $queue ) = @_;
- warn "# vendor_hook $uid ",dump($stored) if $self->debug > 2;
-
- my @refresh;
-
- foreach my $n ( keys %$vendor_data ) {
- if ( defined $stored->{$n} && $vendor_data->{$n} ne $stored->{$n} ) {
- next if $set_tried->{$uid}->{$n}++;
- push @refresh, $n;
- $queue->enqueue( 'SetParameterValues', { $n => $vendor_data->{$n} } );
- }
- }
-
- if ( @refresh ) {
- $queue->enqueue( 'GetParameterValues', [ @refresh ] );
- warn "vendor_hook $uid SetParameterValues ", dump( @refresh );
- return $self->dispatch( 'GetParameterValues', [ @refresh ] );
- }
-
- return;
-}
-
=head2 process_request
One request from client/response from server cycle. Call multiple times to
my $uid = $self->store->state_to_uid( $state );
- my $to_uid = join(" ", grep { defined($_) } "to $uid",
- # board
- $state->{Parameter}->{'InternetGatewayDevice.DeviceInfo.HardwareVersion'},
- # version
- $state->{Parameter}->{'InternetGatewayDevice.DeviceInfo.SoftwareVersion'},
- # summary
-# $state->{Parameter}->{'InternetGatewayDevice.DeviceSummary'},
- ) . "\n";
-
my $queue = CWMP::Queue->new({
id => $uid,
debug => $self->debug,
});
+
$xml = '';
+ my $status = 200;
if ( my $dispatch = $state->{_dispatch} ) {
$xml = $self->dispatch( $dispatch );
$xml = $self->dispatch( $job->dispatch );
$job->finish;
} else {
- my $stored = $self->store->get_state( $uid );
- if ( ! defined $stored->{ParameterInfo} ) {
- $xml = $self->dispatch( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] );
- } else {
- my @params =
- grep { m/\.$/ }
- keys %{ $stored->{ParameterInfo} }
- ;
- if ( @params ) {
- warn "# GetParameterNames ", dump( @params );
- my $first = shift @params;
- delete $stored->{ParameterInfo}->{$first};
- $xml = $self->dispatch( 'GetParameterNames', [ $first, 1 ] );
- foreach ( @params ) {
- $queue->enqueue( 'GetParameterNames', [ $_, 1 ] );
- delete $stored->{ParameterInfo}->{ $_ };
- }
- $self->store->set_state( $uid, $stored );
- } else {
-
- my @params = sort
- grep { ! exists $stored->{Parameter}->{$_} }
- grep { ! m/\.$/ && ! m/NumberOfEntries/ }
- keys %{ $stored->{ParameterInfo} }
- ;
- if ( @params ) {
- warn "# GetParameterValues ", dump( @params );
- my $first = shift @params;
- $xml = $self->dispatch( 'GetParameterValues', [ $first ] );
- while ( @params ) {
- my @chunk = splice @params, 0, 16; # FIXME 16 seems to be max
- $queue->enqueue( 'GetParameterValues', [ @chunk ] );
- }
-
- } elsif ( $xml = $self->vendor_hook( $uid, $stored, $queue ) ) {
-
- warn "vendor_hook triggered\n";
-
- } else {
-
- warn ">>> empty response $to_uid";
- $state->{NoMoreRequests} = 1;
- $xml = '';
-
- }
- }
+ my @dispatch = CWMP::Vendor->all_parameters( $self->store, $uid, $queue );
+ @dispatch = CWMP::Vendor->vendor_config( $self->store, $uid, $queue ) unless @dispatch;
+ $xml = $self->dispatch( @dispatch ) if @dispatch;
+ if ( ! $xml ) {
+ warn ">>> no more work for $uid sending empty response\n";
+ $state->{NoMoreRequests} = 1;
+ $xml = '';
+ $status = 204;
}
}
- my $status = length($xml) ? 200 : 204;
-
my $out = join("\r\n",
"HTTP/1.1 $status OK",
'Content-Type: text/xml; charset="utf-8"',
$out .= "Content-Length: " . length( $xml ) . "\r\n\r\n";
$out .= $xml if length($xml);
- warn "### request over for $uid\n" if $self->debug;
-
return $out; # next request
};
use strict;
use warnings;
-
-use base qw/Class::Accessor/;
-__PACKAGE__->mk_accessors( qw/
-debug
-/ );
+use YAML qw();
#use Carp qw/confess/;
use Data::Dump qw/dump/;
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 );
+sub all_parameters {
+ my ( $self, $store, $uid, $queue ) = @_;
-=head2 state2serial
+ my $stored = $store->get_state( $uid );
- my $serial = state2serial( $state );
+ return ( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] )
+ if ! defined $stored->{ParameterInfo};
-=cut
-
-sub state2serial {
- my $state = shift;
-
- my $serial = $state->{DeviceId}->{SerialNumber} || die "no DeviceId.SerialNumber in ",dump($state);
- chomp($serial);
- 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);
+ my @params =
+ grep { m/\.$/ }
+ keys %{ $stored->{ParameterInfo} }
+ ;
- 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
+ if ( @params ) {
+ warn "# GetParameterNames ", dump( @params );
+ my $first = shift @params;
+ delete $stored->{ParameterInfo}->{$first};
-sub add_triggers {
-}
-
-1;
-
-__END__
-
- 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;
+ foreach ( @params ) {
+ $queue->enqueue( 'GetParameterNames', [ $_, 1 ] );
+ delete $stored->{ParameterInfo}->{ $_ };
+ }
+ $store->set_state( $uid, $stored );
+
+ return ( 'GetParameterNames', [ $first, 1 ] );
+
+ } else {
+
+ my @params = sort
+ grep { ! exists $stored->{Parameter}->{$_} }
+ grep { ! m/\.$/ && ! m/NumberOfEntries/ }
+ keys %{ $stored->{ParameterInfo} }
+ ;
+ if ( @params ) {
+ warn "# GetParameterValues ", dump( @params );
+ my $first = shift @params;
+ while ( @params ) {
+ my @chunk = splice @params, 0, 16; # FIXME 16 seems to be max
+ $queue->enqueue( 'GetParameterValues', [ @chunk ] );
+ }
+
+ return ( 'GetParameterValues', [ $first ] );
+ }
}
- 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};
+ return;
+}
- if ( $ip ne $target_ip ) {
+our $set_tried;
- warn "CHANGE IP $ip to $target_ip for $serial\n";
+sub vendor_config {
+ my ( $self, $store, $uid, $queue ) = @_;
- return; # FIXME
+ my $stored = $store->get_state( $uid );
- my $q = CWMP::Queue->new({ id => $serial, debug => $debug }) || die "no queue?";
+ my @refresh;
- $q->enqueue( 'SetParameterValues', {
- 'InternetGatewayDevice.LANDevice.1.LANHostConfigManagement.IPInterface.1.IPInterfaceIPAddress' => $target_ip,
- });
+ my $vendor = YAML::LoadFile 'vendor.yaml';
+ $vendor = $vendor->{Parameter} || die "no Parameter in vendor.yaml";
- } else {
- warn "IP $ip of $serial ok\n";
+ foreach my $n ( keys %$vendor ) {
+ if ( defined $stored->{$n} && $vendor->{$n} ne $stored->{$n} ) {
+ next if $set_tried->{$uid}->{$n}++;
+ push @refresh, $n;
+ $queue->enqueue( 'SetParameterValues', { $n => $vendor->{$n} } );
}
}
- warn "UNKNOWN CPE $ip $serial\nadd\t'$serial' => '$ip',\n" unless $found;
-
-});
+ if ( @refresh ) {
+ $queue->enqueue( 'GetParameterValues', [ @refresh ] );
+ warn "vendor_hook $uid SetParameterValues ", dump( @refresh );
+ return ( 'GetParameterValues', [ @refresh ] );
+ }
-}#add_triggers
+ return;
+}
1;