######################################################################
# HTTP connection to backend node
# possible states: connecting, bored, sending_req, wait_res, xfer_res
######################################################################

package Perlbal::BackendHTTP;
use strict;
use warnings;
use base "Perlbal::Socket";
use fields ('client',  # Perlbal::ClientProxy connection, or undef
            'service', # Perlbal::Service
            'pool',    # Perlbal::Pool; whatever pool we spawned from
            'ip',      # IP scalar
            'port',    # port scalar
            'ipport',  # "$ip:$port"
            'reportto', # object; must implement reporter interface

            'has_attention', # has been accepted by a webserver and
                             # we know for sure we're not just talking
                             # to the TCP stack

            'waiting_options', # if true, we're waiting for an OPTIONS *
                               # response to determine when we have attention

            'disconnect_at', # time this connection will be disconnected,
                             # if it's kept-alive and backend told us.
                             # otherwise undef for unknown.

            # The following only apply when the backend server sends
            # a content-length header
            'content_length',  # length of document being transferred
            'content_length_remain',    # bytes remaining to be read

            'use_count',  # number of requests this backend's been used for
            'generation', # int; counts what generation we were spawned in
            );
use Socket qw(PF_INET IPPROTO_TCP SOCK_STREAM);

use Perlbal::ClientProxy;

# if this is made too big, (say, 128k), then perl does malloc instead
# of using its slab cache.
use constant BACKEND_READ_SIZE => 61449;  # 60k, to fit in a 64k slab

# keys set here when an endpoint is found to not support persistent
# connections and/or the OPTIONS method
our %NoVerify; # { "ip:port" => next-verify-time }
our %NodeStats; # { "ip:port" => { ... } }; keep statistics about nodes

# constructor for a backend connection takes a service (pool) that it's
# for, and uses that service to get its backend IP/port, as well as the
# client that will be using this backend connection.  final parameter is
# an options hashref that contains some options:
#       reportto => object obeying reportto interface
sub new {
    my ($class, $svc, $ip, $port, $opts) = @_;
    $opts ||= {};

    my $sock;
    socket $sock, PF_INET, SOCK_STREAM, IPPROTO_TCP;

    unless ($sock && defined fileno($sock)) {
        Perlbal::log('crit', "Error creating socket: $!");
        return undef;
    }

    IO::Handle::blocking($sock, 0);
    connect $sock, Socket::sockaddr_in($port, Socket::inet_aton($ip));

    my $self = fields::new($class);
    $self->SUPER::new($sock);

    Perlbal::objctor($self);

    $self->{ip}      = $ip;       # backend IP
    $self->{port}    = $port;     # backend port
    $self->{ipport}  = "$ip:$port";  # often used as key
    $self->{service} = $svc;      # the service we're serving for
    $self->{pool}    = $opts->{pool}; # what pool we came from.
    $self->{reportto} = $opts->{reportto} || $svc; # reportto if specified
    $self->state("connecting");

    # mark another connection to this ip:port
    $NodeStats{$self->{ipport}}->{attempts}++;
    $NodeStats{$self->{ipport}}->{lastattempt} = $self->{create_time};

    # setup callback in case we get stuck in connecting land
    Perlbal::Socket::register_callback(15, sub {
        if ($self->state eq 'connecting' || $self->state eq 'verifying_backend') {
            # shouldn't still be connecting/verifying ~15 seconds after create
            $self->close('callback_timeout');
        }
        return 0;
    });

    # for header reading:
    $self->{req_headers} = undef;
    $self->{res_headers} = undef;  # defined w/ headers object once all headers in
    $self->{headers_string} = "";  # blank to start
    $self->{read_buf} = [];        # scalar refs of bufs read from client
    $self->{read_ahead} = 0;       # bytes sitting in read_buf
    $self->{read_size} = 0;        # total bytes read from client

    $self->{client}   = undef;     # Perlbal::ClientProxy object, initially empty 
                                   #    until we ask our service for one

    $self->{has_attention} = 0;
    $self->{use_count}     = 0;
    $self->{generation}    = $opts->{generation};

    bless $self, ref $class || $class;
    $self->watch_write(1);
    return $self;
}

sub close {
    my Perlbal::BackendHTTP $self = shift;

    # don't close twice
    return if $self->{closed};

    # this closes the socket and sets our closed flag
    $self->SUPER::close(@_);

    # tell our client that we're gone
    if (my $client = $self->{client}) {
        $client->backend(undef);
        $self->{client} = undef;
    }

    # tell our owner that we're gone
    if (my $reportto = $self->{reportto}) {
        $reportto->note_backend_close($self);
        $self->{reportto} = undef;
    }
}

