t/30-server.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 my $debug = shift @ARGV;
   6
   7 use Test::More tests => 153;
   8 use Data::Dump qw/dump/;
   9 use Cwd qw/abs_path/;
  10 use File::Find;
  11 use File::Slurp;
  12 use File::Path qw/rmtree mkpath/;
  13 use YAML::Syck;
  14 use blib;
  15
  16 BEGIN {
  17         use_ok('Net::HTTP');
  18         use_ok('CWMP::Server');
  19         use_ok('CWMP::Store');
  20         use_ok('CWMP::Request');
  21 }
  22
  23 my $port = 4242;
  24
  25 eval {
  26         $SIG{ALRM} = sub { die; };
  27         alarm 30;
  28 };
  29
  30 ok(my $abs_path = abs_path($0), "abs_path");
  31 $abs_path =~ s!/[^/]*$!/!;      #!fix-vim
  32
  33 my $store_path = "$abs_path/var/";
  34 my $store_module = 'YAML';
  35
  36 rmtree $store_path if -e $store_path;
  37 ok( mkpath $store_path, "mkpath $store_path" );
  38
  39 ok( my $server = CWMP::Server->new({
  40         debug => $debug,
  41         port => $port,
  42         session => {
  43                 store => {
  44                         module => $store_module,
  45                         path => $store_path,
  46 #                       clean => 1,
  47                 },
  48                 create_dump => 0,
  49         }
  50 }), 'new' );
  51 isa_ok( $server, 'CWMP::Server' );
  52
  53 my $pid;
  54
  55 if ( $pid = fork ) {
  56         ok( $pid, 'fork ');
  57         diag "forked $pid";
  58 } elsif (defined($pid)) {
  59         # child
  60         $server->run;
  61         exit;
  62 } else {
  63         die "can't fork";
  64 }
  65
  66 sleep 1;        # so server can start
  67
  68 my $s;
  69
  70 sub cpe_connect {
  71         return $s if $s;
  72         diag "CPE connect";
  73         ok( $s = Net::HTTP->new(Host => "localhost:$port"), 'CPE client' );
  74         $s->keep_alive( 1 );
  75 }
  76
  77 sub cpe_disconnect {
  78         return unless $s;
  79         diag "CPE disconnect";
  80         $s->keep_alive( 0 );
  81         ok( $s->write_request(
  82                 POST => '/',
  83                 'SOAPAction' => '',
  84                 'Content-Type' => 'text/xml',
  85         ), 'write_request' );
  86         my ($code, $mess, %h) = $s->read_response_headers;
  87         undef $s;
  88         diag "$code $mess";
  89         return $code == 200 ? 1 : 0;
  90 }
  91
  92 sub test_request {
  93         my $path = shift;
  94
  95         ok( -e $path, $path );
  96
  97         cpe_disconnect if $path =~ m/Inform/;
  98         cpe_connect;
  99
 100         ok( $s->write_request(
 101                 POST => '/',
 102                 'Transfer-Encoding' => 'chunked',
 103                 'SOAPAction' => '',
 104                 'Content-Type' => 'text/xml',
 105         ), 'write_request' );
 106
 107         my $xml = read_file( $path );
 108         $xml =~ s/^.+?</</s;
 109
 110         my $chunk_size = 5000;
 111
 112         foreach my $part ( 0 .. int( length($xml) / $chunk_size ) ) {
 113                 my $chunk = substr( $xml, $part * $chunk_size, $chunk_size );
 114                 ok( $s->write_chunk( $chunk ), "chunk $part " . length($chunk) . " bytes" );
 115         }
 116         ok( $s->write_chunk_eof, 'write_chunk_eof' );
 117
 118         my($code, $mess, %h) = $s->read_response_headers;
 119         diag "$code $mess";
 120         while (1) {
 121                 my $buf;
 122                 my $n = $s->read_entity_body($buf, 1024);
 123                 die "read failed: $!" unless defined $n;
 124                 last unless $n;
 125                 diag $buf;
 126         }
 127
 128         ok( my $store = CWMP::Store->new({ module => $store_module, path => $store_path, debug => $debug }), 'another store' );
 129
 130         my $state = LoadFile( "$path.yml" );
 131
 132         $path =~ s!/[^/]+$!!; #!vim
 133         ok( my $uid = $store->state_to_uid( LoadFile( "$path/Inform.yml" ) ), 'state_to_uid' );
 134
 135         ok( my $store_state = $store->current_store->get_state( $uid ), 'get_state' );
 136
 137         my $s;
 138
 139         # ignore
 140         foreach my $k ( keys %$state ) {
 141                 if ( defined( $store_state->{$k} ) ) {
 142                         $s->{$k} = $store_state->{$k};
 143                 } else {
 144                         die "store_state doesn't have $k: ",dump( $store_state );
 145                 }
 146         }
 147
 148         is_deeply( $s, $state, 'store->current_store->get_state' );
 149
 150 }
 151
 152 find({
 153         no_chdir => 1,
 154         wanted => sub {
 155                 my $path = $File::Find::name;
 156                 return unless -f $path;
 157                 return if $path =~ m/\.yml$/;
 158                 eval {
 159                         test_request( $path );
 160                 };
 161                 ok( ! $@, "request $path" );
 162         }
 163 },'t/dump/');
 164
 165 ok( cpe_disconnect, 'cpe_disconnect' );
 166
 167 diag "shutdown server";
 168
 169 ok( kill(9,$pid), 'kill ' . $pid );
 170
 171 ok( waitpid($pid,0), 'waitpid' );
 172