17 |
|
|
18 |
use HTTP::Daemon; |
use HTTP::Daemon; |
19 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
20 |
use Carp qw/confess cluck croak/; |
use Carp qw/carp confess cluck croak/; |
21 |
use File::Slurp; |
use File::Slurp; |
22 |
|
|
23 |
use CWMP::Request; |
use CWMP::Request; |
24 |
use CWMP::Methods; |
use CWMP::Methods; |
25 |
use CWMP::Store; |
use CWMP::Store; |
26 |
|
|
27 |
|
#use Devel::LeakTrace::Fast; |
28 |
|
|
29 |
=head1 NAME |
=head1 NAME |
30 |
|
|
31 |
CWMP::Session - implement logic of CWMP protocol |
CWMP::Session - implement logic of CWMP protocol |
102 |
# solution from http://use.perl.org/~Matts/journal/12896 |
# solution from http://use.perl.org/~Matts/journal/12896 |
103 |
${*$sock}{'httpd_daemon'} = HTTP::Daemon->new; |
${*$sock}{'httpd_daemon'} = HTTP::Daemon->new; |
104 |
|
|
105 |
my $r = $sock->get_request || confess "can't get_request"; |
my $r = $sock->get_request; |
106 |
|
|
107 |
|
if ( ! $r ) { |
108 |
|
carp "can't get_request"; |
109 |
|
return 0; |
110 |
|
} |
111 |
|
|
112 |
my $xml = $r->content; |
my $xml = $r->content; |
113 |
|
|
157 |
#warn "last request state = ", dump( $state ), "\n" if $self->debug > 1; |
#warn "last request state = ", dump( $state ), "\n" if $self->debug > 1; |
158 |
} |
} |
159 |
|
|
|
|
|
160 |
$sock->send(join("\r\n", |
$sock->send(join("\r\n", |
161 |
'HTTP/1.1 200 OK', |
'HTTP/1.1 200 OK', |
162 |
'Content-Type: text/xml; charset="utf-8"', |
'Content-Type: text/xml; charset="utf-8"', |
163 |
'Server: AcmeCWMP/42', |
'Server: PerlCWMP/42', |
164 |
'SOAPServer: AcmeCWMP/42' |
'SOAPServer: PerlCWMP/42' |
165 |
)."\r\n"); |
)."\r\n"); |
166 |
|
|
167 |
$sock->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} ); |
$sock->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} ); |
168 |
|
|
169 |
my $uid = $self->store->state_to_uid( $state ); |
my $uid = $self->store->state_to_uid( $state ); |
170 |
|
|
171 |
|
my $to_uid = join(" ", grep { defined($_) } "to $uid", |
172 |
|
# board |
173 |
|
$state->{Parameter}->{'InternetGatewayDevice.DeviceInfo.HardwareVersion'}, |
174 |
|
# version |
175 |
|
$state->{Parameter}->{'InternetGatewayDevice.DeviceInfo.SoftwareVersion'}, |
176 |
|
# summary |
177 |
|
# $state->{Parameter}->{'InternetGatewayDevice.DeviceSummary'}, |
178 |
|
) . "\n"; |
179 |
|
|
180 |
my $queue = CWMP::Queue->new({ |
my $queue = CWMP::Queue->new({ |
181 |
id => $uid, |
id => $uid, |
182 |
debug => $self->debug, |
debug => $self->debug, |
189 |
} elsif ( $job = $queue->dequeue ) { |
} elsif ( $job = $queue->dequeue ) { |
190 |
$xml = $self->dispatch( $job->dispatch ); |
$xml = $self->dispatch( $job->dispatch ); |
191 |
} elsif ( $size == 0 ) { |
} elsif ( $size == 0 ) { |
192 |
warn ">>> no more queued commands, closing connection to $uid\n"; |
warn ">>> no more queued commands, no client pending, closing connection $to_uid"; |
193 |
return 0; |
$sock->close; |
194 |
|
return; |
195 |
} else { |
} else { |
196 |
warn ">>> empty response to $uid\n"; |
warn ">>> empty response $to_uid"; |
197 |
$state->{NoMoreRequests} = 1; |
$state->{NoMoreRequests} = 1; |
198 |
$xml = $self->dispatch( 'xml', sub {} ); |
$xml = $self->dispatch( 'xml', sub {} ); |
199 |
} |
} |
201 |
$sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" ); |
$sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" ); |
202 |
$sock->send( $xml ) or die "can't send response"; |
$sock->send( $xml ) or die "can't send response"; |
203 |
|
|
204 |
warn ">>>> " . $sock->peerhost . " [" . localtime() . "] sent ", length( $xml )," bytes to $uid\n"; |
warn ">>>> " . $sock->peerhost . " [" . localtime() . "] sent ", length( $xml )," bytes $to_uid"; |
205 |
|
|
206 |
$job->finish if $job; |
$job->finish if $job; |
207 |
warn "### request over for $uid\n" if $self->debug; |
warn "### request over for $uid\n" if $self->debug; |