# return our defined generation counter with no parameter,
# or set our generation if given a parameter
sub generation {
    my Perlbal::BackendHTTP $self = $_[0];
    return $self->{generation} unless $_[1];
    return $self->{generation} = $_[1];
}

# return what ip and port combination we're using
sub ipport {
    my Perlbal::BackendHTTP $self = $_[0];
    return $self->{ipport};
}

# called by service when it's got a client for us, or by ourselves
# when we asked for a client.
# returns true if client assignment was accepted.
sub assign_client {
    my Perlbal::BackendHTTP $self = shift;
    my Perlbal::ClientProxy $client = shift;
    return 0 if $self->{client};

    # set our client, and the client's backend to us
    $self->{service}->mark_node_used($self->{ipport});
    $self->{client} = $client;
    $self->state("sending_req");
    $self->{client}->backend($self);

    my Perlbal::HTTPHeaders $hds = $client->{req_headers}->clone;
    $self->{req_headers} = $hds;

    # Use HTTP/1.0 to backend (FIXME: use 1.1 and support chunking)
    $hds->set_version("1.0");

    my $persist = $self->{service}{persist_backend};

    $hds->header("Connection", $persist ? "keep-alive" : "close");

    $hds->header("X-Proxy-Capabilities", "reproxy-file");

    # decide whether we trust the upstream or not
    my $trust = $self->{service}->{always_trusted}; # set to default auto-trust level
    if ($self->{service} && $self->{service}->{trusted_upstreams}) {
        $trust = 1
            if $self->{service}->{trusted_upstreams}->match($client->peer_ip_string);
    }

    # if we're not going to trust the upstream, reset these for security reasons
    unless ($trust) {
        $hds->header("X-Forwarded-For", $client->peer_ip_string);
        $hds->header("X-Host", undef);
        $hds->header("X-Forwarded-Host", undef);
    }

    $self->tcp_cork(1);
    $client->state('backend_req_sent');

    $self->{content_length} = undef;
    $self->{content_length_remain} = undef;

    # run hooks
    return 1 if $self->{service}->run_hook('backend_client_assigned', $self);

    # now cleanup the headers before we send to the backend
    $self->{service}->munge_headers($hds) if $self->{service};

    $self->write($hds->to_string_ref);
    $self->write(sub {
        $self->tcp_cork(0);
        if (my $client = $self->{client}) {
            # start waiting on a reply
            $self->watch_read(1);
            $self->state("wait_res");
            $client->state('wait_res');
            # make the client push its overflow reads (request body)
            # to the backend
            $client->drain_read_buf_to($self);
            # and start watching for more reads
            $client->watch_read(1);
        }
    });

    return 1;
}

# Backend
sub event_write {
    my Perlbal::BackendHTTP $self = shift;
    print "Backend $self is writeable!\n" if Perlbal::DEBUG >= 2;

    my $now = time();
    delete $NoVerify{$self->{ipport}} if
        defined $NoVerify{$self->{ipport}} &&
        $NoVerify{$self->{ipport}} < $now;

    if (! $self->{client} && $self->{state} eq "connecting") {
        # not interested in writes again until something else is
        $self->watch_write(0);
        $NodeStats{$self->{ipport}}->{connects}++;
        $NodeStats{$self->{ipport}}->{lastconnect} = $now;

        if (defined $self->{service} && $self->{service}->{verify_backend} &&
            !$self->{has_attention} && !defined $NoVerify{$self->{ipport}}) {

            # the backend should be able to answer this incredibly quickly.
            $self->write("OPTIONS * HTTP/1.0\r\nConnection: keep-alive\r\n\r\n");
            $self->watch_read(1);
            $self->{waiting_options} = 1;
            $self->{content_length_remain} = undef;
            $self->state("verifying_backend");
        } else {
            # register our boredom (readiness for a client/request)
            $self->state("bored");
            $self->{reportto}->register_boredom($self);
        }
        return;
    }

    my $done = $self->write(undef);
    $self->watch_write(0) if $done;
}

sub verify_failure {
    my Perlbal::BackendHTTP $self = shift;
    $NoVerify{$self->{ipport}} = time() + 60;
    $self->{reportto}->note_bad_backend_connect($self);
    $self->close('no_keep_alive');
    return;
}

