From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Wed, 14 Nov 2007 23:02:17 +0000 (+0000)
Subject:  r222@brr:  dpavlin | 2007-11-15 00:01:24 +0100
X-Git-Url: http://git.rot13.org/?p=perl-cwmp.git;a=commitdiff_plain;h=12a50bdc9389aa9a6dd5011365c11ed2091106e7

 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
--- 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 $create_dump = 1;
 
 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,
-	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,
 });
diff --git a/bin/cpe-queue.pl b/bin/cpe-queue.pl
index 05dc602..f991aee 100755
--- a/bin/cpe-queue.pl
+++ b/bin/cpe-queue.pl
@@ -113,10 +113,13 @@ if ( $list ) {
 
 	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
--- a/inc/Module/Install/PRIVATE.pm
+++ b/inc/Module/Install/PRIVATE.pm
@@ -18,6 +18,7 @@ sub my_targets {
 
 dump: all
 	rm dump/* || true
+	rm -Rf queue/ || true
 	./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
--- 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
-store
+session
 background
 debug
 
@@ -30,10 +30,7 @@ CWMP::Server - description
 
   my $server = CWMP::Server->new({
   	port => 3333,
-	store => {
-		module => 'DBMDeep',
-		path => 'var/',
-	},
+	session => { ... },
 	background => 1,
 	debug => 1
   });
@@ -46,7 +43,7 @@ Options:
 
 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.
@@ -70,7 +67,7 @@ sub new {
 		CWMP::Server::Helper->new({
 			proto => 'tcp',
 			port => $self->port,
-			store => $self->store,
+			session => $self->session,
 			debug => $self->debug,
 			background => $self->background,
 		})
@@ -107,7 +104,7 @@ sub 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 };
 	}
@@ -132,21 +129,22 @@ sub process_request {
 	my $sock = $prop->{client};
 	confess "no sock in ", ref( $self ) unless $sock;
 
+	my $sess = $prop->{session} || confess "no session";
+
 	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";
 		}
 	};
 
-	if ($@) {
-		warn $@;
-	}
+	warn "ERROR: $@\n" if $@;
 
 	warn "...returning to accepting new connections\n";
 
diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm
index 25fef34..3139cbb 100644
--- 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
-store
+session
 
 sock
 state
@@ -34,7 +34,7 @@ CWMP::Session - implement logic of CWMP protocol
 
   my $server = CWMP::Session->new({
 	sock => $io_socket_object,
-	store => 'state.db',
+	store => { ... },
 	debug => 1,
 	create_dump => 1,
   });
@@ -46,10 +46,12 @@ sub new {
 	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;
 
-	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,
diff --git a/t/30-server.t b/t/30-server.t
index 4b7747c..5926000 100755
--- 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,
-	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' );
 
@@ -196,3 +199,4 @@ diag "shutdown server";
 ok( kill(9,$pid), 'kill ' . $pid );
 
 ok( waitpid($pid,0), 'waitpid' );
+