-- added the ability for plugins to create custom service roles and

       add custom configuration options to services, demo is available
       as conf/echoservice.conf and lib/Perlbal/Plugin/EchoService.pm

This is by request for the cometd project.  I'm sure someone else will find
it useful too.




git-svn-id: http://code.sixapart.com/svn/perlbal/trunk@481 6caf28e9-730f-0410-b62b-a31386fe13fb

CHANGES

@@ -1,3 +1,7 @@
+	-- added the ability for plugins to create custom service roles and
+	   add custom configuration options to services, demo is available
+	   as conf/echoservice.conf and lib/Perlbal/Plugin/EchoService.pm
+
 1.42: 2006-08-03
 
     -- debug management command 'varsize' to track size of internal

MANIFEST

@@ -27,6 +27,7 @@ lib/Perlbal/Plugin/Queues.pm
 lib/Perlbal/Plugin/Stats.pm
 lib/Perlbal/Plugin/Highpri.pm
 lib/Perlbal/Plugin/Vhosts.pm
+lib/Perlbal/Plugin/EchoService.pm
 lib/Perlbal/ReproxyManager.pm
 META.yml                                 Module meta-data (added by MakeMaker)
 devtools/gendocs.pl
@@ -41,6 +42,7 @@ conf/webserver.conf
 conf/load-balancer.conf
 conf/virtual-hosts.conf
 conf/ssl.conf
+conf/echoservice.conf
 t/00-use.t
 t/10-testharness.t
 t/12-headers.t

conf/echoservice.conf

@@ -0,0 +1,25 @@
+#
+# This is an example configuration using the EchoService plugin.
+#
+# See doc/config-guide.txt for descriptions of each command (line)
+# and configuration syntax.
+#
+
+LOAD EchoService
+
+CREATE SERVICE echo
+  SET listen        = 0.0.0.0:7123
+  SET role          = echo
+ENABLE echo
+
+CREATE SERVICE echo_delayed
+  SET listen        = 0.0.0.0:7124
+  SET role          = echo
+  SET echo_delay    = 3
+ENABLE echo_delayed
+
+# always good to keep an internal management port open:
+CREATE SERVICE mgmt
+  SET role   = management
+  SET listen = 127.0.0.1:60000
+ENABLE mgmt

lib/Perlbal/Plugin/EchoService.pm

@@ -0,0 +1,124 @@
+###########################################################################
+# simple plugin demonstrating how to create an add-on service for Perlbal
+# using the plugin infrastructure
+###########################################################################
+
+package Perlbal::Plugin::EchoService;
+
+use strict;
+use warnings;
+
+# we don't do anything in here
+sub load {
+
+    # define the echo service, which instantiates this type of object
+    Perlbal::Service::add_role(
+            echo => \&Perlbal::Plugin::EchoService::Client::new,
+        );
+
+    # add up custom configuration options that people are allowed to set on the echo_service
+    Perlbal::Service::add_tunable(
+            # allow the following:
+            #    SET myservice.echo_delay = 5
+            # defines how long to wait between getting text and echoing it back
+            echo_delay => {
+                des => "Time in seconds to pause before sending text back using the echo service.",
+                default => 0, # no delay
+                check_role => "echo",
+                check_type => "int",
+            }
+        );
+
+    return 1;
+}
+
+# remove the various things we've hooked into, this is required as a way of
+# being good to the system...
+sub unload {
+    Perlbal::Service::remove_tunable('echo_delay');
+    Perlbal::Service::remove_role('echo');
+    return 1;
+}
+
+
+###########################################################################
+# this is the implementation of the client that gets instantiated by the
+# service.  (which is really all a service does - instantiate the right
+# type of client, and store some information)
+###########################################################################
+
+package Perlbal::Plugin::EchoService::Client;
+use strict;
+use warnings;
+
+use base "Perlbal::Socket";
+use fields ('service', # the service we're from
+            'buf');    # the buffer of what we're reading
+
+# create a new object of this class
+sub new {
+    my $class = "Perlbal::Plugin::EchoService::Client";
+    my ($service, $sock) = @_;
+
+    my $self = $class->SUPER::new($sock);
+    $self->{service} = $service;
+    $self->{buf} = "";   # what we've read so far, not forming a complete line
+
+    bless $self, ref $class || $class;
+    $self->watch_read(1);
+    return $self;
+}
+
+# called when we are readable - i.e. there is data available
+sub event_read {
+    my Perlbal::Plugin::EchoService::Client $self = shift;
+
+    # try to read in 1k of data, remember to close if you get undef, as that means
+    # something went wrong, or the socket was closed
+    my $bref = $self->read(1024);
+    return $self->close() unless defined $bref;
+    $self->{buf} .= $$bref;
+
+    # now, parse out any lines that we have gotten.  this just removes data line by
+    # line so we can handle it.
+    while ($self->{buf} =~ s/^(.+?)\r?\n//) {
+        my $line = $1;
+
+        # package up a sub to do what we want.  this is in a coderef because we either
+        # need to call it now or schedule it for later.  saves some duplication.
+        my $do_echo = sub { $self->write("$line\r\n"); };
+
+        # if they want a delay, we have to schedule this for later
+        if (my $delay = $self->{service}->{extra_config}->{echo_delay}) {
+            # schedule
+            Danga::Socket->AddTimer($delay, $do_echo);
+
+        } else {
+            # immediately, so run it
+            $do_echo->();
+
+        }
+    }
+}
+
+# called when we are writeable - that is, we are allowed to write data now.  try to
+# flush any existing data and then if we have nothing in the write buffer left,
+# go ahead and stop notifying us about writeability.
+sub event_write {
+    my Perlbal::Plugin::EchoService::Client $self = shift;
+    $self->watch_write(0) if $self->write(undef);
+}
+
+# if we run into some socket error, just close
+sub event_err {
+    my Perlbal::Plugin::EchoService::Client $self = shift;
+    $self->close;
+}
+
+# same thing if we get a hup
+sub event_hup {
+    my Perlbal::Plugin::EchoService::Client $self = shift;
+    $self->close;
+}
+
+1;