# Backend
sub event_read {
    my Perlbal::BackendHTTP $self = shift;
    print "Backend $self is readable!\n" if Perlbal::DEBUG >= 2;

    if ($self->{waiting_options}) {
        if ($self->{content_length_remain}) {
            # the HTTP/1.1 spec says OPTIONS responses can have content-lengths,
            # but the meaning of the response is reserved for a future spec.
            # this just gobbles it up for.
            my $bref = $self->read(BACKEND_READ_SIZE);
            return $self->verify_failure unless defined $bref;
            $self->{content_length_remain} -= length($$bref);
        } elsif (my $hd = $self->read_response_headers) {
            # see if we have keep alive support
            return $self->verify_failure unless $hd->res_keep_alive($self->{req_headers});
            $self->{content_length_remain} = $hd->header("Content-Length");
        }

        # if we've got the option response and read any response data
        # if present:
        if ($self->{res_headers} && ! $self->{content_length_remain}) {
            # other setup to mark being done with options checking
            $self->{waiting_options} = 0;
            $self->{has_attention} = 1;
            $NodeStats{$self->{ipport}}->{verifies}++;
            $self->next_request(1); # initial
        }
        return;
    }

    my Perlbal::ClientProxy $client = $self->{client};

    # with persistent connections, sometimes we have a backend and
    # no client, and backend becomes readable, either to signal
    # to use the end of the stream, or because a bad request error,
    # which I can't totally understand.  in any case, we have
    # no client so all we can do is close this backend.
    return $self->close('read_with_no_client') unless $client;

    unless ($self->{res_headers}) {
        if (my $hd = $self->read_response_headers) {
            # note we got this response code
            my $ref = ($NodeStats{$self->{ipport}}->{responsecodes} ||= []);
            push @$ref, $hd->response_code;
            if (scalar(@$ref) > 500) {
                shift @$ref;
            }

            # call service response received function
            return if $self->{reportto}->backend_response_received($self);

            # standard handling
            $self->state("xfer_res");
            $client->state("xfer_res");
            $self->{has_attention} = 1;

            # RFC 2616, Sec 4.4: Messages MUST NOT include both a
            # Content-Length header field and a non-identity
            # transfer-coding. If the message does include a non-
            # identity transfer-coding, the Content-Length MUST be
            # ignored.
            my $te = $hd->header("Transfer-Encoding");
            if ($te && $te !~ /\bidentity\b/i) {
                $hd->header("Content-Length", undef);
            }

            my Perlbal::HTTPHeaders $rqhd = $self->{req_headers};

            # setup our content length so we know how much data to expect, in general
            # we want the content-length from the response, but if this was a head request
            # we know it's a 0 length message the client wants
            if ($rqhd->request_method eq 'HEAD') {
                $self->{content_length} = 0;
            } else {
                $self->{content_length} = $hd->content_length;
            }
            $self->{content_length_remain} = $self->{content_length} || 0;

            if (my $rep = $hd->header('X-REPROXY-FILE')) {
                # make the client begin the async IO while we move on
                $client->start_reproxy_file($rep, $hd);
                $self->next_request;
                return;
            } elsif (my $urls = $hd->header('X-REPROXY-URL')) {
                $client->start_reproxy_uri($self->{res_headers}, $urls);
                $self->next_request;
                return;
            } else {
                my $res_source = $client->{primary_res_hdrs} || $hd;
                my $thd = $client->{res_headers} = $res_source->clone;

                # setup_keepalive will set Connection: and Keep-Alive: headers for us
                # as well as setup our HTTP version appropriately
                $client->setup_keepalive($thd);

                # if we had an alternate primary response header, make sure
                # we send the real content-length (from the reproxied URL)
                # and not the one the first server gave us
                if ($client->{primary_res_hdrs}) {
                    $thd->header('Content-Length', $hd->header('Content-Length'));
                    $thd->header('X-REPROXY-FILE', undef);
                    $thd->header('X-REPROXY-URL', undef);
                    $thd->header('X-REPROXY-EXPECTED-SIZE', undef);
                }

                $client->write($thd->to_string_ref);

                # if we over-read anything from backend (most likely)
                # then decrement it from our count of bytes we need to read
                if (defined $self->{content_length}) {
                    $self->{content_length_remain} -= $self->{read_ahead};
                }
                $self->drain_read_buf_to($client);

                if (defined $self->{content_length} && ! $self->{content_length_remain}) {
                    # order important:  next_request detaches us from client, so
                    # $client->close can't kill us
                    $self->next_request;
                    $client->write(sub { $client->backend_finished; });
                }
            }
        }
        return;
    }

    # if our client's behind more than the max limit, stop buffering
    my $buf_size = defined $self->{service} ? $client->{service}->{buffer_size} : $client->{service}->{buffer_size_reproxy_url};
    if ($client->{write_buf_size} > $buf_size) {
        $self->watch_read(0);
        return;
    }

    my $bref = $self->read(BACKEND_READ_SIZE);

    if (defined $bref) {
        $client->write($bref);

        # HTTP/1.0 keep-alive support to backend.  we just count bytes
        # until we hit the end, then we know we can send another
        # request on this connection
        if ($self->{content_length}) {
            $self->{content_length_remain} -= length($$bref);
            if (! $self->{content_length_remain}) {
                # order important:  next_request detaches us from client, so
                # $client->close can't kill us
                $self->next_request;
                $client->write(sub { $client->backend_finished; });
            }
        }
        return;
    } else {
        # backend closed
        print "Backend $self is done; closing...\n" if Perlbal::DEBUG >= 1;

        $client->backend(undef);    # disconnect ourselves from it
        $self->{client} = undef;    # .. and it from us
        $self->close('backend_disconnect'); # close ourselves

        $client->write(sub { $client->backend_finished; });
        return;
    }
}

