r222@brr: dpavlin | 2007-11-15 00:01:24 +0100

 added --create-dump option to acs.pl which will force creation
 of protocol dumps even without debug level > 2

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

diff --git a/bin/acs.pl b/bin/acs.pl
index 6653653..3675088 100755 (executable)
--- a/bin/acs.pl
+++ b/bin/acs.pl
@@ -17,20 +17,25 @@ my $port = 3333;
 my $debug = 0;
 my $store_path = './';
 my $store_plugin = 'YAML';
 my $debug = 0;
 my $store_path = './';
 my $store_plugin = 'YAML';

+my $create_dump = 1;

 
 GetOptions(
        'debug+' => \$debug,
        'port=i' => \$port,
        'store-path=s' => \$store_path,
        'store-plugin=s' => \$store_plugin,
 
 GetOptions(
        'debug+' => \$debug,
        'port=i' => \$port,
        'store-path=s' => \$store_path,
        'store-plugin=s' => \$store_plugin,

+       'create_dump!' => \$create_dump,

 );
 
 my $server = CWMP::Server->new({
        port => $port,
 );
 
 my $server = CWMP::Server->new({
        port => $port,

-       store => {
-               module => $store_plugin,
-               path => $store_path,
-               debug => $debug,
+       session => {
+               store => {
+                       module => $store_plugin,
+                       path => $store_path,
+                       debug => $debug,
+               },
+               create_dump => $create_dump,

        },
        debug => $debug,
 });
        },
        debug => $debug,
 });

diff --git a/bin/cpe-queue.pl b/bin/cpe-queue.pl
index 05dc602..f991aee 100755 (executable)
--- a/bin/cpe-queue.pl
+++ b/bin/cpe-queue.pl
@@ -113,10 +113,13 @@ if ( $list ) {
 
        warn "injecting some tests commands\n";
 
 
        warn "injecting some tests commands\n";
 

-       $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );
+#      $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );

 
 

-       $q->enqueue( 'GetParameterValues', [
-               'InternetGatewayDevice.',
-       ]);
+#      $q->enqueue( 'GetParameterValues', [
+#              'InternetGatewayDevice.',
+#      ]);

 
 

+       $q->enqueue( 'GetParameterNames', [ '.ExternalIPAddress', 1 ] );
+       $q->enqueue( 'SetParameterValues', { '.ExternalIPAddress' => '192.168.1.250' });
+       $q->enqueue( 'GetParameterNames', [ '.ExternalIPAddress', 1 ] );

 }
 }

