######################################################################
# Service class
######################################################################

package Perlbal::Service;
use strict;
use warnings;

use Net::Netmask;

use Perlbal::BackendHTTP;

use fields (
            'name',
            'enabled', # bool
            'role',    # currently 'reverse_proxy' or 'management'
            'listen',  # scalar: "$ip:$port"
            'pool',      # Perlbal::Pool that we're using to allocate nodes if we're in proxy mode
            'docroot',            # document root for webserver role
            'dirindexing',        # bool: direcotry indexing?  (for webserver role)  not async.
            'index_files',        # arrayref of filenames to try for index files
            'listener',
            'waiting_clients',         # arrayref of clients waiting for backendhttp conns
            'waiting_clients_highpri', # arrayref of high-priority clients waiting for backendhttp conns
            'waiting_client_count',    # number of clients waiting for backendds
            'waiting_client_map'  ,    # map of clientproxy fd -> 1 (if they're waiting for a conn)
            'pending_connects',        # hashref of "ip:port" -> $time (only one pending connect to backend at a time)
            'pending_connect_count',   # number of outstanding backend connects
            'high_priority_cookie',          # cookie name to check if client can 'cut in line' and get backends faster
            'high_priority_cookie_contents', # aforementioned cookie value must contain this substring
            'connect_ahead',           # scalar: number of spare backends to connect to in advance all the time
            'backend_persist_cache',   # scalar: max number of persistent backends to hold onto while no clients
            'bored_backends',          # arrayref of backends we've already connected to, but haven't got clients
            'persist_client',  # bool: persistent connections for clients
            'persist_backend', # bool: persistent connections for backends
            'verify_backend',  # bool: get attention of backend before giving it clients (using OPTIONS)
            'max_backend_uses',  # max requests to send per kept-alive backend (default 0 = unlimited)
            'hooks',    # hashref: hookname => [ [ plugin, ref ], [ plugin, ref ], ... ]
            'plugins',  # hashref: name => 1
            'plugin_order', # arrayref: name, name, name...
            'plugin_setters', # hashref: { plugin_name => { key_name => coderef } }
            'extra_config', # hashref: extra config options; name => values
            'enable_put', # bool: whether PUT is supported
            'max_put_size', # int: max size in bytes of a put file
            'min_put_directory', # int: number of directories required to exist at beginning of URIs in put
            'enable_delete', # bool: whether DELETE is supported
            'buffer_size', # int: specifies how much data a ClientProxy object should buffer from a backend
            'buffer_size_reproxy_url', # int: same as above but for backends that are reproxying for us
            'spawn_lock', # bool: if true, we're currently in spawn_backends
            'queue_relief_size', # int; number of outstanding standard priority
                                 # connections to activate pressure relief at
            'queue_relief_chance', # int:0-100; % chance to take a standard priority
                                   # request when we're in pressure relief mode
            'trusted_upstreams', # Net::Netmask object containing netmasks for trusted upstreams
            'always_trusted', # bool; if true, always trust upstreams
            'extra_headers', # { insert => [ [ header, value ], ... ], remove => [ header, header, ... ],
                             #   set => [ [ header, value ], ... ] }; used in header management interface
            'generation', # int; generation count so we can slough off backends from old pools
            'backend_no_spawn', # { "ip:port" => 1 }; if on, spawn_backends will ignore this ip:port combo
            'buffer_backend_connect', # 0 for of, else, number of bytes to buffer before we ask for a backend
            );

sub new {
    my Perlbal::Service $self = shift;
    $self = fields::new($self) unless ref $self;

    my ($name) = @_;

    $self->{name} = $name;
    $self->{enabled} = 0;
    $self->{listen} = "";
    $self->{persist_client} = 0;
    $self->{persist_backend} = 0;
    $self->{verify_backend} = 0;
    $self->{max_backend_uses} = 0;
    $self->{backend_persist_cache} = 2;
    $self->{generation} = 0;
    $self->{backend_no_spawn} = {};
    $self->{buffer_backend_connect} = 0;

    $self->{hooks} = {};
    $self->{plugins} = {};
    $self->{plugin_order} = [];

    $self->{enable_put} = 0;
    $self->{max_put_size} = 0; # 0 means no max size
    $self->{min_put_directory} = 0;
    $self->{enable_delete} = 0;

    # disable pressure relief by default
    $self->{queue_relief_size} = 0;
    $self->{queue_relief_chance} = 0;

    # set some default maximum buffer sizes
    $self->{buffer_size} = 256_000;
    $self->{buffer_size_reproxy_url} = 51_200;

    # track pending connects to backend
    $self->{pending_connects} = {};
    $self->{pending_connect_count} = 0;
    $self->{bored_backends} = [];
    $self->{connect_ahead} = 0;

    # waiting clients
    $self->{waiting_clients} = [];
    $self->{waiting_clients_highpri} = [];
    $self->{waiting_client_count} = 0;

    # directory handling
    $self->{dirindexing} = 0;
    $self->{index_files} = [ 'index.html' ];

    # don't have an object for this yet
    $self->{trusted_upstreams} = undef;
    $self->{always_trusted} = 0;

    # bare data structure for extra header info
    $self->{extra_headers} = { remove => [], insert => [] };

    return $self;
}

# run the hooks in a list one by one until one hook returns 1.  returns
# 1 or 0 depending on if any hooks handled the request.
sub run_hook {
    my Perlbal::Service $self = shift;
    my $hook = shift;
    if (defined (my $ref = $self->{hooks}->{$hook})) {
        # call all the hooks until one returns true
        foreach my $hookref (@$ref) {
            my $rval = $hookref->[1]->(@_);
            return 1 if defined $rval && $rval;
        }
    }
    return 0;
}

# run a bunch of hooks in this service, always returns undef.
sub run_hooks {
    my Perlbal::Service $self = shift;
    my $hook = shift;
    if (defined (my $ref = $self->{hooks}->{$hook})) {
        # call all the hooks
        $_->[1]->(@_) foreach @$ref;
    }
    return undef;
}

# define a hook for this service
sub register_hook {
    my Perlbal::Service $self = shift;
    my ($pclass, $hook, $ref) = @_;
    push @{$self->{hooks}->{$hook} ||= []}, [ $pclass, $ref ];
    return 1;
}

# remove hooks we have defined
sub unregister_hook {
    my Perlbal::Service $self = shift;
    my ($pclass, $hook) = @_;
    if (defined (my $refs = $self->{hooks}->{$hook})) {
        my @new;
        foreach my $ref (@$refs) {
            # fill @new with hooks that DON'T match
            push @new, $ref
                unless $ref->[0] eq $pclass;
        }
        $self->{hooks}->{$hook} = \@new;
        return 1;
    }
    return undef;
}

# remove all hooks of a certain class
sub unregister_hooks {
    my Perlbal::Service $self = shift;
    foreach my $hook (keys %{$self->{hooks}}) {
        # call unregister_hook with this hook name
        $self->unregister_hook($_[0], $hook);        
    }
}

# register a value setter for plugin configuration
sub register_setter {
    my Perlbal::Service $self = shift;
    my ($pclass, $key, $coderef) = @_;
    return unless $pclass && $key && $coderef;
    $self->{plugin_setters}->{lc $pclass}->{lc $key} = $coderef;
}

# remove a setter
sub unregister_setter {
    my Perlbal::Service $self = shift;
    my ($pclass, $key) = @_;
    return unless $pclass && $key;
    delete $self->{plugin_setters}->{lc $pclass}->{lc $key};
}

# remove a bunch of setters
sub unregister_setters {
    my Perlbal::Service $self = shift;
    my $pclass = shift;
    return unless $pclass;
    delete $self->{plugin_setters}->{lc $pclass};    
}

# take a backend we've created and mark it as pending if we do not
# have another pending backend connection in this slot
sub add_pending_connect {
    my Perlbal::Service $self = shift;
    my Perlbal::BackendHTTP $be = shift;

    # error if we already have a pending connection for this ipport
    if (defined $self->{pending_connects}{$be->{ipport}}) {
        Perlbal::log('warning', "Warning: attempting to spawn backend connection that already existed.");

        # now dump a backtrace so we know how we got here
        my $depth = 0;
        while (my ($package, $filename, $line, $subroutine) = caller($depth++)) {
            Perlbal::log('warning', "          -- [$filename:$line] $package::$subroutine");
        }

        # we're done now, just return
        return;
    }

    # set this connection up in the pending connection list
    $self->{pending_connects}{$be->{ipport}} = $be;
    $self->{pending_connect_count}++;
}

# remove a backend connection from the pending connect list if and only
# if it is the actual connection contained in the list; prevent double
# decrementing on accident
sub clear_pending_connect {
    my Perlbal::Service $self = shift;
    my Perlbal::BackendHTTP $be = shift;
    if (defined $self->{pending_connects}{$be->{ipport}} && defined $be &&
            $self->{pending_connects}{$be->{ipport}} == $be) {
        $self->{pending_connects}{$be->{ipport}} = undef;
        $self->{pending_connect_count}--;
    }
}

# called by BackendHTTP when it's closed by any means
sub note_backend_close {
    my Perlbal::Service $self = shift;
    my Perlbal::BackendHTTP $be = shift;
    $self->clear_pending_connect($be);
    $self->spawn_backends;
}

# called by ClientProxy when it dies.
sub note_client_close {
    my Perlbal::Service $self;
    my Perlbal::ClientProxy $cp;
    ($self, $cp) = @_;

    if (delete $self->{waiting_client_map}{$cp->{fd}}) {
        $self->{waiting_client_count}--;
    }
}

sub mark_node_used {
    my Perlbal::Service $self = $_[0];
    $self->{pool}->mark_node_used($_[1]) if $self->{pool};
}

sub get_client {
    my Perlbal::Service $self = shift;

    my $ret = sub {
        my Perlbal::ClientProxy $cp = shift;
        $self->{waiting_client_count}--;
        delete $self->{waiting_client_map}{$cp->{fd}};

        # before we return, start another round of connections
        $self->spawn_backends;

        return $cp;
    };

    # determine if we should jump straight to the high priority queue or
    # act as pressure relief on the standard queue
    my $hp_first = 1;
    if (($self->{queue_relief_size} > 0) &&
            (scalar(@{$self->{waiting_clients}}) >= $self->{queue_relief_size})) {
        # if we're below the chance level, take a standard queue item
        $hp_first = 0
            if rand(100) < $self->{queue_relief_chance};
    }

    # find a high-priority client, or a regular one
    my Perlbal::ClientProxy $cp;
    while ($hp_first && ($cp = shift @{$self->{waiting_clients_highpri}})) {
        if (Perlbal::DEBUG >= 2) {
            my $backlog = scalar @{$self->{waiting_clients}};
            print "Got from fast queue, in front of $backlog others\n";
        }
        return $ret->($cp) if ! $cp->{closed};
    }
    while ($cp = shift @{$self->{waiting_clients}}) {
        if (Perlbal::DEBUG >= 2) {
            print "Backend requesting client, got normal = $cp->{fd}.\n" unless $cp->{closed};
        }
        return $ret->($cp) if ! $cp->{closed};
    }

    return undef;
}

# given a backend, verify it's generation
sub verify_generation {
    my Perlbal::Service $self = $_[0];
    my Perlbal::BackendHTTP $be = $_[1];

    # fast cases: generation count matches, so we just return an 'okay!' flag
    return 1 if $self->{generation} == $be->generation;

    # if our current pool knows about this ip:port, then we can still use it
    if (defined $self->{pool}->node_used($be->ipport)) {
        # so we know this is good, in the future we just want to hit the fast case
        # and continue, so let's update the generation
        $be->generation($self->{generation});
        return 1;
    }

    # if we get here, the backend should be closed
    $be->close('invalid_generation');
    return 0;
}

# called by backend connection after it becomes writable
sub register_boredom {
    my Perlbal::Service $self;
    my Perlbal::BackendHTTP $be;
    ($self, $be) = @_;

    # note that this backend is no longer pending a connect,
    # if we thought it was before.  but not if it's a persistent
    # connection asking to be re-used.
    unless ($be->{use_count}) {
        $self->clear_pending_connect($be);
    }

    # it is possible that this backend is part of a different pool that we're
    # no longer using... if that's the case, we want to close it
    return unless $self->verify_generation($be);

    # now try to fetch a client for it
    my Perlbal::ClientProxy $cp = $self->get_client;
    if ($cp) {
        if ($be->assign_client($cp)) {
            return;
        } else {
            # don't want to lose client, so we (unfortunately)
            # stick it at the end of the waiting queue.
            # fortunately, assign_client shouldn't ever fail.
            $self->request_backend_connection($cp);
        }
    }

    # don't hang onto more bored, persistent connections than
    # has been configured for connect-ahead
    if ($be->{use_count}) {
        my $current_bored = scalar @{$self->{bored_backends}};
        if ($current_bored >= $self->{backend_persist_cache}) {
            $be->close('too_many_bored');
            return;
        }
    }

    # put backends which are known to be bound to processes
    # and not to TCP stacks at the beginning where they'll
    # be used first
    if ($be->{has_attention}) {
        unshift @{$self->{bored_backends}}, $be;
    } else {
        push @{$self->{bored_backends}}, $be;
    }
}

sub note_bad_backend_connect {
    my Perlbal::Service $self = shift;
    my Perlbal::BackendHTTP $be = shift;
    my $retry_time = shift();

    # clear this pending connection
    $self->clear_pending_connect($be);

    # mark this host as dead for a while if we need to
    if (defined $retry_time && $retry_time > 0) {
        # we don't want other spawn_backends calls to retry
        $self->{backend_no_spawn}->{$be->{ipport}} = 1;

        # and now we set a callback to ensure we're kicked at the right time
        Perlbal::Socket::register_callback($retry_time, sub {
            delete $self->{backend_no_spawn}->{$be->{ipport}};
            $self->spawn_backends;
        });
    }

    # FIXME: do something interesting (tell load balancer about dead host,
    # and fire up a new connection, if warranted)

    # makes a new connection, if needed
    $self->spawn_backends;
}

sub request_backend_connection {
    my Perlbal::Service $self;
    my Perlbal::ClientProxy $cp;
    ($self, $cp) = @_;

    my $hi_pri = 0;  # by default, low priority

    # is there a defined high-priority cookie?
    if (my $cname = $self->{high_priority_cookie}) {
        # decide what priority class this request is in
        my $hd = $cp->{req_headers};
        my %cookie;
        foreach (split(/;\s+/, $hd->header("Cookie") || '')) {
            next unless ($_ =~ /(.*)=(.*)/);
            $cookie{_durl($1)} = _durl($2);
        }
        my $hicookie = $cookie{$cname} || "";
        $hi_pri = index($hicookie, $self->{high_priority_cookie_contents}) != -1;
    }
    
    # now, call hook to see if this should be high priority
    $hi_pri = $self->run_hook('make_high_priority', $cp)
        unless $hi_pri; # only if it's not already
    $cp->{high_priority} = 1 if $hi_pri;

    # before we even consider spawning backends, let's see if we have
    # some bored (pre-connected) backends that'd take this client
    my Perlbal::BackendHTTP $be;
    my $now = time;
    while ($be = shift @{$self->{bored_backends}}) {
        next if $be->{closed};

        # now make sure that it's still in our pool, and if not, close it
        next unless $self->verify_generation($be);

        # don't use connect-ahead connections when we haven't
        # verified we have their attention
        if (! $be->{has_attention} && $be->{create_time} < $now - 5) {
            $be->close("too_old_bored");
            next;
        }

        # don't use keep-alive connections if we know the server's
        # just about to kill the connection for being idle
        if ($be->{disconnect_at} && $now + 2 > $be->{disconnect_at}) {
            $be->close("too_close_disconnect");
            next;
        }

        # give the backend this client
        if ($be->assign_client($cp)) {
            # and make some extra bored backends, if configured as such
            $self->spawn_backends;
            return;
        }
    }

    if ($hi_pri) {
        push @{$self->{waiting_clients_highpri}}, $cp;
    } else {
        push @{$self->{waiting_clients}}, $cp;
    }

    $self->{waiting_client_count}++;
    $self->{waiting_client_map}{$cp->{fd}} = 1;

    $self->spawn_backends;
}

# sees if it should spawn one or more backend connections
sub spawn_backends {
    my Perlbal::Service $self = shift;

    # to spawn we must have a pool
    return unless $self->{pool};

    # check our lock and set it if we can
    return if $self->{spawn_lock};
    $self->{spawn_lock} = 1;

    # sanity checks on our bookkeeping
    if ($self->{pending_connect_count} < 0) {
        Perlbal::log('crit', "Bogus: service $self->{name} has pending connect ".
                     "count of $self->{pending_connect_count}?!  Resetting.");
        $self->{pending_connect_count} = scalar
            map { $_ && ! $_->{closed} } values %{$self->{pending_connects}};
    }

    # keep track of the sum of existing_bored + bored_created
    my $backends_created = scalar(@{$self->{bored_backends}}) + $self->{pending_connect_count};
    my $backends_needed = $self->{waiting_client_count} + $self->{connect_ahead};
    my $to_create = $backends_needed - $backends_created;

    # can't create more than this, assuming one pending connect per node
    my $max_creatable = $self->{pool}->node_count - $self->{pending_connect_count};
    $to_create = $max_creatable if $to_create > $max_creatable;

    # cap number of attempted connects at once
    $to_create = 10 if $to_create > 10;

    my $now = time;

    while ($to_create > 0) {
        $to_create--;
        my ($ip, $port) = $self->{pool}->get_backend_endpoint;
        unless ($ip) {
            Perlbal::log('crit', "No backend IP for service $self->{name}");
            # FIXME: register desperate flag, so load-balancer module can callback when it has a node
            $self->{spawn_lock} = 0;
            return;
        }

        # handle retry timeouts so we don't spin
        next if $self->{backend_no_spawn}->{"$ip:$port"};

        # if it's pending, verify the pending one is still valid
        if (my Perlbal::BackendHTTP $be = $self->{pending_connects}{"$ip:$port"}) {
            my $age = $now - $be->{create_time};
            if ($age >= 5 && $be->{state} eq "connecting") {
                $be->close('connect_timeout');
            } elsif ($age >= 60 && $be->{state} eq "verifying_backend") {
                # after 60 seconds of attempting to verify, we're probably already dead
                $be->close('verify_timeout');
            } elsif (! $be->{closed}) {
                next;
            }
        }

        # now actually spawn a backend and add it to our pending list
        if (my $be = Perlbal::BackendHTTP->new($self, $ip, $port, { pool => $self->{pool},
                                                                    generation => $self->{generation} })) {
            $self->add_pending_connect($be);
        }
    }

    # clear our spawn lock
    $self->{spawn_lock} = 0;
}

# getter only
sub role {
    my Perlbal::Service $self = shift;
    return $self->{role};
}

# manage some header stuff
sub header_management {
    my Perlbal::Service $self = shift;

    my ($mode, $key, $val, $out) = @_;
    my $err = sub { $out->("ERROR: $_[0]"); return 0; };

    return $err->("no header provided") unless $key;
    return $err->("no value provided") unless $val || $mode eq 'remove';

    if ($mode eq 'insert') {
        push @{$self->{extra_headers}->{insert}}, [ $key, $val ];
    } elsif ($mode eq 'remove') {
        push @{$self->{extra_headers}->{remove}}, $key;
    } else {
        return $err->("invalid mode '$mode'");
    }
    return 1;
}

sub munge_headers {
    my Perlbal::Service $self = $_[0];
    my Perlbal::HTTPHeaders $hdrs = $_[1];

    # handle removals first
    foreach my $hdr (@{$self->{extra_headers}->{remove}}) {
        $hdrs->header($hdr, undef);
    }

    # and now insertions
    foreach my $hdr (@{$self->{extra_headers}->{insert}}) {
        $hdrs->header($hdr->[0], $hdr->[1]);
    }
}

# Service
sub set {
    my Perlbal::Service $self = shift;

    my ($key, $val, $out, $verbose) = @_;
    my $err = sub { $out->("ERROR: $_[0]");   return 0;       };
    my $ok  = sub { $out->("OK") if $verbose; return 1;       };
    my $set = sub { $self->{$key} = $val;     return $ok->(); };

    my $pool_set = sub {
        # if we don't have a pool, automatically create one named $NAME_pool
        unless ($self->{pool}) {
            # die if necessary
            die "ERROR: Attempt to vivify pool $self->{name}_pool but one or more pools\n" .
                "       have already been created manually.  Please set $key on a\n" .
                "       previously created pool.\n" unless $Perlbal::vivify_pools;

            # create the pool and ensure that vivify stays on
            Perlbal::run_manage_command("CREATE POOL $self->{name}_pool", $out);
            Perlbal::run_manage_command("SET $self->{name}.pool = $self->{name}_pool");
            $Perlbal::vivify_pools = 1;
        }

        # now we actually do the set
        warn "WARNING: '$key' set on service $self->{name} on auto-vivified pool.\n" .
             "         This behavior is obsolete.  This value should be set on a\n" .
             "         pool object and not on a service.\n" if $Perlbal::vivify_pools;
        return $err->("No pool defined for service") unless $self->{pool};
        return $self->{pool}->set($key, $val, $out, $verbose);
    };

    if ($key eq "role") {
        return $err->("Unknown service role")
            unless $val eq "reverse_proxy" || $val eq "management" || $val eq "web_server";
        return $set->();
    }

    if ($key eq "listen") {
        return $err->("Invalid host:port")
            unless $val =~ m!^\d+\.\d+\.\d+\.\d+:\d+$!;

        # close/reopen listening socket
        if ($val ne $self->{listen} && $self->{enabled}) {
            $self->disable(undef, "force");
            $self->{listen} = $val;
            $self->enable(undef);
        }

        return $set->();
    }

    my $bool = sub {
        my $val = shift;
        return 1 if $val =~ /^1|true|on|yes$/i;
        return 0 if $val =~ /^0|false|off|no$/i;
        return undef;
    };

    if ($key eq 'trusted_upstream_proxies') {
        if ($self->{trusted_upstreams} = Net::Netmask->new2($val)) {
            # set, all good
            return $ok->();
        } else {
            return $err->("Error defining trusted upstream proxies: " . Net::Netmask::errstr());
        }
    }

    if ($key eq 'always_trusted') {
        $val = $bool->($val);
        return $err->("Expecting boolean value for option '$key'")
            unless defined $val;
        return $set->();
    }

    if ($key eq 'enable_put' || $key eq 'enable_delete') {
        return $err->("This can only be used on web_server service")
            unless $self->{role} eq 'web_server';
        $val = $bool->($val);
        return $err->("Expecting boolean value for option '$key'.")
            unless defined $val;
        return $set->();
    }

    if ($key eq "persist_client" || $key eq "persist_backend" ||
        $key eq "verify_backend") {
        $val = $bool->($val);
        return $err->("Expecting boolean value for option '$key'")
            unless defined $val;
        return $set->();
    }

    # this is now handled by Perlbal::Pool, so we pass this set command on
    # through in case people try to use it on us like the old method.
    return $pool_set->()
        if $key eq 'balance_method' ||
           $key eq 'nodefile' ||
           $key =~ /^sendstats\./;
    if ($key eq "balance_method") {
        return $err->("Can only set balance method on a reverse_proxy service")
            unless $self->{role} eq "reverse_proxy";
    }

    if ($key eq "high_priority_cookie" || $key eq "high_priority_cookie_contents") {
        return $set->();
    }

    if ($key eq "connect_ahead") {
        return $err->("Expected integer value") unless $val =~ /^\d+$/;
        $set->();
        $self->spawn_backends if $self->{enabled};
        return $ok->();
    }

    if ($key eq "max_backend_uses" || $key eq "backend_persist_cache" ||
        $key eq "max_put_size" || $key eq "min_put_directory" ||
        $key eq "buffer_size" || $key eq "buffer_size_reproxy_url" ||
        $key eq "queue_relief_size" || $key eq "buffer_backend_connect") {
        return $err->("Expected integer value") unless $val =~ /^\d+$/;
        return $set->();
    }

    if ($key eq "queue_relief_chance") {
        return $err->("Expected integer value") unless $val =~ /^\d+$/;
        return $err->("Expected integer value between 0 and 100 inclusive")
            unless $val >= 0 && $val <= 100;
        return $set->();
    }

    if ($key eq "docroot") {
        return $err->("Can only set docroot on a web_server service")
            unless $self->{role} eq "web_server";
        $val =~ s!/$!!;
        return $err->("Directory not found")
            unless $val && -d $val;
        return $set->();
    }

    if ($key eq "dirindexing") {
        return $err->("Can only set dirindexing on a web_server service")
            unless $self->{role} eq "web_server";
        return $err->("Expected value 0 or 1")
            unless $val eq '0' || $val eq '1';
        return $set->();
    }

    if ($key eq "index_files") {
        return $err->("Can only set index_files on a web_server service")
            unless $self->{role} eq "web_server";
        my @list = split(/[\s,]+/, $val);
        $self->{index_files} = \@list;
        return $ok->();
    }

    if ($key eq 'plugins') {
        # unload existing plugins
        foreach my $plugin (keys %{$self->{plugins}}) {
            eval "Perlbal::Plugin::$plugin->unregister(\$self);";
            return $err->($@) if $@;
        }
        
        # clear out loaded plugins and hooks
        $self->{hooks} = {};
        $self->{plugins} = {};
        $self->{plugin_order} = [];
        
        # load some plugins
        foreach my $plugin (split /[\s,]+/, $val) {
            next if $plugin eq 'none';

            # since we lowercase our input, uppercase the first character here
            my $fn = uc($1) . lc($2) if $plugin =~ /^(.)(.*)$/;
            next if $self->{plugins}->{$fn};
            unless ($Perlbal::plugins{$fn}) {
                $err->("Plugin $fn not loaded; not registered for $self->{name}.");
                next;
            }

            # now register it
            eval "Perlbal::Plugin::$fn->register(\$self);";
            $self->{plugins}->{$fn} = 1;
            push @{$self->{plugin_order}}, $fn;
            return $err->($@) if $@;
        }
        return $ok->();
    }

    if ($key =~ /^extra\.(.+)$/) {
        # set some extra configuration data data
        $self->{extra_config}->{$1} = $val;
        return $ok->();
    }

    if ($key eq 'pool') {
        my $pl = Perlbal->pool($val);
        return $err->("Pool '$val' not found") unless $pl;
        $self->{pool}->decrement_use_count if $self->{pool};
        $self->{pool} = $pl;
        $self->{pool}->increment_use_count;
        $self->{generation}++;
        return $ok->();
    }

    # see if it happens to be a plugin set command?
    if ($key =~ /^(.+)\.(.+)$/) {
        if (my $coderef = $self->{plugin_setters}->{$1}->{$2}) {
            return $coderef->($out, $2, $val);
        }
    }

    return $err->("Unknown attribute '$key'");
}

# Service
sub enable {
    my Perlbal::Service $self;
    my $out;
    ($self, $out) = @_;

    if ($self->{enabled}) {
        $out && $out->("ERROR: service $self->{name} is already enabled");
        return 0;
    }

    # create listening socket
    my $tl = Perlbal::TCPListener->new($self->{listen}, $self);
    unless ($tl) {
        $out && $out->("ERROR: Can't start service '$self->{name}' on $self->{listen}: $Perlbal::last_error");
        return 0;
    }

    $self->{listener} = $tl;
    $self->{enabled} = 1;
    return 1;
}

# Service
sub disable {
    my Perlbal::Service $self;
    my ($out, $force);

    ($self, $out, $force) = @_;

    if (! $self->{enabled}) {
        $out && $out->("ERROR: service $self->{name} is already disabled");
        return 0;
    }
    if ($self->{role} eq "management" && ! $force) {
        $out && $out->("ERROR: can't disable management service");
        return 0;
    }

    # find listening socket
    my $tl = $self->{listener};
    $tl->close;
    $self->{listener} = undef;
    $self->{enabled} = 0;
    return 1;
}

sub stats_info
{
    my Perlbal::Service $self = shift;
    my $out = shift;
    my $now = time;

    $out->("SERVICE $self->{name}");
    $out->("     listening: $self->{listen}");
    $out->("          role: $self->{role}");
    if ($self->{role} eq "reverse_proxy" ||
        $self->{role} eq "web_server") {
        $out->("  pend clients: $self->{waiting_client_count}");
        $out->("  pend backend: $self->{pending_connect_count}");
        foreach my $ipport (sort keys %{$self->{pending_connects}}) {
            my $be = $self->{pending_connects}{$ipport};
            next unless $be;
            my $age = $now - $be->{create_time};
            $out->("   $ipport - " . ($be->{closed} ? "(closed)" : $be->{state}) . " - ${age}s");
        }
    }
    if ($self->{role} eq "reverse_proxy") {
        my $bored_count = scalar @{$self->{bored_backends}};
        $out->(" connect-ahead: $bored_count/$self->{connect_ahead}");
        if ($self->{pool}) {
            $out->("          pool: " . $self->{pool}->name);
            $out->("balance method: " . $self->{pool}->balance_method);
            $out->("         nodes:");
            foreach my $n (@{ $self->{pool}->nodes }) {
                my $hostport = "$n->[0]:$n->[1]";
                $out->(sprintf("                %-21s %7d", $hostport, $self->{pool}->node_used($hostport) || 0));
            }
        }
    } elsif ($self->{role} eq "web_server") {
        $out->("        docroot: $self->{docroot}");
    }
}

# simple passthroughs to the run_hook mechanism.  part of the reportto interface.
sub backend_response_received {
    return $_[0]->run_hook('backend_response_received', $_[1]);
}

sub _durl
{
    my ($a) = @_;
    $a =~ tr/+/ /;
    $a =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    return $a;
}


1;


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