Posts categorized "Perl" Feed

Mar 06, 2013

Plack::Middleware::DefaultDocument というのを作った。

MogileFS のクライアントとしてだけ動く小さな PSGI アプリかいていて、MogileFS になかったらアプリがもってるデフォルトのファイルを 404 ではなく 200 で返したい、ということをやりたかったんだけど、これを実現する方法として、

  • app 側で対応する
    • 汎用的にしたかったのでなし
  • 手前にいる reverse proxy(apache2.2)にやらせる
    • プロキシした結果 404 だったら別の何かを 200 で返す、という方法がわからなかった
    • あったとしても mod_rewrite での対応となると今回はきつい
      • このアプリにプロキシされるまでにすでにカオス RewriteRule をくぐり抜けてきているので...
  • さらに手前にいる varnish / perlbal にやらせる
    • varnish がバックエンドから 404 うけとったら req.url 書き換えて restart、varnish の後ろにいる perlbal の web server につかませる
    • キャッシュがあればバックエンドひと通り巡るコストもなく速いが関係者が増えるのでなんかいや
  • Middleware::ErrorDocument で subrequest なげて Middleware::Static につかませる
    • 404 は普通につかいたいので、それとは別に enable_if { $_[0]->{PATH_INFO} =~ m{/favicon.ico} } ErrorDocument 〜 とかしてわけて、Static で path => sub { s/// } で PATH_INFO 書き換えて特定ディレクトリからさがす
    • 別にこれでよかった(え)

など堂々めぐりした結果、簡単にできるやつをということで作った。

使い方はこんなん感じ。

enable "DefaultDocument",
    '/favicon\.ico$' => '/path/to/htodcs/favicon.ico',
    '/robots\.txt'   => '/path/to/htdocs/robots.txt';

app からのレスポンスコードが 404 だった場合に、PATH_INFO が key の正規表現にマッチしたら value のファイルを返す、という動作をする。404 以外が返っていこうとした場合は何もしない。

MogileFS からファイル探して、なかったらデフォルトのなにかを必要に応じてだす感じだとこういう風の例。

DefaultDocument という名前は英語的、動作の説明的に微妙な気がしないでもない...。そして相変わらずの俺得 module 感...。

Feb 06, 2013

Perlbal の Reproxy URL Cache の統計を Ganglia に送りつけるやっつけスクリプト。

mgmt のポートにつないで、show service <service name> で Reproxy URL Cache のキャッシュ数、ヒット数、ヒット率なんかが取れる。

% echo "show service web" | nc localhost 5700
show service tp_web
SERVICE tp_web
     listening: --
          role: reverse_proxy
  pend clients: 0
  pend backend: 0
    cache size: 0/1024 (0.00%)
    cache hits: 0
cache hit rate: 0.00%
 connect-ahead: 0/0
          pool: web_pool
         nodes:
                127.0.0.1:6500              0
.

(空っぽの状態だけど)これを parse して gmetric コマンドで定期的に ganglia に送りつけるだけ。

#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long qw( :config posix_default no_ignore_case bundling auto_help );
use Pod::Usage;
use IO::Socket::INET;

GetOptions(\my %opt, qw( host=s service=s gmetric verbose ))
    or pod2usage(1);

my $sock = IO::Socket::INET->new(PeerAddr => $opt{host}, Timeout => 2, Proto => 'tcp')
    or die $!;
print $sock "show service $opt{service}\r\n";
my ($cached, $max, $hit, $rate);
while (my $line = <$sock>) {
    last if $line =~ m{^\.};
    chomp $line;
    if ($line =~ m{\s*cache size: (\d+)/(\d+) \((\d+(?:\.\d+)?)\%\)}) {
        $cached = $1;
        $max    = $2;
    }
    elsif ($line =~ m{\s*cache hits: (\d+)}) {
        $hit = $1;
    }
    elsif ($line =~ m{\s*cache hit rate: (\d+(?:\.\d+)?)\%}) {
        $rate = $1;
    }
}
die unless (defined $cached && defined $max && defined $hit && defined $rate);

if ($opt{verbose}) {
    print "$cached cached, $hit hits, $rate% hit\n";
}
if ($opt{gmetric}) {
    system 'gmetric', '--name', 'perlbal_reproxy_cache_urls', '--value', $cached, '--type', 'uint32', '--group', 'perlbal';
    system 'gmetric', '--name', 'perlbal_reproxy_cache_hits', '--value', $hit, '--type', 'uint32', '--group', 'perlbal';
    system 'gmetric', '--name', 'perlbal_reproxy_cache_hit_rate', '--value', $rate, '--type', 'float', '--group', 'perlbal';
}

__END__

=pod

=head1 NAME

reproxy_cache_stats.pl - get reproxy cache stats

=head1 SYNOPSIS

  % reproxy_cache_stats.pl --host=<host:port> --service=<name> [--gmetric] [--verbose]

=cut

というメモ。

Jan 17, 2013

Perlbal で Server::Starter(start_server command) によるホットデプロイをサポートするためのプラグイン、Perlbal::Plugin::ServerStarter というのを作った(作っている)。

https://github.com/ziguzagu/Perlbal-Plugin-ServerStarter

Perlbal の素敵な点の一つに、動的に設定変更できる(管理ポートに telnet, nc などでつないでコマンド送り込む)というのがあるけど、たぶんほとんどのプラグインでは設定の削除ができない。たとえば Vhosts プラグイン。

VHOST app.example.com   = app
VHOST admin.example.com = admin     ## これがいらなくなっても動的に削除するコマンドはない
VHOST www.example.com   = web

また、複雑な設定や開発環境などではテスト済みの大きめの設定変更なんかをちまちま動的に変更するのは、作業自体のテストもしづらいし、そもそもが面倒くさい。なので、ときには再起動で設定読み直しがどうしても必要になったりならなかったりする。ただ(一応)ロードバランサーという位置づけのソフトウェアでもあり、サーバーのエッジあたりで運用されることもなくはないので、できれば無停止でいきたい。

ということで Server::Starter 対応。以下使い方。

プラグインを読み込むと LISTEN というコマンドが使えるようになるので、SET listen = [ip:]port の代わりに使う。

LOAD ServerStarter

CREATE SERVICE web
  SET role    = web_server
  SET docroot = /path/to/htdocs
  LISTEN = 5000
ENABLE web

と設定ファイルに書き、start_server 経由で perlbal 起動。

$ start_server --port 5000 -- perlbal -c /etc/perlbal/perlbal.conf

ただ、ポート番号をコマンドラインと設定ファイルで重複して管理することになるのがアレなので、設定ファイルからポート番号抜き出して start_server に食わせてくれる start_perlbal というコマンドも用意した。

$ start_perlbal -c /path/to/perlbal.conf

これでよしなにしてくれる。知らないオプションは start_server にパススルーするので、

$ start_perlbal -c /path/to/perlbal.conf --pid-file perlbal.pid

というのも機能するように。

1つ注意点があるとすればログについてはちょっと見直しが必要。Perlbal(1.80現在) のログ出力は、

  • foreground で実行したら STDOUT
  • --daemon オプションで daemonize したら syslog

という実装になっていて、foreground で実行しつつもログは syslog に、というのができない。Server::Starter は仕様上 foreground で実行する必要がある(daemonize すると pid が変わってしまうので(fork して exit するから)、start_server で起動失敗扱いになる。はず。試した限り。)ので、perlbal --daemon でいままで運用していた場合は、daemontools (multilog) 使ったりするか、

$ sudo start_perlbal 2>&1 | /usr/bin/logger -p local7.warn -t perlbal &

とかして syslog やらファイルにログ出すようにする必要がある。

あと、start_server を経由せずに perlbal で起動しようとすると Server::Starter#server_ports よんだところで死んでそのまま起動できなんだけど、警告だけだして SET listen = [ip:]port の指定に読み替えてとにかく起動できたほうがいいかどうかは迷いどころ。そのフォールバックのせいで気づかずに start_server なしで起動してた、なんてことになるのはそれはそれで事故のもとかなぁとも思うけどはたして...。

実装自体は Perlbal 本体に取り込んだほうが美しいので安定したら考えたいところ。

とはいえ、これで Perlbal 無停止運用が可能になったよ。たぶん。 happy01

Oct 24, 2012

perl のバージョンあげたのにともなって XMLRPC サーバーの実装につかっていた SOAP::Lite を、0.68 から最新(0.715)にあげたら、レスポンスに日本語含むやつが文字化けしつつ途中できれたXMLが返ってきてしまうという問題がおきた。

アプリが古めかしくて、アプリ内で扱う文字列が utf8 flagged な文字列ではなく binary な文字列で統一されていて、XMLRPC のレスポンス作るとこでも、

SOAP::Data->type(string => $user->name);  ## $user->name は binary string を返す

みたいなことしてた。で、SOAP::Lite 0.711(より正確には develop なバージョンである 0.71.01 )から SOAP::Transport::HTTP#send_receive で以下のようなことをやるようになった。

if ($] < 5.008) {
    $envelope = pack( 'C0A*', $envelope );
}
else {
    require Encode;
    $envelope = Encode::encode($encoding, $envelope);
}                                                                                                                                                                                                   

とにかく Encode::encode してしまう。全部の SOAP::Data#type で string つくってるとこで Encode::decode する以外に回避方法がなさげだったので、SOAP::Data#type をコピってきて上書きしてしまうクソハックで対応した。

{
    no warnings 'redefine';
    *SOAP::Data::type = sub {
        my $self = UNIVERSAL::isa($_[0] => 'SOAP::Data') ? shift->new() : SOAP::Data->new();
        if (@_) {
            $self->{_type} = shift;
            if ($self->{_type} eq 'string') {
                my $val = shift;
                $self->value(Encode::decode_utf8($val)) unless Encode::is_utf8($val);
            }
            else {
                $self->value(@_);
            }
            return $self;
        }
        if (!defined $self->{_type} && (my @types = grep {/^\{$SOAP::Constants::NS_XSI_ALL}type$/o} keys %{$self->{_attr}})) {
            $self->{_type} = (SOAP::Utils::splitlongname(delete $self->{_attr}->{shift(@types)}))[1];
        }
        return $self->{_type};
    }
}

早く内部文字列を utf8 flagged なものに統一したいけど、あちこちにちりばめられた、

Encode::is_utf8($str) && Encode::_utf8_off($str);

的なコードを改修する量が....。

Jun 25, 2011

Perlbal の web server に Apache の mod_expires と同じ代替期間指定構文ってやつで Expires を指定できるプラグイン、Perlball::Plugin::Expires というのを書いた。