lib/Perlbal/Service.pm

@@ -88,14 +88,23 @@ use fields (
             'latency',               # int: milliseconds of latency to add to request
             );
 
+# hash; 'role' => coderef to instantiate a client for this role
+our %PluginRoles;
 
 our $tunables = {
 
     'role' => {
         des => "What type of service.  One of 'reverse_proxy' for a service that load balances to a pool of backend webserver nodes, 'web_server' for a typical webserver', 'management' for a Perlbal management interface (speaks both command-line or HTTP, auto-detected), or 'selector', for a virtual service that maps onto other services.",
         required => 1,
 
-        check_type => ["enum", ["reverse_proxy", "web_server", "management", "selector", "upload_tracker"]],
+        check_type => sub {
+            my ($self, $val, $errref) = @_;
+            return 0 unless $val;
+            return 1 if $val =~ /^(?:reverse_proxy|web_server|management|selector|upload_tracker)$/;
+            return 1 if $PluginRoles{$val};
+            $$errref = "Role not valid for service $self->{name}";
+            return 0;
+        },
         check_role => '*',
         setter => sub {
             my ($self, $val, $set, $mc) = @_;
@@ -461,6 +470,7 @@ sub new {
 
     $self->{name} = $name;
     $self->{enabled} = 0;
+    $self->{extra_config} = {};
 
     $self->{backend_no_spawn} = {};
     $self->{generation} = 0;
@@ -604,6 +614,11 @@ sub set {
 
         if (ref $setter eq "CODE") {
             return $setter->($self, $val, $set, $mc);
+        } elsif ($tun->{_plugin_inserted}) {
+            # plugins that add tunables need to be stored in the extra_config hash due to the main object
+            # using fields.  this passthrough is done so the config files don't need to specify this.
+            $self->{extra_config}->{$key} = $val;
+            return $mc->ok;
         } else {
             return $set->();
         }
@@ -658,6 +673,51 @@ sub set {
     return $mc->err("Unknown service parameter '$key'");
 }
 
+# CLASS METHOD -
+# used by plugins that want to add tunables so that the config file
+# can have more options for service settings
+sub add_tunable {
+    my ($name, $hashref) = @_;
+    return 0 unless $name && $hashref && ref $hashref eq 'HASH';
+    return 0 if $tunables->{$name};
+    $hashref->{_plugin_inserted} = 1; # mark that a plugin did this
+    $tunables->{$name} = $hashref;
+    return 1;
+}
+
+# CLASS METHOD -
+# remove a defined tunable, but only if a plugin is what created it
+sub remove_tunable {
+    my $name = shift;
+    my $tun = $tunables->{$name} or return 0;
+    return 0 unless $tun->{_plugin_inserted};
+    delete $tunables->{$name};
+    return 1;
+}
+
+# CLASS METHOD -
+# used by plugins to define a new role that services can take on
+sub add_role {
+    my ($role, $creator) = @_;
+    return 0 unless $role && $creator && ref $creator eq 'CODE';
+    return 0 if $PluginRoles{$role};
+    $PluginRoles{$role} = $creator;
+    return 1;
+}
+
+# CLASS METHOD -
+# remove a defined plugin role
+sub remove_role {
+    return 0 unless delete $PluginRoles{$_[0]};
+    return 1;
+}
+
+# CLASS METHOD -
+# returns a defined role creator, if it exists.  (undef if it does not)
+sub get_role_creator {
+    return $PluginRoles{$_[0]};
+}
+
 # run the hooks in a list one by one until one hook returns a true
 # value.  returns 1 or 0 depending on if any hooks handled the
 # request.

lib/Perlbal/TCPListener.pm

@@ -78,6 +78,9 @@ sub event_read {
         } elsif ($service_role eq "selector") {
             # will be cast to a more specific class later...
             Perlbal::ClientHTTPBase->new($self->{service}, $psock, $self->{service});
+        } elsif (my $creator = Perlbal::Service::get_role_creator($service_role)) {
+            # was defined by a plugin, so we want to return one of these
+            $creator->($self->{service}, $psock);
         }
 
     }