POEx-HTTP-Server
view release on metacpan or search on metacpan
lib/POEx/HTTP/Server.pm view on Meta::CPAN
}
sub input_error
{
my( $self, $resp ) = @_;
DEBUG and $self->D( "ERROR ", $resp->status_line );
bless $resp, 'POEx::HTTP::Server::Error';
$self->special_dispatch( on_error => $resp );
$self->{req} = POEx::HTTP::Server::Request->new( ERROR => '/' );
$self->{req}->connection( $self->{connection} );
$self->{req}->protocol( "HTTP/1.1" );
$self->{resp} = $resp;
$self->reset_req;
$self->{shutdown} = 1;
$self->respond;
}
sub reset_req
{
my( $self ) = @_;
if( delete $self->{stream_wheel} ) {
# Second request on a keep-alive wheel. Switch back to Filter::HTTPD
$self->{wheel}->set_output_filter( $self->build_filter );
}
$self->{will_close} = 0;
$self->{once} = 0;
$self->{flushing} = 0;
}
#######################################
sub output
{
my( $self, $something ) = @_;
$self->{flushing} = 1;
# T->point( REQ => 'output' );
$self->{wheel}->put( $something );
}
#######################################
## POE::Wheel::ReadWrite is telling us that what we wrote has been written
sub flushed
{
my( $self ) = @_;
$self->{flushing} = 0;
DEBUG and $self->D( "Flushed" );
# wrote a bit of a file
if( $self->{sendfile} ) {
return $self->sendfile_next; # send some more
}
# Request has finished
if( not $self->{resp} or $self->{S}{done} or $self->{resp}->finished ) {
return $self->finish_request;
}
# streaming?
elsif( $self->{resp}->streaming ) {
return $self->send_more; # send some more
}
# The last possiblity is that calls to ->send have filled up the Wheel's
# or the driver's buffer and it was flushed.
}
#######################################
# Clean up after a request
sub finish_request
{
my( $self ) = @_;
$self->state( 'done' );
DEBUG and $self->D( 'finish_request' );
if( $self->keepalive_start ) {
# if we have keepalive set, then we don't need the TCP timeout
$self->timeout_stop;
}
# If we don't have a keepalive, {will_close} will be true and that will
# force a socket close
# next 3 MUST be in this order if we want post_request to always come
# before on_disconnect (which is posted from ->close())
$self->special_dispatch( 'post_request', $self->{req}, $self->{resp} );
$self->close if $self->{will_close};
$self->drop;
$self->pending_next;
# T->end( 'REQ' );
}
#######################################
sub dispatch
{
my( $self ) = @_;
my $path = $self->{req} && $self->{req}->uri ?
$self->{req}->uri->path : '/';
my( $why, $handler ) = $self->find_handler( $path );
if( $handler ) {
# T->point( REQ => "handler $re" );
$self->invoke( $why, $handler, $self->{req}, $self->{resp} );
}
else {
$self->{resp}->error( RC_NOT_FOUND, "No handler for path $path.\n" );
}
}
#######################################
sub find_handler
{
my( $self, $path ) = @_;
DEBUG and $self->D( "Request for $path" );
lib/POEx/HTTP/Server.pm view on Meta::CPAN
$self->{resp}->content( undef() );
$self->timeout_start();
return;
}
sub send_headers
{
my( $self ) = @_;
DEBUG and $self->D( "Response: ".$self->{resp}->status_line );
$self->__fix_headers;
$self->output( $self->{resp} );
$self->{resp}->headers_sent( 1 );
}
#######################################
sub __fix_headers
{
my( $self ) = @_;
while( my( $h, $v ) = each %{$self->{headers}} ) {
next if $self->{resp}->header( $h );
$self->{resp}->header( $h => $v);
}
# Tell the browser the connection should close
if( $self->{will_close} and $self->{req} and $self->{req}->protocol eq 'HTTP/1.1' ) {
my $c = $self->{resp}->header( 'Connection' );
if( $c ) { $c .= ",close" }
else { $c = 'close' }
$self->{resp}->header( 'Connection', $c );
}
}
#######################################
sub should_close
{
my( $self ) = @_;
$self->{will_close} = 1;
if ( $self->{req} and $self->{req}->protocol eq 'HTTP/1.1' ) {
$self->{will_close} = 0; # keepalive
# It turns out the connection field can contain multiple
# comma separated values
my $conn = $self->{req}->header('Connection')||'';
$self->{will_close} = 1 if qq(,$conn,) =~ /,\s*close\s*,/i;
#warn "$$:conn=$conn will_close=$self->{will_close}";
# Allow handler code to control the connection
$conn = $self->{resp}->header('Connection')||'';
$self->{will_close} = 1 if qq(,$conn,) =~ /,\s*close\s*,/i;
#warn "$$:conn=$conn will_close=$self->{will_close}";
}
else {
# HTTP/1.0-style keep-alives fail
#my $conn = $self->{req}->header('Connection')||'';
#$self->{will_close} = 0 if qq(,$conn,) =~ /,\s*keep-alive\s*,/i;
#warn "$$:conn=$conn will_close=$self->{will_close}";
}
$self->{will_close} = 1 if $self->{resp}->streaming;
#warn "$$:post streaming will_close=$self->{will_close}";
$self->{will_close} = 1 unless $self->{keepalive} > 1;
#warn "$$:post keepalive will_close=$self->{will_close}";
$self->{will_close} = 1 if $self->{shutdown};
DEBUG and
$self->D( "will_close=$self->{will_close}" );
return $self->{will_close};
}
#######################################
sub send
{
my( $self, $something ) = @_;
DEBUG and $self->D("send");
confess "Responding more then once to a request" unless $self->{resp};
unless( $self->{resp}->headers_sent ) {
$self->should_close;
$self->send_headers;
$self->{stream_wheel} = 1;
$self->{wheel}->set_output_filter( $self->build_stream_filter );
if( $self->{resp}->streaming ) {
eval {
$SIG{__DIE__} = 'DEFAULT';
$self->__tcp_hot;
};
warn $@ if $@;
}
}
$self->output( $something ) if defined $something;
if( $self->{resp}->streaming and $self->{wheel} ) {
$self->{wheel}->flush;
}
$self->timeout_start();
return;
}
# We are in streaming mode. The last chunk has flushed. Send a new one
sub send_more
{
my( $self ) = @_;
$self->timeout_stop();
$self->special_dispatch( 'stream_request', $self->{req}, $self->{resp} );
}
# We are in streaming mode. Turn off Nagle's algorithm
# This isn't as effective as you might think
sub __tcp_hot
{
my( $self ) = @_;
DEBUG and
$self->D( "TCP_NODELAY" );
my $h = $self->{wheel}->get_output_handle;
setsockopt($h, Socket::IPPROTO_TCP(), Socket::TCP_NODELAY(), 1)
or die "setsockopt TCP_NODELAY: $!";
# Note: On linux, even if we set the buffer size to 576, the minimum
# is 2048. However, this still allows us to by-pass Nagle's algorithm.
setsockopt($h, Socket::SOL_SOCKET(), Socket::SO_SNDBUF(), 576)
or die "setsockopt SO_SNDBUF: $!";
DEBUG and $self->D( "SO_SNDBUF=", unpack "i",
getsockopt($h, Socket::SOL_SOCKET(), Socket::SO_SNDBUF()));
}
sub __tcp_sndbuf
{
my( $self ) = @_;
my $h = $self->{wheel}->get_output_handle;
my $bs = eval {
$SIG{__DIE__} = 'DEFAULT';
return unpack "i", getsockopt($h, Socket::SOL_SOCKET(), Socket::SO_SNDBUF());
};
return $bs;
}
#######################################
# Send an entire file
# This is a callback from Response
# $path is what should be reported in errors
# $file is the full path to a readable file
# $size is the amount of the file to send. Should be entire file.
sub sendfile_start
{
my( $self, $path, $file, $size ) = @_;
die "Already sending a file" if $self->{sendfile};
DEBUG and $self->D( "sendfile path=$path size=$size" );
# Open the file
my $fh = IO::File->new;
unless( $fh->open($file) ) {
$self->{resp}->error(RC_INTERNAL_SERVER_ERROR, "Unable to open $path: $!" );
return;
}
$self->{sendfile} = { offset=>0, size=>$size, fh=>$fh,
path=>$path, bs=>$self->{blocksize} };
$self->send;
# we wait for the 'flush' event to invoke sendfile.
$self->timeout_start();
}
sub sendfile_next
lib/POEx/HTTP/Server.pm view on Meta::CPAN
There are 5 special handlers that are invoked when a browser connection is
opened and closed, before and after each request and when an error occurs.
The note about L</Handler parameters> also aplies to special handlers.
=head3 on_connect
Invoked when a new connection is made to the server. C<ARG0> is a
L<POEx::HTTP::Server::Connection> object that may be queried for information
about the connection. This connection object will be shared by all requests
objects that use this connection.
POEx::HTTP::Server->spawn(
handlers => { on_connect => 'poe:my-session/on_connect' }
);
sub on_connect {
my( $object, $connection ) = @_[OBJECT, ARG0];
# ...
}
=head3 on_disconnect
Invoked when a connection is closed. C<ARG0> is the same
L<POEx::HTTP::Server::Connection> object that was passed to L</on_connect>.
=head3 pre_request
Invoked after a request is read from the browser but before it is processed.
C<ARG0> is a L<POEx::HTTP::Server::Request> object. There is no C<ARG1>.
POEx::HTTP::Server->spawn(
handlers => { pre_request => 'poe:my-session/pre' }
);
sub pre {
my( $object, $request ) = @_[OBJECT, ARG0];
my $connection = $request->connection;
# ...
}
If you use L</keepalive>, L</pre_request> will be invoked more often then
C<on_connect>.
=head3 post_request
Invoked after a response has been sent to the browser.
C<ARG0> is a L<POEx::HTTP::Server::Request> object.
C<ARG1> is a L<POEx::HTTP::Server::Response> object, with
it's C<content> cleared.
POEx::HTTP::Server->spawn(
handlers => { pre_request => 'poe:my-session/post' }
);
sub post {
my( $self, $request, $response ) = @_[OBJECT, ARG0, ARG1];
my $connection = $request->connection;
# ...
}
=head3 stream_request
Invoked when a chunk has been flushed to the OS, if you are streaming a
response to the browser. Streaming is turned on with
L<POEx::HTTP::Server::Response/streaming>.
Please remember that while a chunk might be flushed, the OS's network layer
might still decide to combine several chunks into a single packet. And this
even though we setup a I<hot> socket with C<TCP_NODELAY> set to 1 and
C<SO_SNDBUF> to 576.
=head3 on_error
Invoked when the server detects an error. C<ARG0> is a
L<POEx::HTTP::Server::Error> object.
There are 2 types of errors: network errors and HTTP errors. They may be
distiguished by calling the error object's C<op> method. If C<op> returns
C<undef()>, it is an HTTP error, otherwise a network error. HTTP errors
already have a message to the browser with HTML content. You may modify the
HTTP error's content and headers before they get sent back to the browser.
Unlike HTTP errors, network errors are never sent to the browser.
POEx::HTTP::Server->spawn(
handlers => { on_error => 'poe:my-session/error' }
);
sub error {
my( $self, $err ) = @_[OBJECT, ARG0];
if( $err->op ) { # network error
$self->LOG( $err->op." error [".$err->errnum, "] ".$err->errstr );
# or the equivalent
$self->LOG( $err->content );
}
else { # HTTP error
$self->LOG( $err->status_line );
$self->content_type( 'text/plain' );
$self->content( "Don't do that!" );
}
}
=head1 EVENTS
The following POE events may be used to control POEx::HTTP::Server.
=head2 shutdown
$poe_kernel->signal( $poe_kernel => 'shutdown' );
$poe_kernel->post( HTTPd => 'shutdown' );
Initiate server shutdown. Any pending requests will stay active, however.
The session will exit when the last of the requests has finished. No further
requests will be accepted, even if keepalive is in use.
=head2 handlers_get
my $handlers = $poe_kernel->call( HTTPd => 'handlers_get' );
Fetch a hashref of handlers and their URIs. This list contains both the
special handlers and the HTTP handlers.
=head2 handlers_set
$poe_kernel->post( HTTPD => handlers_set => $URI );
$poe_kernel->post( HTTPD => handlers_set => $ARRAYREF );
lib/POEx/HTTP/Server.pm view on Meta::CPAN
on the regex, not the handler's URI. The regex must be exactly identical to
the regex supplied to L</handlers>.
The sole parameter may be :
=head3 $RE
$poe_kernel->post( HTTPD => handers_remove => '^/static' );
The handler associated with this regex is removed.
=head3 $ARRAYREF
$poe_kernel->post( HTTPD => handers_remove =>
[ '^/static', '^/static/bigger' ] );
Remove a list of handlers associated.
=head3 $HASHREF
$poe_kernel->post( HTTPD => handers_remove =>
{ '^/static' => 1, '^/static/bigger' => 1 } );
The hash's keys are a list of regexes to remove. The values are ignored.
Note that modifying the set of handlers will not modify the handlers for
currently open connections.
=head1 NOTES
=head2 Sending headers
If you wish to send the headers right away, but send the body later, you may do:
$resp->header( 'Content-Length' => $size );
$resp->send;
The above causes the headers to be sent, allong with any content you might
have added to C<$resp>.
When you want to send the body:
$resp->send( $content );
When you are finished:
$resp->done;
=head2 Streaming
Streaming is very similar to sending the headers and body seperately. See
above. One difference is that the headers will be flushed and the socket
will be set to I<hot> with TCP_NODELAY and SO_SNBUF. Another difference is that
keepalive is deactivated for the connection. Finally difference
is that you will see C<L</stream_request>> when you are allowed to send the
next block. Look for C<L</post_request>> to find out when the last block has
been sent to the browser.
$resp->streaming( 1 );
$resp->header( 'Content-Length' => $size );
$resp->send;
When you want to send a chunk:
$resp->send( $chunk );
This can be repeated as long as you want.
When you are finished:
$resp->done;
This will provoke a L</post_request> when the last chunk is flushed.
=head2 blocksize and MTU
If you are using sendfile, but do not have L<Sys::Sendfile> installed you
really should set L</blocksize> to a whole multiple of the interface's MTU.
Doing so automatically is currently beyond the scope of this module. Please
see L<Net::Interface/mtu>. But that won't help for servers available over
the the Internet; your local ethernet interface's MTU (1500) is probably
greater then your internet connection's MTU (1400-1492 for DSL). What's
more, the MTU could be as low as 576.
=head1 SEE ALSO
L<POE>,
L<POEx::HTTP::Server::Request>,
L<POEx::HTTP::Server::Response>,
L<POEx::HTTP::Server::Error>,
L<POEx::HTTP::Server::Connection>,
=head1 AUTHOR
Philip Gwyn, E<lt>gwyn -at- cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2010, 2011 by Philip Gwyn. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut
( run in 1.166 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )