Perlbal::Plugin::Regex

昨日のPerlbal::Plugin::Regexcontrolを受けて、
いろいろPerlbalとかさわってみましたが、
結論として、selectorは多段で実行できません。

はじめにやりたいと思ってたことが、

selector
 Vhostsプラグインでホストの振り分け
↓
selector
 拡張子によりサーバを振り分け
↓
reverse_proxy

大体こんな感じでできるのかなーーとか思ってたのですが、
無理でした。

Vhostsプラグインで、ホストがマッチした時に実行される、
adopt_base_clientメソッドではroleがweb_serverかreverse_proxyかしか
受け付けてくれないので、多段selectorの夢が破られました。
まあ、もともとの考え方もまずいのかなぁ。

で、仕方ないので次の手。
Perlbal::Plugin::Regexってのを書きました。
Perlbal::Plugin::Regexcontrolと何が違うかというと、
Vhostsプラグインの簡易版プラスRegexによるURLマッチングです。
ソースはこんなの。
Vhostsプラグインほど、ホスト名を面倒はみてません。
FQDNがベストなのかな。ってかFQDNならこんなの考えずにできるチューはなしもありますか。

package Perlbal::Plugin::Regex;

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+)\s*=\s*(\w+)$/,
                              "usage: REGEX [<service>] <host_or_pattern> <regex> = <dest_service>");
        my ($selname, $host, $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";

        $host = lc $host;
        return $mc->err("invalid host pattern: '$host'")
            unless $host =~ /^[\w\-\_\.\*\;\:]+$/;

        $ss->{extra_config}->{_regex} ||= {};
        $ss->{extra_config}->{_regex}{$host}->{regex}  = $target;
        $ss->{extra_config}->{_regex}{$host}->{target} = $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}->{_regex} = {};

    $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 $vhost = $req->header("Host");
    my $uri = $req->request_uri;
    my $maps = $cb->{service}{extra_config}{_regex} ||= {};

    $vhost =~ s/:\d+$//;

    my $regex  = $maps->{$vhost}->{regex}  ||= '';
    my $target = $maps->{$vhost}->{target} ||= '';

    if ($regex && $target) {
        my $svc = Perlbal->service($target) || undef;

        unless ($svc) {
            $cb->_simple_response(404, "Not Found (no configured regex)");
        } else {
            $svc->adopt_base_client($cb);
        }
    }
}

1;

設定方法はこんなの。以下の設定方法は間違ってます＞＜

LOAD vhosts
LOAD regex
CREATE POOL a

CREATE SERVICE ss
  SET ss.listen = 127.0.0.1:$pb_port
  SET ss.role = selector
  SET ss.persist_client = on

  SET ss.plugins = regex
  REGEX ss regex \\.(txt)\$ = ws

  SET ss.plugins = vhosts
  VHOST ss *.regex       = ws
  VHOST ss proxy         = pr
  VHOST ss webserver     = ws
  VHOST ss *.webserver   = ws
  VHOST ss manage        = mgmt
ENABLE ss

CREATE SERVICE pr
  SET pr.role = reverse_proxy
  SET pr.persist_client = 1
  SET pr.persist_backend = 1
  SET pr.pool = a
  SET pr.connect_ahead = 0
ENABLE pr

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

テストスクリプトからの抜粋ですが。
先にRegexプラグインでマッチさせてみて、マッチしたらそっち
マッチしなかったら普通にVhostsプラグインで処理みたいな。
適当に作ったから穴はありそう。

この設定ファイル本当は

LOAD vhosts
LOAD regex

CREATE SERVICE ss
  SET ss.listen = 127.0.0.1:$pb_port
  SET ss.role = selector
  SET ss.persist_client = on

  SET ss.plugins = regex vhosts
  REGEX ss regex \\.(txt)\$ = ws
  VHOST ss *.regex       = ws
  VHOST ss proxy         = pr
  VHOST ss webserver     = ws
  VHOST ss *.webserver   = ws
  VHOST ss manage        = mgmt
ENABLE ss

こんな感じでPluginの部分を一気にかいておけるかなーとおもったら無理でした。
こんな感じでとりあえずうごきそげー。

PerlbalとかMogileFSのコードはなれないとちょっと大変。

本当はこのモジュール名Perlbal::Plugin::VhostsRegex
とかにしたかったのですが、Perlbalちゃんがキャメライズ微妙だったので。
とりあえずやむなし。

（追記）
だめだ、これも失敗作だわさ。
しょぼーん。