view release on metacpan or  search on metacpan

lib/Perlbal/BackendHTTP.pm  view on Meta::CPAN

}

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

# called to tell backend that the client has gone on to do something else now.
sub forget_client {
    my Perlbal::BackendHTTP $self = $_[0];
    $self->{client} = undef;
}

# 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};

    my $svc = $self->{service};

    # set our client, and the client's backend to us
    $svc->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;

    my $client_ip = $client->peer_ip_string;

    # I think I've seen this be undef in practice.  Double-check
    unless ($client_ip) {
        warn "Undef client_ip ($client) in assign_client.  Closing.";
        $client->close;
        return 0;
    }

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

    my $persist = $svc->{persist_backend};

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

    if ($svc->{enable_reproxy}) {
        $hds->header("X-Proxy-Capabilities", "reproxy-file");
    }

    # decide whether we trust the upstream or not, to give us useful
    # forwarding info headers
    if ($svc->trusted_ip($client_ip)) {
        # yes, we trust our upstream, so just append our client's IP
        # to the existing list of forwarded IPs, if we're a blind proxy
        # then don't append our IP to the end of the list.
        unless ($svc->{blind_proxy}) {
            my @ips = split /,\s*/, ($hds->header("X-Forwarded-For") || '');
            $hds->header("X-Forwarded-For", join ", ", @ips, $client_ip);
        }
    } else {
        # no, don't trust upstream (untrusted client), so remove all their
        # forwarding headers and tag their IP as the x-forwarded-for
        $hds->header("X-Forwarded-For", $client_ip);
        $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 $svc->run_hook('backend_client_assigned', $self);

    # now cleanup the headers before we send to the backend
    $svc->munge_headers($hds) if $svc;

    $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');
            $client->backend_ready($self);
        }
    });

    return 1;
}

# called by ClientProxy after we tell it our backend is ready and
# it has an upload ready on disk
sub invoke_buffered_upload_mode {
    my Perlbal::BackendHTTP $self = shift;

    # so, we're receiving a buffered upload, we need to go ahead and
    # start the buffered upload retransmission to backend process. we
    # have to turn watching for writes on, since that's what is doing
    # the triggering, NOT the normal client proxy watch for read
    $self->{buffered_upload_mode} = 1;
    $self->watch_write(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;