使い方はこんなん。

LOAD Expires
CREATE SERVICE web
    SET role    = web_server
    SET listen  = 127.0.0.1:8000
    SET docroot = /path/to/docs
    SET plugins = Expires
    Expires default   = access plus 1 day 12 hours
    Expires image/gif = access plus 10 years
ENABLE web

Content-Type 別に指定できるのも同じ。ExpiresDefault 的なのは default を使う。mod_expires には A<時間>, M<時間> という形式もあるけどそっちはとりあえず対応してない(使ったことないから...)。

Perlbal には汎用的にレスポンスヘッダを追加できる Perlbal::Plugin::Addheader というのがあるのだけれど、Expires を指定するのに、

ADDHEADER static Expires [% {use HTTP::Date;HTTP::Date::time2str(time() + 2592000)} %]

こんなふうに書かないといけなくてあんまりだなぁと思ったので書いてみた次第。

どうぞご利用ください。

Oct 16, 2010

YAPC::Asia 2010、今年も無事開催され、無事参加してきた。

トークセッションはこのへんを聴いた。

  • That Goes Without Saying (or Does It?)
  • CloudForecastの紹介
  • モダンな Perl5 開発環境について
  • DataPortability and SocialWeb Protocols
  • Studying HTTP with Perl
  • How Xslate Works
  • O2 Web Framework
  • Perl5 is Alive!
  • let's database testing!
  • Perl6正規表現プログラミング楽土入門
  • 省サーバ運用
  • LT(2日目)
  • Keynote

合間に講堂前デッキのベンチでコードかいたり、アリンコや赤いダニみたいな虫と格闘したりした(きづくと Mac Book のディスプレイの縁をあるいている)。

しかしやっぱりあれだ。毎日何考えながらコードかいたり、仕事たりしてるかで人間やっぱり差がでるもんだなぁ、と思った。とはいっても、仕事のなかですべてを見つけようとするのもやっぱり無理があるよなぁとも思ったりもするので、プライベートで1個でいいからなんか夢中になれるもの探さないとこのまま腐っていくなぁ、僕の脳みそ。

という、前向きなのか後ろ向きなのかわからないのが今年の YAPC::Asia の感想です。まぁ、いろいろ刺激をうけた、ということで、前向きとする方向で。

来年はスピーカーとして参加できるよう、1年間精進していきたいところであります。

Sep 04, 2010

response body をいじる Plack::Middleware を作る場合、call で渡すコールバック関数の戻り値はサブルーチンにするのがよい(というかそうすべき?)。

