projects
/
perl-cwmp.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r210@brr: dpavlin | 2007-11-14 19:15:41 +0100
[perl-cwmp.git]
/
lib
/
CWMP
/
Session.pm
diff --git
a/lib/CWMP/Session.pm
b/lib/CWMP/Session.pm
index
fd50a53
..
ff6d95d
100644
(file)
--- a/
lib/CWMP/Session.pm
+++ b/
lib/CWMP/Session.pm
@@
-11,7
+11,6
@@
store
sock
state
sock
state
-queue
store
/ );
store
/ );
@@
-35,10
+34,6
@@
CWMP::Session - implement logic of CWMP protocol
my $server = CWMP::Session->new({
sock => $io_socket_object,
store => 'state.db',
my $server = CWMP::Session->new({
sock => $io_socket_object,
store => 'state.db',
- queue => [
- 'GetRPCMethods',
- [ 'GetParameterValyes', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ],
- ],
debug => 1,
});
debug => 1,
});
@@
-107,8
+102,10
@@
sub process_request {
warn "<<<< ", $sock->peerhost, " [" . localtime() . "] ", $r->method, " ", $r->uri, " $size bytes\n";
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 ) {
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";
}
write_file( $file, $r->as_string );
warn "### request dumped to file: $file\n";
}
@@
-123,6
+120,11
@@
sub process_request {
$state = CWMP::Request->parse( $xml );
$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 );
warn "## acquired state = ", dump( $state ), "\n";
$self->state( $state );
@@
-146,18
+148,25
@@
sub process_request {
)."\r\n");
$sock->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} );
)."\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 );
$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 ) {
} elsif ( $size == 0 ) {
- warn ">>> no more queued commands, closing connection\n";
+ warn ">>> no more queued commands, closing connection
to $uid
\n";
return 0;
} else {
return 0;
} else {
- warn ">>> empty response\n";
+ warn ">>> empty response
to $uid
\n";
$state->{NoMoreRequests} = 1;
$xml = $self->dispatch( 'xml', sub {} );
}
$state->{NoMoreRequests} = 1;
$xml = $self->dispatch( 'xml', sub {} );
}
@@
-165,9
+174,10
@@
sub process_request {
$sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" );
$sock->send( $xml ) or die "can't send response";
$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
};
return 1; # next request
};
@@
-183,20
+193,16
@@
If debugging level of 3 or more, it will create dumps of responses named C<< dum
sub dispatch {
my $self = shift;
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::Methods->new({ debug => $self->debug });
if ( $response->can( $dispatch ) ) {
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);
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);