47 |
ReuseAddr => 1, |
ReuseAddr => 1, |
48 |
); |
); |
49 |
|
|
50 |
warn "ACS waiting for request on port ", $self->port, " queue ( ", join(",",@{$self->queue}), " )\n"; |
warn "ACS waiting for request on port ", $self->port, |
51 |
|
$self->queue ? " queue ( " . join(",",@{$self->queue}) . " )" : "", |
52 |
|
"\n"; |
53 |
|
|
54 |
while ( my $sock = $listen->accept ) { |
while ( my $sock = $listen->accept ) { |
55 |
$sock->autoflush(1); |
$sock->autoflush(1); |
56 |
|
|
57 |
warn "connection from ", $sock->peerhost, "\n"; |
warn "connection from ", $sock->peerhost, "\n" if $self->debug; |
58 |
|
|
59 |
$self->sock( $sock ); # FIXME this will not work for multiple clients |
$self->sock( $sock ); # FIXME this will not work for multiple clients |
60 |
while ( $self->process_request ) { |
while ( $self->process_request ) { |
81 |
die "not IO::Socket::INET but ", ref( $sock ) unless ( ref($sock) eq 'IO::Socket::INET' ); |
die "not IO::Socket::INET but ", ref( $sock ) unless ( ref($sock) eq 'IO::Socket::INET' ); |
82 |
|
|
83 |
if ( ! $sock->connected ) { |
if ( ! $sock->connected ) { |
84 |
warn "SOCKET NOT CONNECTED"; |
warn "SOCKET NOT CONNECTED\n"; |
85 |
return 0; |
return 0; |
86 |
} |
} |
87 |
|
|
134 |
$sock->read( my $buff, $len ); |
$sock->read( my $buff, $len ); |
135 |
$chunk .= $buff; |
$chunk .= $buff; |
136 |
|
|
137 |
warn "--- $len bytes: --=>||$buff||<=--\n"; |
warn "--- $len bytes: --=>||$buff||<=--\n" if $self->debug; |
138 |
|
|
139 |
} while ( $len > 0 ); |
} while ( $len > 0 ); |
140 |
my $sep = $sock->getline; |
my $sep = $sock->getline; |
221 |
if ( $response->can( $dispatch ) ) { |
if ( $response->can( $dispatch ) ) { |
222 |
warn ">>> dispatching to $dispatch\n"; |
warn ">>> dispatching to $dispatch\n"; |
223 |
my $xml = $response->$dispatch( $self->state, @_ ) . "\r\n"; |
my $xml = $response->$dispatch( $self->state, @_ ) . "\r\n"; |
224 |
warn "## response payload: ",length($xml)," bytes\n$xml\n"; |
warn "## response payload: ",length($xml)," bytes\n$xml\n" if $self->debug; |
225 |
return $xml; |
return $xml; |
226 |
} else { |
} else { |
227 |
confess "can't dispatch to $dispatch"; |
confess "can't dispatch to $dispatch"; |
242 |
while (defined($_ = $self->sock->getline)) { |
while (defined($_ = $self->sock->getline)) { |
243 |
s/[\r\n]+$//; |
s/[\r\n]+$//; |
244 |
last unless length $_; |
last unless length $_; |
245 |
warn "-- $_\n"; |
warn "-- $_\n" if $self->debug; |
246 |
return 0 if ! /^ ([\w\-]+) :[\ \t]* (.*) $/x; |
return 0 if ! /^ ([\w\-]+) :[\ \t]* (.*) $/x; |
247 |
$self->{headers}->{$1} = $2; |
$self->{headers}->{$1} = $2; |
248 |
} |
} |