AxKit2

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

http://trac.axkit.org/axkit2/timeline

1.1
    --  Only load Data::Dumper and Devel::GC::Helper in the forked process when
        doing "leaks" in the console so as not to bloat the parent.
    --  Many fixes to serve_file
    --  Continuation support
    --  Much improved error handling
    --  Implemented error output for most non-OK responses
    --  Improved gallery speed
    --  Made keep-alives work
    --  Numerous performance improvements
    --  New config directive system
    --  Added typeless_uri plugin
    --  Work around a bug in debian's libxml-perl-sax-base
    --  Fix small security hole in doc_viewer plugin
    --  Implemented test framework (and some tests)
    --  Fully implement AIO versions of uri_to_file and serve_file
    --  Support HTTP/0.9 requests
    --  Support If-Modified-Since/Last-Modified in serve_file
    --  Fully fix path_info parsing to be same as Apache HTTPD

lib/AxKit2/Connection.pm  view on Meta::CPAN


use strict;
use warnings;
use base qw(Danga::Socket AxKit2::Client);

use AxKit2::HTTPHeaders;
use AxKit2::Constants;
use AxKit2::Utils qw(http_date);

use fields qw(
    alive_time
    create_time
    headers_string
    headers_in
    headers_out
    ditch_leading_rn
    server_config
    path_config
    http_headers_sent
    notes
    sock_closed
    pause_count
    continuation
    keep_alive_count
    );

use constant KEEP_ALIVE_MAX => 100;
use constant CLEANUP_TIME => 5; # every N seconds
use constant MAX_HTTP_HEADER_LENGTH => 102400; # 100k

sub new {
    my AxKit2::Connection $self = shift;
    my $sock = shift;
    my $servconf = shift;
    $self = fields::new($self) unless ref($self);
    
    $self->SUPER::new($sock);

    my $now = time;
    $self->{alive_time} = $self->{create_time} = $now;
    
    $self->{headers_string} = '';
    $self->{closed} = 0;
    $self->{ditch_leading_rn} = 0; # TODO - work out how to set that...
    $self->{server_config} = $servconf;
    $self->{keep_alive_count} = 0;
    $self->{notes} = {};
    
    $self->log(LOGINFO, "Connection from " . $self->peer_addr_string);
    
    $self->hook_connect();
    
    return $self;
}

=head2 C<< $obj->uptime >>

lib/AxKit2/Connection.pm  view on Meta::CPAN

}

sub max_idle_time       { 30 }
sub max_connect_time    { 180 }
sub event_err { my AxKit2::Connection $self = shift; $self->close("Error") }
sub event_hup { my AxKit2::Connection $self = shift; $self->close("Disconnect (HUP)") }
sub close     { my AxKit2::Connection $self = shift; $self->{sock_closed}++; $self->{notes} = undef; $self->SUPER::close(@_) }

sub event_read {
    my AxKit2::Connection $self = shift;
    $self->{alive_time} = time;
    
    if ($self->{headers_in}) {
        # already got the headers... do we get a body too?
        my $bref = $self->read(8192);
        return $self->close($!) unless defined $bref;
        return $self->hook_body_data($bref);
    }
    my $to_read = MAX_HTTP_HEADER_LENGTH - length($self->{headers_string});
    my $bref = $self->read($to_read);
    return $self->close($!) unless defined $bref;

lib/AxKit2/Connection.pm  view on Meta::CPAN

        $self->default_error_out(BAD_REQUEST);
    }
    
    $self->{ditch_leading_rn} = 0;
    
    $self->hook_post_read_request($self->{headers_in});
}

sub event_write {
    my AxKit2::Connection $self = shift;
    $self->{alive_time} = time;
    
    if ($self->hook_write_body_data) {
        return;
    }
    
    # if hook_write_body_data didn't want to send anything, we just pump
    # whatever's in the queue to go out.
    if ($self->write(undef)) {
        # Everything sent. No need to watch for write notifications any more.
        $self->watch_write(0);

lib/AxKit2/Connection.pm  view on Meta::CPAN

    $self->{headers_out}->header(Server => "AxKit-2/v$AxKit2::VERSION");
}

sub process_request {
    my AxKit2::Connection $self = shift;
    my $hd = $self->{headers_in};
    
    $self->initialize_response($hd);
    
    no warnings 'uninitialized';
    if ($hd->header('Connection') =~ /\bkeep-alive\b/i) {
        # client asked for keep alive. Do we?
        $self->{keep_alive_count}++;
        if ($self->{keep_alive_count} > KEEP_ALIVE_MAX) {
            $self->{headers_out}->header(Connection => 'close');
        }
        else {
            $self->{headers_out}->header(Connection => 'Keep-Alive');
            $self->{headers_out}->header('Keep-Alive' => 
                "timeout=" . $self->max_idle_time . 
                ", max=" .  (KEEP_ALIVE_MAX - $self->{keep_alive_count}));
        }
    }

    # This starts off the chain reaction of the main state machine
    $self->hook_uri_translation($hd, $hd->request_uri);
}

# called when we've finished writing everything to a client and we need
# to reset our state for another request.  returns 1 to mean that we should
# support persistence, 0 means we're discarding this connection.
sub http_response_sent {
    my AxKit2::Connection $self = $_[0];
    
    $self->log(LOGDEBUG, "Response sent");
    
    return 0 if $self->{sock_closed};
    
    # close if we're supposed to
    if (
        ! defined $self->{headers_out} ||
        ! $self->{headers_out}->res_keep_alive($self->{headers_in})
        )
    {
        # do a final read so we don't have unread_data_waiting and RST
        # the connection.  IE and others send an extra \r\n after POSTs
        my $dummy = $self->read(5);
        
        # close if we have no response headers or they say to close
        $self->close("no_keep_alive");
        return 0;
    }

    # if they just did a POST, set the flag that says we might expect
    # an unadvertised \r\n coming from some browsers.  Old Netscape
    # 4.x did this on all POSTs, and Firefox/Safari do it on
    # XmlHttpRequest POSTs.
    if ($self->{headers_in}->request_method eq "POST") {
        $self->{ditch_leading_rn} = 1;
    }

    # now since we're doing persistence, uncork so the last packet goes.
    # we will recork when we're processing a new request.
    # TODO: Disabled because this seemed mostly relevant to Perlbal...
    $self->tcp_cork(0);

    # reset state
    $self->{alive_time}            = $self->{create_time} = time;
    $self->{headers_string}        = '';
    $self->{headers_in}            = undef;
    $self->{headers_out}           = undef;
    $self->{http_headers_sent}     = 0;
    $self->{notes}                 = {};
    $self->{path_config}           = undef;
    
    # NOTE: because we only speak 1.0 to clients they can't have
    # pipeline in a read that we haven't read yet.
    $self->watch_read(1);

lib/AxKit2/Connection.pm  view on Meta::CPAN

            $max_age{$ref}      = $ref->max_idle_time || 0;
            $max_connect{$ref}  = $ref->max_connect_time || 0;
        }
        if (my $t = $max_connect{$ref}) {
            if ($v->{create_time} < $now - $t) {
                push @to_close, $v;
                next;
            }
        }
        if (my $t = $max_age{$ref}) {
            if ($v->{alive_time} < $now - $t) {
                push @to_close, $v;
            }
        }
    }
    
    $_->close("Timeout") foreach @to_close;
}

1;

lib/AxKit2/Console.pm  view on Meta::CPAN

use strict;
use warnings;

use IO::Socket;
use AxKit2::Constants;
use Socket qw(IPPROTO_TCP TCP_NODELAY);

use base 'Danga::Socket';

use fields qw(
    alive_time
    create_time
    line
    );
    
use constant CLEANUP_TIME => 5; # seconds

our $PROMPT = "\nEnter command (or \"HELP\" for help)\n> ";

Danga::Socket->AddTimer(CLEANUP_TIME, \&_do_cleanup);

lib/AxKit2/Console.pm  view on Meta::CPAN


sub new {
    my $self = shift;
    my $sock = shift;
    my $conf = shift;
    $self = fields::new($self) unless ref($self);

    $self->SUPER::new($sock);

    my $now = time;
    $self->{alive_time} = $self->{create_time} = $now;
    $self->{line} = '';
    
    $self->write($PROMPT);
    
    return $self;
}

sub event_read {
    my AxKit2::Console $self = shift;
    $self->{alive_time} = time;

    my $bref = $self->read(8192);
    return $self->close($!) unless defined $bref;
    $self->process_read_buf($bref);
}

sub process_read_buf {
    my AxKit2::Console $self = shift;
    my $bref = shift;
    $self->{line} .= $$bref;

lib/AxKit2/Console.pm  view on Meta::CPAN

            $max_age{$ref}      = $ref->max_idle_time || 0;
            $max_connect{$ref}  = $ref->max_connect_time || 0;
        }
        if (my $t = $max_connect{$ref}) {
            if ($v->{create_time} < $now - $t) {
                push @to_close, $v;
                next;
            }
        }
        if (my $t = $max_age{$ref}) {
            if ($v->{alive_time} < $now - $t) {
                push @to_close, $v;
            }
        }
    }
    
    $_->close("Timeout") foreach @to_close;
}

1;

