From fec1acf5d1dfce1a661535d2b40b0e9d97de6005 Mon Sep 17 00:00:00 2001 From: Dobrica Pavlinusic Date: Mon, 12 Nov 2007 22:03:01 +0000 Subject: [PATCH] r206@brr: dpavlin | 2007-11-12 23:02:21 +0100 - move protocol dump to new cpe-queue.pl command - queue now stores data in YAML to preserve perl structures intact - queue jobs are now finished correctly - remove all traces of default_queue git-svn-id: https://perl-cwmp.googlecode.com/svn/trunk@196 836a5e1a-633d-0410-964b-294494ad4392 --- bin/acs.pl | 27 ----------------------- bin/cpe-queue.pl | 53 +++++++++++++++++++++++++++++++++++++++++++++ lib/CWMP/Queue.pm | 44 ++++++++++++++++++++++++++++--------- lib/CWMP/Server.pm | 19 +++++----------- lib/CWMP/Session.pm | 17 ++++++++------- t/06-queue.t | 14 +++++++----- t/30-server.t | 2 ++ 7 files changed, 111 insertions(+), 65 deletions(-) create mode 100755 bin/cpe-queue.pl diff --git a/bin/acs.pl b/bin/acs.pl index f143b4c..b4b1e8e 100755 --- a/bin/acs.pl +++ b/bin/acs.pl @@ -14,40 +14,14 @@ my $port = 3333; my $debug = 0; my $store_path = './'; my $store_plugin = 'YAML'; -my $protocol_dump = 0; GetOptions( 'debug+' => \$debug, 'port=i' => \$port, 'store-path=s' => \$store_path, 'store-plugin=s' => \$store_plugin, - 'protocol-dump!' => \$protocol_dump, ); -my $queue; - -if ( $protocol_dump ) { - - warn "generating dump of xml protocol with CPE\n"; - - $queue = [ - 'GetRPCMethods', - 'GetParameterNames', -# [ 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ], -# [ 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.', 1 ], - [ 'GetParameterValues', - 'InternetGatewayDevice.DeviceInfo.SerialNumber', - 'InternetGatewayDevice.DeviceInfo.VendorConfigFile.', - 'InternetGatewayDevice.DeviceInfo.X_000E50_Country', - ], - [ 'SetParameterValues', - 'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision', -# 'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1, - ], -# 'Reboot', - ]; -}; - my $server = CWMP::Server->new({ port => $port, @@ -57,7 +31,6 @@ my $server = CWMP::Server->new({ debug => $debug, }, debug => $debug, - default_queue => [ $queue ], }); $server->run(); diff --git a/bin/cpe-queue.pl b/bin/cpe-queue.pl new file mode 100755 index 0000000..2135884 --- /dev/null +++ b/bin/cpe-queue.pl @@ -0,0 +1,53 @@ +#!/usr/bin/perl -w + +# cpe-queue.pl +# +# 11/12/2007 10:03:53 PM CET <> + +use strict; + +use lib './lib'; +use CWMP::Queue; +use Getopt::Long; + +my $debug = 0; +my $protocol_dump = 1; + +GetOptions( + 'debug+' => \$debug, + 'protocol-dump!' => \$protocol_dump, +); + +my $id = shift @ARGV || die "usage: $0 CPE_id [--protocol-dump]\n"; + +$id =~ s!^.*queue/+!!; +$id =~ s!/+$!!; #! + +die "ID isn't valid: $id\n" unless $id =~ m/^\w+$/; + +my $q = CWMP::Queue->new({ id => $id, debug => $debug }); + +if ( $protocol_dump ) { + + warn "generating dump of xml protocol with CPE\n"; + + $q->enqueue( 'GetRPCMethods' ); + $q->enqueue( 'GetParameterNames' ); + +# $q->enqueue( 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ); +# $q->enqueue( 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.', 1 ); + + $q->enqueue( 'GetParameterValues', + 'InternetGatewayDevice.DeviceInfo.SerialNumber', + 'InternetGatewayDevice.DeviceInfo.VendorConfigFile.', + 'InternetGatewayDevice.DeviceInfo.X_000E50_Country', + ); + $q->enqueue( 'SetParameterValues', + 'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision', +# 'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1, + ); + +# $q->enqueue( 'Reboot' ); + +} + diff --git a/lib/CWMP/Queue.pm b/lib/CWMP/Queue.pm index 014f5db..bf4595e 100644 --- a/lib/CWMP/Queue.pm +++ b/lib/CWMP/Queue.pm @@ -16,6 +16,7 @@ use Data::Dump qw/dump/; use File::Spec; use File::Path qw/mkpath/; use IPC::DirQueue; +use YAML qw/Dump/; use Carp qw/confess/; =head1 NAME @@ -74,16 +75,18 @@ sub enqueue { my $self = shift; my $id = $self->id; - my $data = {@_} || confess "need data"; - - warn "## enqueue( $id, ", dump( $data ), " )\n" if $self->debug; - - $self->{dq}->{$id}->enqueue_string( $id, $data ); + + warn "## enqueue( $id, ", dump( @_ ), " )\n" if $self->debug; + + $self->{dq}->{$id}->enqueue_string( Dump( @_ ) ); } =head2 dequeue - my $data = $q->dequeue; + my $job = $q->dequeue; + my $dispatch = $job->dispatch; + # after dispatch is processed + $job->finish; =cut @@ -92,11 +95,32 @@ sub dequeue { my $id = $self->id; - my $data = $self->{dq}->{$id}->pickup_queued_job(); - return unless defined $data; + my $job = $self->{dq}->{$id}->pickup_queued_job(); + return unless defined $job; - warn "## dequeue( $id ) = ", dump( $data ), " )\n" if $self->debug; + warn "## dequeue( $id ) = ", dump( $job ), " )\n" if $self->debug; - return $data->{metadata}; + return CWMP::Queue::Job->new({ job => $job }); } + +package CWMP::Queue::Job; + +use base qw/Class::Accessor/; +__PACKAGE__->mk_accessors( qw/ +job +/ ); + +use YAML qw/LoadFile/; + +sub dispatch { + my $self = shift; + my $path = $self->job->get_data_path || die "get_data_path?"; + return LoadFile( $path ) || die "can't read $path: $!"; +} + +sub finish { + my $self = shift; + $self->job->finish; +} + 1; diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm index d64e472..e90fa13 100644 --- a/lib/CWMP/Server.pm +++ b/lib/CWMP/Server.pm @@ -8,7 +8,6 @@ use base qw/Class::Accessor/; __PACKAGE__->mk_accessors( qw/ port store -default_queue background debug @@ -16,6 +15,7 @@ server / ); use CWMP::Session; +use CWMP::Queue; use Carp qw/confess/; use Data::Dump qw/dump/; @@ -34,7 +34,6 @@ CWMP::Server - description module => 'DBMDeep', path => 'var/', }, - default_queue => [ qw/GetRPCMethods GetParameterNames/ ], background => 1, debug => 1 }); @@ -52,10 +51,6 @@ port to listen on hash with key C with value C if L is used. Other parametars are optional. -=item default_queue - -commands which will be issued to every CPE on connect - =back =cut @@ -75,7 +70,6 @@ sub new { CWMP::Server::Helper->new({ proto => 'tcp', port => $self->port, - default_queue => $self->default_queue, store => $self->store, debug => $self->debug, background => $self->background, @@ -119,10 +113,10 @@ sub options { } # new multi-value options - foreach my $p ( qw/ default_queue / ) { - $prop->{ $p } ||= []; - $template->{ $p } = $prop->{ $p }; - } +# foreach my $p ( qw/ default_queue / ) { +# $prop->{ $p } ||= []; +# $template->{ $p } = $prop->{ $p }; +# } } @@ -138,12 +132,9 @@ sub process_request { my $sock = $prop->{client}; confess "no sock in ", ref( $self ) unless $sock; - warn "default CPE queue ", dump( $prop->{default_queue} ), "\n" if defined($prop->{default_queue}); - eval { my $session = CWMP::Session->new({ sock => $sock, - queue => $prop->{default_queue}, store => $prop->{store}, debug => $prop->{debug}, }) || confess "can't create session"; diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm index f30dc59..488bd4f 100644 --- a/lib/CWMP/Session.pm +++ b/lib/CWMP/Session.pm @@ -11,7 +11,6 @@ store sock state -queue store / ); @@ -35,10 +34,6 @@ CWMP::Session - implement logic of CWMP protocol my $server = CWMP::Session->new({ sock => $io_socket_object, store => 'state.db', - queue => [ - 'GetRPCMethods', - [ 'GetParameterValyes', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ], - ], debug => 1, }); @@ -153,13 +148,18 @@ sub process_request { )."\r\n"); $sock->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} ); - + + my $queue = CWMP::Queue->new({ + id => $self->store->ID_to_uid( $state->{ID}, $state ), + debug => $self->debug, + }); + my $job; $xml = ''; if ( my $dispatch = $state->{_dispatch} ) { $xml = $self->dispatch( $dispatch ); - } elsif ( $dispatch = shift @{ $self->queue } ) { - $xml = $self->dispatch( $dispatch ); + } elsif ( $job = $queue->dequeue ) { + $xml = $self->dispatch( $job->dispatch ); } elsif ( $size == 0 ) { warn ">>> no more queued commands, closing connection\n"; return 0; @@ -174,6 +174,7 @@ sub process_request { warn ">>>> " . $sock->peerhost . " [" . localtime() . "] sent ", length( $xml )," bytes\n"; + $job->finish if $job; warn "### request over\n" if $self->debug; return 1; # next request diff --git a/t/06-queue.t b/t/06-queue.t index e8cfe3e..e56b93e 100755 --- a/t/06-queue.t +++ b/t/06-queue.t @@ -4,7 +4,7 @@ use warnings; my $debug = shift @ARGV; -use Test::More tests => 129; +use Test::More tests => 213; use Data::Dump qw/dump/; use lib 'lib'; @@ -23,16 +23,18 @@ ok( my $obj = CWMP::Queue->new({ isa_ok( $obj, 'CWMP::Queue' ); for my $i ( 1 .. 42 ) { - ok( $obj->enqueue( + ok( $obj->enqueue({ i => $i, foo => 'bar', - ), "enqueue $i" ); + }), "enqueue $i" ); }; my $i = 1; -while ( my $data = $obj->dequeue ) { - ok( $data, "dequeue $i" ); - cmp_ok( $data->{i}, '==', $i, "i == $i" ); +while ( my $job = $obj->dequeue ) { + ok( $job, "dequeue $i" ); + ok( my $dispatch = $job->dispatch, "dispatch $i" ); + cmp_ok( $dispatch->{i}, '==', $i, "i == $i" ); + ok( $job->finish, "finish $i" ); $i++; } diff --git a/t/30-server.t b/t/30-server.t index d8bcbd4..4b7747c 100755 --- a/t/30-server.t +++ b/t/30-server.t @@ -191,6 +191,8 @@ my $state = { is_deeply( $store->current_store->get_state( 'CP0644JTHJ4' ), $state, 'store->current_store->get_state' ); +diag "shutdown server"; + ok( kill(9,$pid), 'kill ' . $pid ); ok( waitpid($pid,0), 'waitpid' ); -- 2.20.1