diff --git a/inc/Module/Install/PRIVATE.pm b/inc/Module/Install/PRIVATE.pm
index bce76e4..edc212e 100644 (file)
--- a/inc/Module/Install/PRIVATE.pm
+++ b/inc/Module/Install/PRIVATE.pm
@@ -18,6 +18,7 @@ sub my_targets {
 
 dump: all
        rm dump/* || true
 
 dump: all
        rm dump/* || true

+       rm -Rf queue/ || true

        ./bin/acs.pl -d -d -d -d 2>&1 | tee log
 
 html: \$(MAN1PODS) \$(MAN3PODS)
        ./bin/acs.pl -d -d -d -d 2>&1 | tee log
 
 html: \$(MAN1PODS) \$(MAN3PODS)

diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm
index e90fa13..52f9016 100644 (file)
--- a/lib/CWMP/Server.pm
+++ b/lib/CWMP/Server.pm
@@ -7,7 +7,7 @@ use warnings;
 use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
 port
 use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
 port

-store
+session

 background
 debug
 
 background
 debug
 


@@ -30,10 +30,7 @@ CWMP::Server - description
 
   my $server = CWMP::Server->new({
        port => 3333,
 
   my $server = CWMP::Server->new({
        port => 3333,

-       store => {
-               module => 'DBMDeep',
-               path => 'var/',
-       },
+       session => { ... },

        background => 1,
        debug => 1
   });
        background => 1,
        debug => 1
   });


@@ -46,7 +43,7 @@ Options:
 
 port to listen on
 
 
 port to listen on
 

-=item store
+=item session

 
 hash with key C<module> with value C<DBMDeep> if L<CWMP::Store::DBMDeep>
 is used. Other parametars are optional.
 
 hash with key C<module> with value C<DBMDeep> if L<CWMP::Store::DBMDeep>
 is used. Other parametars are optional.


@@ -70,7 +67,7 @@ sub new {
                CWMP::Server::Helper->new({
                        proto => 'tcp',
                        port => $self->port,
                CWMP::Server::Helper->new({
                        proto => 'tcp',
                        port => $self->port,

-                       store => $self->store,
+                       session => $self->session,

                        debug => $self->debug,
                        background => $self->background,
                })
                        debug => $self->debug,
                        background => $self->background,
                })


@@ -107,7 +104,7 @@ sub options {
        $self->SUPER::options($template);
 
        # new single-value options
        $self->SUPER::options($template);
 
        # new single-value options

-       foreach my $p ( qw/ store debug / ) {
+       foreach my $p ( qw/ session debug / ) {

                $prop->{ $p } ||= undef;
                $template->{ $p } = \$prop->{ $p };
        }
                $prop->{ $p } ||= undef;
                $template->{ $p } = \$prop->{ $p };
        }


@@ -132,21 +129,22 @@ sub process_request {
        my $sock = $prop->{client};
        confess "no sock in ", ref( $self ) unless $sock;
 
        my $sock = $prop->{client};
        confess "no sock in ", ref( $self ) unless $sock;
 

+       my $sess = $prop->{session} || confess "no session";
+

        eval  {
        eval  {

-               my $session = CWMP::Session->new({
-                       sock => $sock,
-                       store => $prop->{store},
-                       debug => $prop->{debug},
-               }) || confess "can't create session";
+               $sess->{sock} = $sock;
+               $sess->{debug} = $prop->{debug};
+
+               warn "## sess = ", dump( $sess );
+
+               my $session = CWMP::Session->new( $sess ) || confess "can't create session from ",dump( $sess );

 
                while ( $session->process_request ) {
                        warn "...waiting for next request from CPE...\n";
                }
        };
 
 
                while ( $session->process_request ) {
                        warn "...waiting for next request from CPE...\n";
                }
        };
 

-       if ($@) {
-               warn $@;
-       }
+       warn "ERROR: $@\n" if $@;

 
        warn "...returning to accepting new connections\n";
 
 
        warn "...returning to accepting new connections\n";
 

diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm
index 25fef34..3139cbb 100644 (file)
--- a/lib/CWMP/Session.pm
+++ b/lib/CWMP/Session.pm
@@ -8,7 +8,7 @@ use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
 debug
 create_dump
 __PACKAGE__->mk_accessors( qw/
 debug
 create_dump

-store
+session

 
 sock
 state
 
 sock
 state


@@ -34,7 +34,7 @@ CWMP::Session - implement logic of CWMP protocol
 
   my $server = CWMP::Session->new({
        sock => $io_socket_object,
 
   my $server = CWMP::Session->new({
        sock => $io_socket_object,

-       store => 'state.db',
+       store => { ... },

        debug => 1,
        create_dump => 1,
   });
        debug => 1,
        create_dump => 1,
   });


@@ -46,10 +46,12 @@ sub new {
        my $self = $class->SUPER::new( @_ );
 
        confess "need sock" unless $self->sock;
        my $self = $class->SUPER::new( @_ );
 
        confess "need sock" unless $self->sock;

+       confess "need store" unless $self->store;
+       my $peerhost = $self->sock->peerhost || confess "can't get sock->peerhost";

 
        $self->debug( 0 ) unless $self->debug;
 
 
        $self->debug( 0 ) unless $self->debug;
 

-       warn "created ", __PACKAGE__, "(", dump( @_ ), ") for ", $self->sock->peerhost, "\n" if $self->debug;
+       warn "created ", __PACKAGE__, "(", dump( @_ ), ") for $peerhost\n" if $self->debug;

 
        my $store_obj = CWMP::Store->new({
                debug => $self->debug,
 
        my $store_obj = CWMP::Store->new({
                debug => $self->debug,

diff --git a/t/30-server.t b/t/30-server.t
index 4b7747c..5926000 100755 (executable)
--- a/t/30-server.t
+++ b/t/30-server.t
@@ -32,11 +32,14 @@ my $store_module = 'YAML';
 ok( my $server = CWMP::Server->new({
        debug => $debug,
        port => $port,
 ok( my $server = CWMP::Server->new({
        debug => $debug,
        port => $port,

-       store => {
-               module => $store_module,
-               path => $store_path,
-               clean => 1,
-       },
+       session => {
+               store => {
+                       module => $store_module,
+                       path => $store_path,
+                       clean => 1,
+               },
+               create_dump => 0,
+       }

 }), 'new' );
 isa_ok( $server, 'CWMP::Server' );
 
 }), 'new' );
 isa_ok( $server, 'CWMP::Server' );
 


@@ -196,3 +199,4 @@ diag "shutdown server";
 ok( kill(9,$pid), 'kill ' . $pid );
 
 ok( waitpid($pid,0), 'waitpid' );
 ok( kill(9,$pid), 'kill ' . $pid );
 
 ok( waitpid($pid,0), 'waitpid' );

+