lib/AxKit2/HTTPHeaders.pm  view on Meta::CPAN

    # also, an OPTIONS requests generally has a defined but 0 content-length
    if (defined(my $clen = $self->header("Content-Length"))) {
        return $clen;
    }

    # if we get here, nothing matched, so we don't definitively know what the
    # content length is.  this is usually an error, but we try to work around it.
    return undef;
}

=head2 C<< $obj->req_keep_alive( RESPONSE_HEADERS ) >>

Given C<$obj> is the request headers, answers the question: "should a response
to this person specify keep-alive, given the request and the given response?"

This is used in proxy mode to determine based on the client's request and the
backend's response whether or not the response from the proxy (us) should do
keep-alive.

For normal responses (should a response be kept alive) see C<res_keep_alive>.

=cut
sub req_keep_alive {
    my AxKit2::HTTPHeaders $self = $_[0];
    my AxKit2::HTTPHeaders $res = $_[1] or Carp::confess("ASSERT: No response headers given");

    # get the connection header now (saves warnings later)
    my $conn = lc ($self->header('Connection') || '');

    # check the client
    if ($self->version_number < 1001) {
        # they must specify a keep-alive header
        return 0 unless $conn =~ /\bkeep-alive\b/i;
    }

    # so it must be 1.1 which means keep-alive is on, unless they say not to
    return 0 if $conn =~ /\bclose\b/i;

    # if we get here, the user wants keep-alive and seems to support it,
    # so we make sure that the response is in a form that we can understand
    # well enough to do keep-alive.  FIXME: support chunked encoding in the
    # future, which means this check changes.
    return 1 if defined $res->header('Content-length') ||
        $res->response_code == 304 || # not modified
        $res->response_code == 204 || # no content
        $self->request_method eq 'HEAD';

    # fail-safe, no keep-alive
    return 0;
}

=head2 C<< $obj->res_keep_alive_options >>

Determine if an options response from a backend looks like it can do keep-alive.

=cut
sub res_keep_alive_options {
    my AxKit2::HTTPHeaders $self = $_[0];
    return $self->res_keep_alive(undef, 1);
}

=head2 C<< $obj->res_keep_alive( REQUEST_HEADERS ) >>

Given C<$obj> is the response headers, answers the question: "is the backend
expected to stay open?"  this is a combination of the request we sent to it and
the response they sent...

You don't normally need to call this - it is automatically performed by the
backend.

=cut
sub res_keep_alive {
    my AxKit2::HTTPHeaders $self = $_[0];
    my AxKit2::HTTPHeaders $req = $_[1];
    my $is_options = $_[2];
    Carp::confess("ASSERT: No request headers given") unless $req || $is_options;

    # get the connection header now (saves warnings later)
    my $conn = lc ($self->header('Connection') || '');

    # if they said Connection: close, it's always not keep-alive
    return 0 if $conn =~ /\bclose\b/i;

    # handle the http 1.0/0.9 case which requires keep-alive specified
    if ($self->version_number < 1001) {
        # must specify keep-alive, and must have a content length OR
        # the request must be a head request
        return 1 if
            $conn =~ /\bkeep-alive\b/i &&
            ($is_options ||
             defined $self->header('Content-length') ||
             $req->request_method eq 'HEAD' ||
             $self->response_code == 304 || # not modified
             $self->response_code == 204
             ); # no content

        return 0;
    }

    # HTTP/1.1 case.  defaults to keep-alive, per spec, unless
    # asked for otherwise (checked above)
    # FIXME: make sure we handle a HTTP/1.1 response from backend
    # with connection: close, no content-length, going to a
    # HTTP/1.1 persistent client.  we'll have to add chunk markers.
    # (not here, obviously)
    return 1;
}

=head2 C<< $obj->range( SIZE ) >>

lib/AxKit2/Plugin.pm  view on Meta::CPAN


=item * Anything else - connection is rejected

=back


=head2 pre_request

Params: None

Called before headers are received. Useful if keep-alives are present as this
is called after a keep-alive request finishes but before the next request.


=head2 post_read_request

Params: HEADER

Called after the headers are received and parsed. Passed the C<AxKit2::HTTPHeaders>
object for the incoming headers.

Return Values:

lib/AxKit2/Plugin.pm  view on Meta::CPAN



=head2 response_sent

Params: CODE

Called after the response has been sent to the browser. The parameter is the
response code used (e.g. 200 for OK, 404 for Not Found, etc).

The return codes for this hook are used to determine if the connection should
be kept open in a keep-alive request.

Return Value:

=over 4

=item * C<DECLINED/OK> - Use default keep-alive response depending on request
type.

=item * C<DONE> - Request was OK, but don't keep the connection open.

=item * Anything Else - ... TBD.

=back


=head2 disconnect



( run in 0.870 second using v1.01-cache-2.11-cpan-df04353d9ac )