# if $initial is on, then don't increment use count
sub next_request {
    my Perlbal::BackendHTTP $self = $_[0];
    my $initial = $_[1];

    # don't allow this if we're closed
    return if $self->{closed};

    # set alive_time so reproxy can intelligently reuse this backend
    my $now = time();
    $self->{alive_time} = $now;
    $NodeStats{$self->{ipport}}->{requests}++ unless $initial;
    $NodeStats{$self->{ipport}}->{lastresponse} = $now;

    my $hd = $self->{res_headers};  # response headers

    # verify that we have keep-alive support
    return $self->close('next_request_no_persist')
        unless $hd->res_keep_alive($self->{req_headers});

    # and now see if we should closed based on the pool we're from
    return $self->close('pool_requested_closure')
        if $self->{pool} && ! $self->{pool}->backend_should_live($self);

    # we've been used
    $self->{use_count}++ unless $initial;

    # service specific
    if (my Perlbal::Service $svc = $self->{service}) {
        # keep track of how many times we've been used, and don't
        # keep using this connection more times than the service
        # is configured for.
        if ($svc->{max_backend_uses} && ($self->{use_count} > $svc->{max_backend_uses})) {
            return $self->close('exceeded_max_uses');
        }
    }

    # if backend told us, keep track of when the backend
    # says it's going to boot us, so we don't use it within
    # a few seconds of that time
    if (($hd->header("Keep-Alive") || '') =~ /\btimeout=(\d+)/i) {
        $self->{disconnect_at} = $now + $1;
    } else {
        $self->{disconnect_at} = undef;
    }

    $self->{client} = undef;

    $self->state("bored");
    $self->watch_write(0);

    $self->{req_headers} = undef;
    $self->{res_headers} = undef;
    $self->{headers_string} = "";
    $self->{req_headers} = undef;

    $self->{read_size} = 0;
    $self->{content_length_remain} = undef;
    $self->{content_length} = undef;

    $self->{reportto}->register_boredom($self);
    return;
}

# Backend: bad connection to backend
sub event_err {
    my Perlbal::BackendHTTP $self = shift;

    # FIXME: we get this after backend is done reading and we disconnect,
    # hence the misc checks below for $self->{client}.

    print "BACKEND event_err\n" if
        Perlbal::DEBUG >= 2;

    if ($self->{client}) {
        # request already sent to backend, then an error occurred.
        # we don't want to duplicate POST requests, so for now
        # just fail
        # TODO: if just a GET request, retry?
        $self->{client}->close('backend_error');
        $self->close('error');
        return;
    }

    if ($self->{state} eq "connecting" ||
        $self->{state} eq "verifying_backend") {
        # then tell the service manager that this connection
        # failed, so it can spawn a new one and note the dead host
        $self->{reportto}->note_bad_backend_connect($self, 1);
    }

    # close ourselves first
    $self->close("error");
}

# Backend
sub event_hup {
    my Perlbal::BackendHTTP $self = shift;
    print "HANGUP for $self\n" if Perlbal::DEBUG;
    $self->close("after_hup");
}

sub as_string {
    my Perlbal::BackendHTTP $self = shift;

    my $ret = $self->SUPER::as_string;
    my $name = $self->{sock} ? getsockname($self->{sock}) : undef;
    my $lport = $name ? (Socket::sockaddr_in($name))[0] : undef;
    $ret .= ": localport=$lport" if $lport;
    if (my Perlbal::ClientProxy $cp = $self->{client}) {
        $ret .= "; client=$cp->{fd}";
    }
    $ret .= "; uses=$self->{use_count}; $self->{state}";
    if (defined $self->{service} && $self->{service}->{verify_backend}) {
        $ret .= "; has_attention=";
        $ret .= $self->{has_attention} ? 'yes' : 'no';
    }

    return $ret;
}

sub die_gracefully {
    # see if we need to die
    my Perlbal::BackendHTTP $self = shift;
    $self->close('graceful_death') if $self->state eq 'bored';
}

sub DESTROY {
    Perlbal::objdtor($_[0]);
    $_[0]->SUPER::DESTROY;
}

1;

# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End: