68 |
HTTP. |
HTTP. |
69 |
|
|
70 |
If used with debugging level of 3 or more, it will also create dumps of |
If used with debugging level of 3 or more, it will also create dumps of |
71 |
requests named C<< nr.dump >> where C<nr> is number from 0 to total number |
requests named C<< dump/nr.request >> where C<nr> is number from 0 to total number |
72 |
of requests in single session. |
of requests in single session. |
73 |
|
|
74 |
=cut |
=cut |
102 |
warn "<<<< ", $sock->peerhost, " [" . localtime() . "] ", $r->method, " ", $r->uri, " $size bytes\n"; |
warn "<<<< ", $sock->peerhost, " [" . localtime() . "] ", $r->method, " ", $r->uri, " $size bytes\n"; |
103 |
|
|
104 |
if ( $self->debug > 2 ) { |
if ( $self->debug > 2 ) { |
105 |
my $file = $dump_nr++ . '.dump'; |
my $file = sprintf("dump/%04d.request", $dump_nr++); |
106 |
write_file( $file, $r->as_string ); |
write_file( $file, $r->as_string ); |
107 |
warn "### request dump: $file\n"; |
warn "### request dump: $file\n"; |
108 |
} |
} |
113 |
|
|
114 |
die "no SOAPAction header in ",dump($chunk) unless defined ( $r->header('SOAPAction') ); |
die "no SOAPAction header in ",dump($chunk) unless defined ( $r->header('SOAPAction') ); |
115 |
|
|
116 |
|
$state = CWMP::Request->parse( $chunk ); |
117 |
|
|
118 |
if ( $chunk ) { |
warn "## acquired state = ", dump( $state ), "\n"; |
|
warn "## request chunk: ",length($chunk)," bytes\n$chunk\n" if $self->debug; |
|
119 |
|
|
120 |
$state = CWMP::Request->parse( $chunk ); |
$self->state( $state ); |
121 |
|
$self->store->update_state( ID => $state->{ID}, $state ); |
122 |
|
|
123 |
warn "## acquired state = ", dump( $state ), "\n"; |
} else { |
|
|
|
|
$self->state( $state ); |
|
|
$self->store->update_state( ID => $state->{ID}, $state ); |
|
124 |
|
|
125 |
} else { |
warn "## empty request\n"; |
|
warn "## empty request\n"; |
|
|
} |
|
126 |
|
|
|
} else { |
|
127 |
$state = $self->state; |
$state = $self->state; |
128 |
|
delete( $state->{_dispatch} ); |
129 |
warn "last request state = ", dump( $state ), "\n" if $self->debug > 1; |
warn "last request state = ", dump( $state ), "\n" if $self->debug > 1; |
130 |
} |
} |
131 |
|
|
168 |
|
|
169 |
$xml = $self->dispatch('Inform', $response_arguments ); |
$xml = $self->dispatch('Inform', $response_arguments ); |
170 |
|
|
171 |
|
If debugging level of 3 or more, it will create dumps of responses named C<< dump/nr.response >> |
172 |
|
|
173 |
=cut |
=cut |
174 |
|
|
175 |
sub dispatch { |
sub dispatch { |
183 |
warn ">>> dispatching to $dispatch\n"; |
warn ">>> dispatching to $dispatch\n"; |
184 |
my $xml = $response->$dispatch( $self->state, @_ ); |
my $xml = $response->$dispatch( $self->state, @_ ); |
185 |
warn "## response payload: ",length($xml)," bytes\n$xml\n" if $self->debug; |
warn "## response payload: ",length($xml)," bytes\n$xml\n" if $self->debug; |
186 |
|
if ( $self->debug > 2 ) { |
187 |
|
my $file = sprintf("dump/%04d.response", $dump_nr++); |
188 |
|
write_file( $file, $xml ); |
189 |
|
warn "### response dump: $file\n"; |
190 |
|
} |
191 |
return $xml; |
return $xml; |
192 |
} else { |
} else { |
193 |
confess "can't dispatch to $dispatch"; |
confess "can't dispatch to $dispatch"; |