sock
state
-queue
store
/ );
use File::Slurp;
use CWMP::Request;
-use CWMP::Response;
+use CWMP::Methods;
use CWMP::Store;
=head1 NAME
my $server = CWMP::Session->new({
sock => $io_socket_object,
store => 'state.db',
- queue => [
- 'GetRPCMethods',
- [ 'GetParameterValyes', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ],
- ],
debug => 1,
});
warn "<<<< ", $sock->peerhost, " [" . localtime() . "] ", $r->method, " ", $r->uri, " $size bytes\n";
+ $dump_nr++;
+ my $file = sprintf("dump/%04d-%s.request", $dump_nr, $sock->peerhost);
+
if ( $self->debug > 2 ) {
- my $file = sprintf("dump/%04d-%s.request", $dump_nr++, $sock->peerhost);
write_file( $file, $r->as_string );
warn "### request dumped to file: $file\n";
}
$state = CWMP::Request->parse( $xml );
+ if ( defined( $state->{_dispatch} ) && $self->debug > 2 ) {
+ my $type = sprintf("dump/%04d-%s-%s", $dump_nr, $sock->peerhost, $state->{_dispatch});
+ symlink $file, $type || warn "can't symlink $file -> $type: $!";
+ }
+
warn "## acquired state = ", dump( $state ), "\n";
$self->state( $state );
)."\r\n");
$sock->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} );
-
+
+ my $uid = $self->store->ID_to_uid( $state->{ID}, $state );
+
+ my $queue = CWMP::Queue->new({
+ id => $uid,
+ 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";
+ warn ">>> no more queued commands, closing connection to $uid\n";
return 0;
} else {
- warn ">>> empty response\n";
+ warn ">>> empty response to $uid\n";
$state->{NoMoreRequests} = 1;
$xml = $self->dispatch( 'xml', sub {} );
}
$sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" );
$sock->send( $xml ) or die "can't send response";
- warn ">>>> " . $sock->peerhost . " [" . localtime() . "] sent ", length( $xml )," bytes\n";
+ warn ">>>> " . $sock->peerhost . " [" . localtime() . "] sent ", length( $xml )," bytes to $uid\n";
- warn "### request over\n" if $self->debug;
+ $job->finish if $job;
+ warn "### request over for $uid\n" if $self->debug;
return 1; # next request
};
sub dispatch {
my $self = shift;
- my $dispatch = shift || die "no dispatch?";
- my @args = @_;
+warn "##!!! dispatch(",dump( @_ ),")\n";
- if ( ref($dispatch) eq 'ARRAY' ) {
- my @a = @$dispatch;
- $dispatch = shift @a;
- push @args, @a;
- }
+ my $dispatch = shift || die "no dispatch?";
+ my $args = shift;
- my $response = CWMP::Response->new({ debug => $self->debug });
+ my $response = CWMP::Methods->new({ debug => $self->debug });
if ( $response->can( $dispatch ) ) {
- warn ">>> dispatching to $dispatch\n";
- my $xml = $response->$dispatch( $self->state, @args );
+ warn ">>> dispatching to $dispatch with args ",dump( $args ),"\n";
+ my $xml = $response->$dispatch( $self->state, $args );
warn "## response payload: ",length($xml)," bytes\n$xml\n" if $self->debug;
if ( $self->debug > 2 ) {
my $file = sprintf("dump/%04d-%s.response", $dump_nr++, $self->sock->peerhost);