8 |
__PACKAGE__->mk_accessors( qw/ |
__PACKAGE__->mk_accessors( qw/ |
9 |
debug |
debug |
10 |
port |
port |
11 |
|
sock |
12 |
/ ); |
/ ); |
13 |
|
|
14 |
use IO::Socket::INET; |
use IO::Socket::INET; |
52 |
|
|
53 |
warn "connection from ", $sock->peerhost, "\n"; |
warn "connection from ", $sock->peerhost, "\n"; |
54 |
|
|
55 |
|
$self->sock( $sock ); # FIXME this will not work for multiple clients |
56 |
$self->process_request( $sock ); |
$self->process_request( $sock ); |
57 |
|
|
58 |
warn "...another one bites a dust...\n"; |
warn "...another one bites a dust...\n"; |
144 |
|
|
145 |
my $response = CWMP::Response->new({ debug => $self->debug }); |
my $response = CWMP::Response->new({ debug => $self->debug }); |
146 |
|
|
147 |
print $self->status(200), $self->content_type('text/xml; charset="utf-8"'), "\r\n"; |
$sock->print( |
148 |
|
$self->status(200), |
149 |
print "Server: AcmeCWMP/42\r\nSOAPServer: AcmeCWMP/42\r\n"; |
$self->content_type('text/xml; charset="utf-8"'), |
150 |
|
"Server: AcmeCWMP/42\r\n", |
151 |
|
"SOAPServer: AcmeCWMP/42\r\n" |
152 |
|
); |
153 |
|
|
154 |
print "Set-Cookie: ID=" , $state->{ID}, "; path=/\r\n" if ( $state->{ID} ); |
$sock->print( "Set-Cookie: ID=" , $state->{ID}, "; path=/\r\n" ) if ( $state->{ID} ); |
155 |
|
|
156 |
my $xml = ''; |
my $xml = ''; |
157 |
|
|
167 |
warn ">>> empty response\n"; |
warn ">>> empty response\n"; |
168 |
} |
} |
169 |
|
|
170 |
print "Content-length: ", length( $xml ), "\r\n\r\n"; |
$sock->print( "Content-length: ", length( $xml ), "\r\n\r\n" ); |
171 |
print $xml or die "can't send response"; |
$sock->print( $xml ) or die "can't send response"; |
172 |
|
|
173 |
warn "### request over"; |
warn "### request over"; |
174 |
|
|
211 |
|
|
212 |
sub error{ |
sub error{ |
213 |
my ($self, $number, $msg) = @_; |
my ($self, $number, $msg) = @_; |
214 |
print $self->status($number, $msg), "\r\n"; |
$self->sock->print( $self->status($number, $msg), "\r\n" ); |
215 |
warn "Error - $number - $msg\n"; |
warn "Error - $number - $msg\n"; |
216 |
} |
} |
217 |
|
|
226 |
my $self = shift; |
my $self = shift; |
227 |
my $number = shift || 200; |
my $number = shift || 200; |
228 |
return if ! delete $self->{needs_header}; |
return if ! delete $self->{needs_header}; |
229 |
print "HTTP/1.0 $number\r\n"; |
$self->sock->Print("HTTP/1.0 $number\r\n"); |
230 |
return 1; |
return 1; |
231 |
} |
} |
232 |
|
|