Perlbal::Plugin::Regexcontrol

ロードバランサーにPoundを使う場合、
画像はこっちのサーバつかってね、
アプリはこっちのサーバつかってねって結構簡単にかけます。
こんな感じ。

UrlGroup "[^=]\.(jpg|gif|png|js|css|swf)$"
HeadRequire Host "example.jp.*"
BackEnd 192.168.200.1,80,1
BackEnd 192.168.200.2,80,1
EndGroup 

こんな感じで特定の拡張子のアクセスの場合は
別のサーバに振り分けするとかできるのですが、
Perlbalの場合、デフォルトの機能でできませぬ。
と、悩んでいる時にmiyagawaさんからプラグインかけばできると
教えてもらったので書いてみた。
激しく微妙な感じですが。とりあえずうごいてるぽい。

package Perlbal::Plugin::Regexcontrol;

use strict;
use warnings;
no  warnings qw(deprecated);

our %Services;  # service_name => $svc

# when "LOAD" directive loads us up
sub load {
    my $class = shift;

    Perlbal::register_global_hook('manage_command.regex', sub {
        my $mc = shift->parse(qr/^regex\s+(?:(\w+)\s+)?(\S+)\s*=\s*(\w+)$/,
                              "usage: REGEX [<regex>] <regex> = <dest_service>");
        my ($selname, $regex, $target) = $mc->args;
        unless ($selname ||= $mc->{ctx}{last_created}) {
            return $mc->err("omitted service name not implied from context");
        }

        my $ss = Perlbal->service($selname);
        return $mc->err("Service '$selname' is not a selector service")
            unless $ss && $ss->{role} eq "selector";

        $ss->{extra_config}->{_regexs} ||= {};
        $ss->{extra_config}->{_regexs}{$regex} = $target;

        return $mc->ok;
    });
    return 1;
}

# unload our global commands, clear our service object
sub unload {
    my $class = shift;

    Perlbal::unregister_global_hook('manage_command.regex');
    unregister($class, $_) foreach (values %Services);
    return 1;
}

# called when we're being added to a service
sub register {
    my ($class, $svc) = @_;
    unless ($svc && $svc->{role} eq "selector") {
        die "You can't load the regex plugin on a service not of role selector.\n";
    }

    $svc->selector(\&regex_selector);
    $svc->{extra_config}->{_regexs} = {};

    $Services{"$svc"} = $svc;
    return 1;
}

# called when we're no longer active on a service
sub unregister {
    my ($class, $svc) = @_;
    $svc->selector(undef);
    delete $Services{"$svc"};
    return 1;
}

# call back from Service via ClientHTTPBase's event_read calling service->select_new_service(Perlbal::ClientHTTPBase)
sub regex_selector {
    my Perlbal::ClientHTTPBase $cb = shift;

    my $req = $cb->{req_headers};
    return $cb->_simple_response(404, "Not Found (no reqheaders)") unless $req;

    my $uri = $req->request_uri;
    my $maps = $cb->{service}{extra_config}{_regexs} ||= {};

    my ($regex, $val) = each %{$maps};

    my $svc = Perlbal->service($val);

    if ($regex eq '*') {
        $svc->adopt_base_client($cb);
        return 1;
    }
    if ( $uri =~ /$regex/ ) {
        $svc->adopt_base_client($cb);
        return 1;
    } else {
        return 0;
    }
}

1;

ただ、Vhostsプラグインと同時に使えるか分からない。ってか現状使えない。
selectorを多段でかませれば問題ないと思うんだけど、どうも動かない。
もし無理ならVhostsプラグインにパッチあてるしかないかもー。＞＜

（追記）
ちょっとした設定例

CREATE SERVICE reg
  SET reg.role = selector
  SET reg.plugins = regexcontrol
  SET reg.persist_client = on

  REGEX reg \\.(txt)\$ = ws
ENABLE reg
CREATE SERVICE ws
  SET ws.role = web_server
  SET ws.docroot = $dir
  SET ws.dirindexing = 0
  SET ws.persist_client = 1
  SET ws.enable_put = 1
  SET ws.enable_delete = 1
ENABLE ws