sub call {
    my ($self, $env) = @_;
    my $res = $self->app->($env);
    $self->response_cb($res, sub {
        my $res = shift;
        ## こゆこと
        return sub {
            my $chunk = shift;
            $chunk .= 'test';
            return $chunk;
        };
    }
}

ただ $res をそのまんま書き換えてもちゃんと動いている風。

sub call {
    my ($self, $env) = @_;
    my $res = $self->app->($env);
    $self->response_cb($res, sub {
        my $res = shift;
        ## なまなましい感じで
        push @{ $res->[2] }, 'test';
    }
}

でも、後者をやってしまうと、Content-Length ヘッダがすでに設定されてしまっている場合、response body が変更されているにもかかわらず値が変更されない、という問題があったりする。

response_cb メソッドの実態は(いまのところ)Plack::Util::response_cb で、その中では、戻り値がサブルーチンだった場合にのみ設定済みの Content-Length を削除してくれるようになっている(ので、ContentLength Middleware も enable しておく必要がある)。以下、Plack::Util::response_cb (v0.9946) より抜粋。

my $body_filter = sub {
    my($cb, $res) = @_;
    my $filter_cb = $cb->($res);
    # If response_cb returns a callback, treat it as a $body filter
    if (defined $filter_cb && ref $filter_cb eq 'CODE') {
        Plack::Util::header_remove($res->[1], 'Content-Length');
        if (defined $res->[2]) {
            if (ref $res->[2] eq 'ARRAY') {
                for my $line (@{$res->[2]}) {
                    $line = $filter_cb->($line);
                }
                # Send EOF.
                my $eof = $filter_cb->( undef );
                push @{ $res->[2] }, $eof if defined $eof;
            } else {
                my $body    = $res->[2];
                my $getline = sub { $body->getline };
                $res->[2] = Plack::Util::inline_object
                    getline => sub { $filter_cb->($getline->()) },
                    close => sub { $body->close };
            }
        } else {
            return $filter_cb;
        }
    }
};

なんでサブルーチン返したときのみこうするようにしてるのかはよくわかっていないんだけど、、、そうなってるのでそうしましょう。。。(くぅ…、弱い)

# そして、P::U::response_cb の doc を書くという issue が github にあることに今気づいた

Aug 31, 2010

HTML や XML なんかのケツにコメントとしてテキストを埋め込む Plack::Middleware を作ってみた。

http://github.com/ziguzagu/Plack-Middleware-Watermark

やってることといえば、content type を見て適当なコメントシンタックスを選んで、指定された文字列を追加するだけのお仕事。

use Plack::Builder;
my $app = sub {
    [ 200, [ 'Content-Type' => 'text/html' ], [ "Hello World\n" ] ]
};
builder {
    enable 'Watermark', comment => 'HELLO HELLO!!';
    $app;
}

こうすると、

Hello World
<!-- HELLO HELLO!! -->

こういう出力になる。サブルーチンも渡せたりするので、

builder {
    enable 'Watermark', comment => sub { 'Generated by ' . Sys::Hostname::hostname };
    $app;
}

とかってのもできたり。HTML/CSS/XML/JS な Content-Type にとりあえず対応してる感じ。

でもまぁ、あんまり使い道はないですね :) ただ Plack & Plack::Middleware の勉強にはもろもろちょうど良かったです。まる。

Mar 29, 2010

% plackup -s Starman app.psgi

% starman app.psgi

は、機能的には全く同じ。なんだけど、plackup 使ったほうは ps コマンドでプロセスみるとコマンドラインから渡したパラメーターが見えなくなる。たとえば、worker の数調整して --daemonize したとする。

% plackup -s Starman --workers 2 --daemonize app.psgi
% ps x | grep starman
18801   ??  Ss     0:00.01 starman master
18803   ??  S      0:00.00 starman worker
18804   ??  S      0:00.00 starman worker

こんな表示。一方 starman コマンド使ったほう。

% starman --workers 2 --daemonize app.psgi
% ps x | grep starman
18835   ??  Ss     0:00.01 starman master --workers 2 --daemonize app.psgi
18837   ??  S      0:00.00 starman worker --workers 2 --daemonize app.psgi
18838   ??  S      0:00.00 starman worker --workers 2 --daemonize app.psgi

引数見えてる。

1つのホストで複数のアプリを plackup 経由で動かしていて、さてアプリ更新しよ、HUP だ、ってときに

% ps x | grep starman

したら、いっぱい出てきて焦った...。

それぞれのアプリでもちろん listen してる port も違ったけど、--pid で pid ファイル作っていたので、そっちから、kill して難を逃れた...。

% kill -HUP $(cat hello.pid)

きょうびのイケてる人達は daemontools 使って、plackup なり starman なりなんなり動かしてるようなので、たぶん問題ないんだろうけど( daemontools まだ使った事ないからよくわからん...>< )、コマンド用意されている PSGI なサーバーはとりあえずそれを使おうと思った。

ていうかなんで ps がああなるかわかっていないのはダメ男な気がする...。アウチ。

Mar 09, 2010

http://gist.github.com/326535

これをみてちょっとビビった(まったく本筋とは関係ないところで)。Getopt::Long::GetOptions の第1引数に HashRef 渡して、続いてオプションリストを配列で渡してる...。なんですかその使い方...。

まじで?!と思って試してみた。

#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;

GetOptions(
    \my %opt,
    qw( foo=s bar=i baz ),
);                                                                                                                                                         
$opt{foo} ||= '';
$opt{bar} ||= 0;
$opt{baz} ||= 0;

print $opt{foo}, "\n";
print $opt{bar}, "\n";
print $opt{baz} ? 'ture' : 'false', "\n";

テスト。

% perl getoptions.pl --foo test --bar 123
test
123
false

おぉお。こんな指定できたのかぁ、GetOptions。