113 |
|
|
114 |
if ( $self->create_dump ) { |
if ( $self->create_dump ) { |
115 |
write_file( $file, $r->as_string ); |
write_file( $file, $r->as_string ); |
116 |
warn "### request dumped to file: $file\n"; |
warn "### request dumped to file: $file\n" if $self->debug; |
117 |
} |
} |
118 |
|
|
119 |
my $state; |
my $state; |
131 |
symlink $file, $type || warn "can't symlink $file -> $type: $!"; |
symlink $file, $type || warn "can't symlink $file -> $type: $!"; |
132 |
} |
} |
133 |
|
|
134 |
warn "## acquired state = ", dump( $state ), "\n"; |
warn "## acquired state = ", dump( $state ), "\n" if $self->debug; |
135 |
|
|
136 |
if ( ! defined( $state->{DeviceID} ) ) { |
if ( ! defined( $state->{DeviceID} ) ) { |
137 |
warn "## state with DeviceID, using old one...\n"; |
warn "## state with DeviceID, using old one...\n"; |
139 |
} |
} |
140 |
|
|
141 |
$self->state( $state ); |
$self->state( $state ); |
142 |
$self->store->update_state( ID => $state->{ID}, $state ); |
$self->store->update_state( $state ); |
143 |
|
|
144 |
} else { |
} else { |
145 |
|
|
150 |
#warn "last request state = ", dump( $state ), "\n" if $self->debug > 1; |
#warn "last request state = ", dump( $state ), "\n" if $self->debug > 1; |
151 |
} |
} |
152 |
|
|
|
|
|
153 |
$sock->send(join("\r\n", |
$sock->send(join("\r\n", |
154 |
'HTTP/1.1 200 OK', |
'HTTP/1.1 200 OK', |
155 |
'Content-Type: text/xml; charset="utf-8"', |
'Content-Type: text/xml; charset="utf-8"', |
156 |
'Server: AcmeCWMP/42', |
'Server: PerlCWMP/42', |
157 |
'SOAPServer: AcmeCWMP/42' |
'SOAPServer: PerlCWMP/42' |
158 |
)."\r\n"); |
)."\r\n"); |
159 |
|
|
160 |
$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} ); |
161 |
|
|
162 |
my $uid = $self->store->ID_to_uid( $state->{ID}, $state ); |
my $uid = $self->store->state_to_uid( $state ); |
163 |
|
|
164 |
|
my $to_uid = join(" ", "to $uid", |
165 |
|
# board |
166 |
|
$state->{Parameter}->{'InternetGatewayDevice.DeviceInfo.HardwareVersion'}, |
167 |
|
# version |
168 |
|
$state->{Parameter}->{'InternetGatewayDevice.DeviceInfo.SoftwareVersion'}, |
169 |
|
# summary |
170 |
|
# $state->{Parameter}->{'InternetGatewayDevice.DeviceSummary'}, |
171 |
|
) . "\n"; |
172 |
|
|
173 |
my $queue = CWMP::Queue->new({ |
my $queue = CWMP::Queue->new({ |
174 |
id => $uid, |
id => $uid, |
182 |
} elsif ( $job = $queue->dequeue ) { |
} elsif ( $job = $queue->dequeue ) { |
183 |
$xml = $self->dispatch( $job->dispatch ); |
$xml = $self->dispatch( $job->dispatch ); |
184 |
} elsif ( $size == 0 ) { |
} elsif ( $size == 0 ) { |
185 |
warn ">>> no more queued commands, closing connection to $uid\n"; |
warn ">>> no more queued commands, closing connection $to_uid"; |
186 |
return 0; |
return 0; |
187 |
} else { |
} else { |
188 |
warn ">>> empty response to $uid\n"; |
warn ">>> empty response $to_uid"; |
189 |
$state->{NoMoreRequests} = 1; |
$state->{NoMoreRequests} = 1; |
190 |
$xml = $self->dispatch( 'xml', sub {} ); |
$xml = $self->dispatch( 'xml', sub {} ); |
191 |
} |
} |
193 |
$sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" ); |
$sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" ); |
194 |
$sock->send( $xml ) or die "can't send response"; |
$sock->send( $xml ) or die "can't send response"; |
195 |
|
|
196 |
warn ">>>> " . $sock->peerhost . " [" . localtime() . "] sent ", length( $xml )," bytes to $uid\n"; |
warn ">>>> " . $sock->peerhost . " [" . localtime() . "] sent ", length( $xml )," bytes $to_uid"; |
197 |
|
|
198 |
$job->finish if $job; |
$job->finish if $job; |
199 |
warn "### request over for $uid\n" if $self->debug; |
warn "### request over for $uid\n" if $self->debug; |
224 |
if ( $self->create_dump ) { |
if ( $self->create_dump ) { |
225 |
my $file = sprintf("dump/%04d-%s.response", $dump_nr++, $self->sock->peerhost); |
my $file = sprintf("dump/%04d-%s.response", $dump_nr++, $self->sock->peerhost); |
226 |
write_file( $file, $xml ); |
write_file( $file, $xml ); |
227 |
warn "### response dump: $file\n"; |
warn "### response dump: $file\n" if $self->debug; |
228 |
} |
} |
229 |
return $xml; |
return $xml; |
230 |
} else { |
} else { |