From 68d767eafbbf968a504e212120029d71e7be986a Mon Sep 17 00:00:00 2001 From: Dobrica Pavlinusic Date: Sun, 25 Nov 2007 23:26:42 +0000 Subject: [PATCH] r278@brr: dpavlin | 2007-11-26 00:17:17 +0100 Massive re-write of server testing, which now behaves more like real CPE client (reconnecting on inform, etc) git-svn-id: https://perl-cwmp.googlecode.com/svn/trunk@233 836a5e1a-633d-0410-964b-294494ad4392 --- bin/dump2test.pl | 14 ++- lib/CWMP/Session.pm | 11 +- lib/CWMP/Store/HASH.pm | 5 +- t/30-server.t | 242 ++++++++++++++++++----------------------- 4 files changed, 128 insertions(+), 144 deletions(-) diff --git a/bin/dump2test.pl b/bin/dump2test.pl index 40edb4d..e1c7498 100755 --- a/bin/dump2test.pl +++ b/bin/dump2test.pl @@ -11,6 +11,7 @@ use Data::Dump qw/dump/; use File::Slurp; use blib; use CWMP::Request; +use YAML::Syck; my $path = shift @ARGV || die "usage: $0 dump/client_ip/\n"; @@ -37,14 +38,19 @@ warn "## requests = ",dump( $requests ); my $test_path = 't/dump/'; +sub xml2state { + my $xml = shift; + $xml =~ s/^.*?parse( $xml ); +} + if ( my $i = $requests->{Inform} ) { my $xml = read_file($i); - $xml =~ s/^.*?parse( $xml ); + my $state = xml2state( $xml ); # warn "## state = ",dump( $state ); @@ -67,6 +73,8 @@ foreach my $name ( keys %$requests ) { my $to = "$test_path/$name"; warn "## $from -> $to\n"; next if -e $to; - write_file( $to, read_file( $from ) ); + my $xml = read_file( $from ); + write_file( $to, $xml ); + DumpFile( "$to.yml", xml2state( $xml ) ); warn "created $to\n"; } diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm index e96f08d..52140c3 100644 --- a/lib/CWMP/Session.pm +++ b/lib/CWMP/Session.pm @@ -106,7 +106,7 @@ sub process_request { my $r = $sock->get_request; if ( ! $r ) { - carp "can't get_request"; + warn "WARNING: can't get_request\n"; return 0; } @@ -146,8 +146,13 @@ sub process_request { warn "## acquired state = ", dump( $state ), "\n" if $self->debug; if ( ! defined( $state->{DeviceID} ) ) { - warn "## state with DeviceID, using old one...\n"; - $state->{DeviceID} = $self->state->{DeviceID}; + if ( $self->state ) { + warn "## state without DeviceID, using old one...\n"; + $state->{DeviceID} = $self->state->{DeviceID}; + } else { + warn "WARNING: state without DeviceID, and I don't have old one!\n"; + warn "## state = ",dump( $state ); + } } $self->state( $state ); diff --git a/lib/CWMP/Store/HASH.pm b/lib/CWMP/Store/HASH.pm index bcc503d..3624e4f 100644 --- a/lib/CWMP/Store/HASH.pm +++ b/lib/CWMP/Store/HASH.pm @@ -32,6 +32,8 @@ my $path; my $debug = 0; +my $cleaned = 0; + sub open { my $self = shift; @@ -47,12 +49,13 @@ sub open { if ( ! -e $path ) { mkdir $path || die "can't create $path: $!"; warn "created $path directory\n" if $debug; - } elsif ( $args->{clean} ) { + } elsif ( $args->{clean} && ! $cleaned ) { warn "removed old $path\n" if $debug; foreach my $uid ( $self->all_uids ) { my $file = $self->file( $uid ); unlink $file || die "can't remove $file: $!"; } + $cleaned++; } diff --git a/t/30-server.t b/t/30-server.t index 7545d60..794e35f 100755 --- a/t/30-server.t +++ b/t/30-server.t @@ -4,15 +4,20 @@ use warnings; my $debug = shift @ARGV; -use Test::More tests => 20; +use Test::More tests => 135; use Data::Dump qw/dump/; use Cwd qw/abs_path/; +use File::Find; +use File::Slurp; +use File::Path qw/rmtree mkpath/; +use YAML::Syck; use blib; BEGIN { use_ok('Net::HTTP'); use_ok('CWMP::Server'); use_ok('CWMP::Store'); + use_ok('CWMP::Request'); } my $port = 4242; @@ -26,9 +31,11 @@ ok(my $abs_path = abs_path($0), "abs_path"); $abs_path =~ s!/[^/]*$!/!; #!fix-vim my $store_path = "$abs_path/var/"; -#my $store_module = 'DBMDeep'; my $store_module = 'YAML'; +rmtree $store_path if -e $store_path; +ok( mkpath $store_path, "mkpath $store_path" ); + ok( my $server = CWMP::Server->new({ debug => $debug, port => $port, @@ -36,7 +43,7 @@ ok( my $server = CWMP::Server->new({ store => { module => $store_module, path => $store_path, - clean => 1, +# clean => 1, }, create_dump => 0, } @@ -58,143 +65,104 @@ if ( $pid = fork ) { sleep 1; # so server can start -ok( my $s = Net::HTTP->new(Host => "localhost:$port"), 'client' ); -$s->keep_alive( 1 ); - -ok( $s->write_request( - POST => '/', - 'Transfer-Encoding' => 'chunked', - 'SOAPAction' => '', - 'Content-Type' => 'text/xml', -), 'write_request' ); - -foreach my $chunk (qq{ - - - -1_THOM_TR69_ID - - - - - THOMSON - 00147F - SpeedTouch 780 - CP0644JTHJ4 - - - - 0 BOOTSTRAP - - - - 1 BOOT - - - - 4 VALUE CHANGE - - - -2 -1970-01-01T00:04:33Z -01},qq{ - - - InternetGatewayDevice.DeviceSummary - InternetGatewayDevice:1.1[] (Baseline:1, EthernetLAN:1, ADSLWAN:1, Bridging:1, Time:1, WiFiLAN:1) - - - }, qq{ -InternetGatewayDevice.DeviceInfo.SpecVersion - 1.1 - - - InternetGatewayDevice.DeviceInfo.HardwareVersion - BANT-R - - - InternetGatewayDevice.DeviceInfo.SoftwareVersion - 6.2.15.5 - - - InternetGatewayDevice.DeviceInfo.ProvisioningCode - - - - InternetGatewayDevice.DeviceInfo.VendorConfigFile.1.Name - Routed PPPoE on 0/35 and 8/35 - - - InternetGatewayDevice.DeviceInfo.VendorConfigFile.1.Version - - - - InternetGatewayDevice.DeviceInfo.VendorConfigFile.1.Date - 0000-00-00T00:00:00 - - - InternetGatewayDevice.DeviceInfo.VendorConfigFile.1.Description - Factory Defaults - - - InternetGatewayDevice.ManagementServer.ConnectionRequestURL - http://192.168.1.254:51005/ - - - InternetGatewayDevice.ManagementServer.ParameterKey - - - - .ExternalIPAddress - 192.168.1.254 - - - - - -} ) { - ok( $s->write_chunk( $chunk ), "chunk " . length($chunk) . " bytes" ); +my $s; + +sub cpe_connect { + return $s if $s; + diag "CPE connect"; + ok( $s = Net::HTTP->new(Host => "localhost:$port"), 'CPE client' ); + $s->keep_alive( 1 ); } -ok( $s->write_chunk_eof, 'write_chunk_eof' ); - -sleep 1; - -ok( my $store = CWMP::Store->new({ module => $store_module, path => $store_path, debug => $debug }), 'another store' ); - -my $state = { - CurrentTime => "1970-01-01T00:04:33Z", - DeviceID => { - Manufacturer => "THOMSON", - OUI => "00147F", - ProductClass => "SpeedTouch 780", - SerialNumber => "CP0644JTHJ4", - }, - EventStruct => ["0 BOOTSTRAP", "1 BOOT", "4 VALUE CHANGE"], - ID => "1_THOM_TR69_ID", - MaxEnvelopes => 2, -# NoMoreRequests => undef, - Parameter => { - "\nInternetGatewayDevice.DeviceInfo.SpecVersion" => "1.1", - ".ExternalIPAddress" => "192.168.1.254", - "InternetGatewayDevice.DeviceInfo.HardwareVersion" => "BANT-R", - "InternetGatewayDevice.DeviceInfo.ProvisioningCode" => undef, - "InternetGatewayDevice.DeviceInfo.SoftwareVersion" => "6.2.15.5", - "InternetGatewayDevice.DeviceInfo.VendorConfigFile.1.Date" => "0000-00-00T00:00:00", - "InternetGatewayDevice.DeviceInfo.VendorConfigFile.1.Description" => "Factory Defaults", - "InternetGatewayDevice.DeviceInfo.VendorConfigFile.1.Name" => "Routed PPPoE on 0/35 and 8/35", - "InternetGatewayDevice.DeviceInfo.VendorConfigFile.1.Version" => undef, - "InternetGatewayDevice.DeviceSummary" => "InternetGatewayDevice:1.1[] (Baseline:1, EthernetLAN:1, ADSLWAN:1, Bridging:1, Time:1, WiFiLAN:1)", - "InternetGatewayDevice.ManagementServer.ConnectionRequestURL" => "http://192.168.1.254:51005/", - "InternetGatewayDevice.ManagementServer.ParameterKey" => undef, - }, - RetryCount => "01", - _dispatch => "InformResponse", -}; -ok( my $store_state = $store->current_store->get_state( 'CP0644JTHJ4' ), 'get_state' ); +sub cpe_disconnect { + return unless $s; + diag "CPE disconnect"; + $s->keep_alive( 0 ); + ok( $s->write_request( + POST => '/', + 'SOAPAction' => '', + 'Content-Type' => 'text/xml', + ), 'write_request' ); + my ($code, $mess, %h) = $s->read_response_headers; + undef $s; + diag "$code $mess"; + return $code == 200 ? 1 : 0; +} + +sub test_request { + my $path = shift; + + ok( -e $path, $path ); + + cpe_disconnect if $path =~ m/Inform/; + cpe_connect; + + ok( $s->write_request( + POST => '/', + 'Transfer-Encoding' => 'chunked', + 'SOAPAction' => '', + 'Content-Type' => 'text/xml', + ), 'write_request' ); + + my $xml = read_file( $path ); + $xml =~ s/^.+?write_chunk( $chunk ), "chunk $part " . length($chunk) . " bytes" ); + } + ok( $s->write_chunk_eof, 'write_chunk_eof' ); + + my($code, $mess, %h) = $s->read_response_headers; + diag "$code $mess"; + while (1) { + my $buf; + my $n = $s->read_entity_body($buf, 1024); + die "read failed: $!" unless defined $n; + last unless $n; + diag $buf; + } + + ok( my $store = CWMP::Store->new({ module => $store_module, path => $store_path, debug => $debug }), 'another store' ); + + my $state = LoadFile( "$path.yml" ); + + $path =~ s!/[^/]+$!!; #!vim + ok( my $uid = $store->state_to_uid( LoadFile( "$path/Inform.yml" ) ), 'state_to_uid' ); + + ok( my $store_state = $store->current_store->get_state( $uid ), 'get_state' ); + + my $s; + + # ignore + foreach my $k ( keys %$state ) { + if ( defined( $store_state->{$k} ) ) { + $s->{$k} = $store_state->{$k}; + } else { + die "store_state doesn't have $k: ",dump( $store_state ); + } + } + + is_deeply( $s, $state, 'store->current_store->get_state' ); + +} + +find({ + no_chdir => 1, + wanted => sub { + my $path = $File::Find::name; + return unless -f $path; + return if $path =~ m/\.yml$/; + eval { + test_request( $path ); + }; + ok( ! $@, "request $path" ); + } +},'t/dump/'); -is_deeply( $store_state, $state, 'store->current_store->get_state' ); +ok( cpe_disconnect, 'cpe_disconnect' ); diag "shutdown server"; -- 2.20.1