use inc::Module::Install;
name 'CWMP';
-version '0.06';
+version '0.07';
license 'GPL';
requires 'Net::Server';
requires 'HTTP::Daemon';
=head1 DESCRIPTION
+This is free, open source implementation of
+
+DSL Forum: TR-069 - CPE WAN Management Protocol, May 2004
+
+In essence, it's relaxed SOAP server which eats garbage and tries to produce
+standard compliant results.
+
+Standard defines following methods:
+
CPE methods Responding Calling
GetRPCMethods Required Optional
Kicked Optional Optional
+To see implemented methods take a look in L<CWMP::Methods>
+
=head1 AUTHOR
Dobrica Pavlinusic, C<< dpavlin@rot13.org >>
--- /dev/null
+package CWMP::Methods;
+
+use strict;
+use warnings;
+
+
+use base qw/Class::Accessor/;
+__PACKAGE__->mk_accessors( qw/debug/ );
+
+use XML::Generator;
+use Carp qw/confess/;
+use Data::Dump qw/dump/;
+
+=head1 NAME
+
+CWMP::Methods - generate SOAP meesages for CPE
+
+=head2 METHODS
+
+=head2 new
+
+ my $response = CWMP::Methods->new({ debug => 1 });
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new( @_ );
+
+ warn "created XML::Generator object\n" if $self->debug;
+
+ return $self;
+}
+
+
+my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
+my $soap = [ soap => 'http://schemas.xmlsoap.org/soap/envelope/' ];
+my $xsd = [ xsd => 'http://www.w3.org/2001/XMLSchema-instance' ];
+
+=head2 InformResponse
+
+ $response->InformResponse( $state );
+
+=cut
+
+sub InformResponse {
+ my ( $self, $state ) = @_;
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+ $X->InformResponse( $cwmp,
+ $X->MaxEnvelopes( $cwmp, 1 )
+ );
+ });
+}
+
+=head2 GetRPCMethods
+
+ $response->GetRPCMethods( $state );
+
+=cut
+
+sub GetRPCMethods {
+ my ( $self, $state ) = @_;
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+ $X->GetRPCMethods();
+ });
+};
+
+=head2 Reboot
+
+ $response->Reboot( $state );
+
+=cut
+
+sub Reboot {
+ my ( $self, $state ) = @_;
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+ $X->Reboot();
+ });
+}
+
+=head2 GetParameterNames
+
+ $response->GetParameterNames( $state, $ParameterPath, $NextLevel );
+
+=cut
+
+sub GetParameterNames {
+ my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
+ $ParameterPath ||= ''; # all
+ $NextLevel ||= 0; # all
+ warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug;
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+
+ $X->GetParameterNames( $cwmp,
+ $X->ParameterPath( $cwmp, $ParameterPath ),
+ $X->NextLevel( $cwmp, $NextLevel ),
+ );
+ });
+}
+
+=head2 GetParameterValues
+
+ $response->GetParameterValues( $state, $ParameterNames );
+
+=cut
+
+sub GetParameterValues {
+ my $self = shift;
+ my $state = shift;
+ my @ParameterNames = @_;
+ confess "need ParameterNames" unless @ParameterNames;
+ warn "# GetParameterValues", dump( @ParameterNames ), "\n" if $self->debug;
+
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+
+ $X->GetParameterValues( $cwmp,
+ $X->ParameterNames( $cwmp,
+ map {
+ $X->string( $xsd, $_ )
+ } @ParameterNames
+ )
+ );
+ });
+}
+
+=head2 xml
+
+Used to implement methods which modify just body of soap message.
+For examples, see source of this module.
+
+=cut
+
+sub xml {
+ my $self = shift;
+
+ my ( $state, $closure ) = @_;
+
+ confess "no state?" unless ($state);
+ confess "no body closure" unless ( $closure );
+
+ confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
+
+ #warn "state used to generate xml = ", dump( $state ) if $self->debug;
+
+ my $X = XML::Generator->new(':pretty');
+
+ return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
+ $X->Header( $soap,
+ $X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
+ $X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} || 0 ),
+ ),
+ $X->Body( $soap, $closure->( $X, $state ) ),
+ );
+}
+
+1;
+++ /dev/null
-package CWMP::Response;
-
-use strict;
-use warnings;
-
-
-use base qw/Class::Accessor/;
-__PACKAGE__->mk_accessors( qw/debug/ );
-
-use XML::Generator;
-use Carp qw/confess/;
-use Data::Dump qw/dump/;
-
-=head1 NAME
-
-CWMP::Response - generate SOAP meesage for response
-
-=head2 METHODS
-
-=head2 new
-
- my $response = CWMP::Response->new({ debug => 1 });
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new( @_ );
-
- warn "created XML::Generator object\n" if $self->debug;
-
- return $self;
-}
-
-
-my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
-my $soap = [ soap => 'http://schemas.xmlsoap.org/soap/envelope/' ];
-my $xsd = [ xsd => 'http://www.w3.org/2001/XMLSchema-instance' ];
-
-=head2 InformResponse
-
- $response->InformResponse( $state );
-
-=cut
-
-sub InformResponse {
- my ( $self, $state ) = @_;
- $self->xml( $state, sub {
- my ( $X, $state ) = @_;
- $X->InformResponse( $cwmp,
- $X->MaxEnvelopes( $cwmp, 1 )
- );
- });
-}
-
-=head2 GetRPCMethods
-
- $response->GetRPCMethods( $state );
-
-=cut
-
-sub GetRPCMethods {
- my ( $self, $state ) = @_;
- $self->xml( $state, sub {
- my ( $X, $state ) = @_;
- $X->GetRPCMethods();
- });
-};
-
-=head2 Reboot
-
- $response->Reboot( $state );
-
-=cut
-
-sub Reboot {
- my ( $self, $state ) = @_;
- $self->xml( $state, sub {
- my ( $X, $state ) = @_;
- $X->Reboot();
- });
-}
-
-=head2 GetParameterNames
-
- $response->GetParameterNames( $state, $ParameterPath, $NextLevel );
-
-=cut
-
-sub GetParameterNames {
- my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
- $ParameterPath ||= ''; # all
- $NextLevel ||= 0; # all
- warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug;
- $self->xml( $state, sub {
- my ( $X, $state ) = @_;
-
- $X->GetParameterNames( $cwmp,
- $X->ParameterPath( $cwmp, $ParameterPath ),
- $X->NextLevel( $cwmp, $NextLevel ),
- );
- });
-}
-
-=head2 GetParameterValues
-
- $response->GetParameterValues( $state, $ParameterNames );
-
-=cut
-
-sub GetParameterValues {
- my $self = shift;
- my $state = shift;
- my @ParameterNames = @_;
- confess "need ParameterNames" unless @ParameterNames;
- warn "# GetParameterValues", dump( @ParameterNames ), "\n" if $self->debug;
-
- $self->xml( $state, sub {
- my ( $X, $state ) = @_;
-
- $X->GetParameterValues( $cwmp,
- $X->ParameterNames( $cwmp,
- map {
- $X->string( $xsd, $_ )
- } @ParameterNames
- )
- );
- });
-}
-
-=head2 xml
-
-Used to implement methods which modify just body of soap message.
-For examples, see source of this module.
-
-=cut
-
-sub xml {
- my $self = shift;
-
- my ( $state, $closure ) = @_;
-
- confess "no state?" unless ($state);
- confess "no body closure" unless ( $closure );
-
- confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
-
- #warn "state used to generate xml = ", dump( $state ) if $self->debug;
-
- my $X = XML::Generator->new(':pretty');
-
- return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
- $X->Header( $soap,
- $X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
- $X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} || 0 ),
- ),
- $X->Body( $soap, $closure->( $X, $state ) ),
- );
-}
-
-1;
use File::Slurp;
use CWMP::Request;
-use CWMP::Response;
+use CWMP::Methods;
use CWMP::Store;
=head1 NAME
push @args, @a;
}
- my $response = CWMP::Response->new({ debug => $self->debug });
+ my $response = CWMP::Methods->new({ debug => $self->debug });
if ( $response->can( $dispatch ) ) {
warn ">>> dispatching to $dispatch\n";
BEGIN {
use_ok('CWMP::Server');
use_ok('CWMP::Request');
- use_ok('CWMP::Response');
+ use_ok('CWMP::Methods');
use_ok('CWMP::Store');
}
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+my $debug = shift @ARGV;
+
+use Test::More tests => 14;
+use Data::Dump qw/dump/;
+use Cwd qw/abs_path/;
+use File::Slurp;
+use blib;
+
+BEGIN {
+ use_ok('CWMP::Methods');
+}
+
+ok(my $abs_path = abs_path($0), "abs_path");
+$abs_path =~ s!/[^/]*$!/!; #!fix-vim
+
+ok( my $response = CWMP::Methods->new({ debug => $debug }), 'new' );
+isa_ok( $response, 'CWMP::Methods' );
+
+sub check_response {
+ my $command = shift || die "no command?";
+
+ my $state = {
+ ID => 42,
+ };
+
+ diag "check_response $command",dump( 'state', @_ ) if $debug;
+ ok( my $xml = $response->$command( $state, @_ ), "generate response $command" . dump(@_) );
+
+ my $file = "$abs_path/response/$command.xml";
+
+ if ( ! -e $file ) {
+ diag "creating $file";
+ write_file( $file, $xml );
+ }
+
+ my $template_xml = read_file( $file ) || die "can't read template xml $file: $!";
+
+ is( $xml, $template_xml, "compare $command" );
+}
+
+check_response( 'InformResponse' );
+check_response( 'GetRPCMethods' );
+check_response( 'Reboot' );
+check_response( 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.SerialNumber' );
+check_response( 'GetParameterValues', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 'InternetGatewayDevice.DeviceInfo.VendorConfigFile.' );
+++ /dev/null
-#!/usr/bin/perl
-use strict;
-use warnings;
-
-my $debug = shift @ARGV;
-
-use Test::More tests => 14;
-use Data::Dump qw/dump/;
-use Cwd qw/abs_path/;
-use File::Slurp;
-use blib;
-
-BEGIN {
- use_ok('CWMP::Response');
-}
-
-ok(my $abs_path = abs_path($0), "abs_path");
-$abs_path =~ s!/[^/]*$!/!; #!fix-vim
-
-ok( my $response = CWMP::Response->new({ debug => $debug }), 'new' );
-isa_ok( $response, 'CWMP::Response' );
-
-sub check_response {
- my $command = shift || die "no command?";
-
- my $state = {
- ID => 42,
- };
-
- diag "check_response $command",dump( 'state', @_ ) if $debug;
- ok( my $xml = $response->$command( $state, @_ ), "generate response $command" . dump(@_) );
-
- my $file = "$abs_path/response/$command.xml";
-
- if ( ! -e $file ) {
- diag "creating $file";
- write_file( $file, $xml );
- }
-
- my $template_xml = read_file( $file ) || die "can't read template xml $file: $!";
-
- is( $xml, $template_xml, "compare $command" );
-}
-
-check_response( 'InformResponse' );
-check_response( 'GetRPCMethods' );
-check_response( 'Reboot' );
-check_response( 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.SerialNumber' );
-check_response( 'GetParameterValues', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 'InternetGatewayDevice.DeviceInfo.VendorConfigFile.' );