Blog Developer's Cookbook http://blog.bulknews.net/cookbook/blosxom Cookbook About Programming Weblog Technologies ja Tatsuhiko Miyagawa (miyagawa@bulknews.net) Copyright Tatsuhiko Miyagawa Trackback Ping を受信する http://blog.bulknews.net/cookbook/blosxom/trackback/tb_receive.html Trackback Ping を送信する では、[[Trackback]] Ping を送信するクライアントについて解説しました. Trackback Pings Tatsuhiko Miyagawa 2003-11-26T23:28+09:00 Trackback Ping を送信する では、Trackback Ping を送信するクライアントについて解説しました。今回は、受信する側の実装を解説します。

Trackback Ping クライアント で解説したように、Trackback は HTTP POST によりパラメータを送信し、結果を XML 形式で返すという非常にシンプルなフレームワークです。よって、受信する Trackback サーバも、CGI スクリプトで簡単に記述することが可能です。

受信する CGI スクリプトでは、

  1. Trackback ID の解析 (必要なら)
  2. POST で渡された CGI パラメータの解析
  3. パラメータの保存
  4. XML レスポンスの表示
といった処理を行います。Trackback ID の解析というところが若干やっかいで、仕様自体には、どのように Trackback ID を指定すればいいかは規定されていません。よって、
  1. .../tb.cgi?tb_id=1234
  2. .../tb.cgi/1234
  3. .../1234.tb
のように、Trackback ID (ここでは 1234) が取得できれば、実装方法は何でもよいわけです。ちなみに、いくつかの Blog ツールやホスティングサービスでの実装は以下のようになっているようです。 |ツール名|Trackback URL サンプル|h |Movable Type|http://example.com/mt-tb.cgi/1234| |Blosxom|http://example.com/entry.trackback| |TypePad|http://www.typepad.com/t/trackback/1234| |tDiary|http://example.com/tdiary/tb.rb/20031126| いずれも、Trackback ID の取得は PATH_INFO や URL Rewriting(*1) を利用しています。先にあげたように HTTP GET のパラメータとして Query String に指定する方法もありますが、Trackback Ping 自体が HTTP POST でリクエストされるため、環境によってはうまく動作しないことも考えられますので、あまり利用しない方がよいでしょう(*2)。

サンプルコード

Trackback を受信する CGI スクリプトのサンプルは List 1 のようになります。ここでは、Trackback ID の抽出は PATH_INFO を使用、取得したデータは DBI インタフェースを使用して SQLite データベースに格納することにします。 

use CGI;
use DBI;
use HTML::Entities;
use Time::Piece;
使用するモジュールを use します。XML の文字変換に HTML::Entities を使用します。 

our $dbdir = "/tmp";
our @cols  = qw(url title blog_name excerpt timestamp);
Trackback を格納するデータベースファイルのパス、またテーブルに使用するカラム名をパッケージグローバルで宣言します。 

my $query = CGI->new();
   $query->charset('utf-8');
CGI オブジェクトを new し、charset に UTF-8 をセットします。 

    my $tb_id = munge_tb_id($query);
munge_tb_id で、PATH_INFO から Trackback ID を取得します。 

sub munge_tb_id {
    my $query = shift;
    my $path_info = $query->path_info();
    $path_info && $path_info =~ m!(\w+)! && return $1;
    return;
}
munge_tb_id では、CGI.pm の path_info メソッドで環境変数 PATH_INFO を取得し、/(\w+)/ という正規表現にマッチさせて ID を拾っています(*3)。 

    my $vars = $query->Vars();

    # Some validations
    if (!$tb_id) {
        send_response(1 => "Invalid Trackback ID");
        return;
    }

    if (!$vars->{url}) {
        send_response(1 => "No url parameter (required)");
        return;
    }
CGI.pm の Vars メソッドでハッシュリファレンスにパラメータを取得した後、Trackback ID が指定されているか、また url パラメータのチェックをしています。Trackback 仕様書 には、どのパラメータが必須かは記載されていませんが、

In the Movable Type implementation, of the above parameters only url is required. If title is not provided, the value for url will be set as the title.

とも記述されている通り、url パラメータだけはチェックしておきます。 

    fix_encoding($vars) if $vars->{charset};
charset パラメータが指定されている場合は、fix_encoding でエンコーディングの変換を行います。 

sub fix_encoding {
    my $vars = shift;
    require Encode;
    Encode::from_to($vars->{$_},
                    $vars->{charset} => "utf-8") for @cols;
}
@cols に含まれるパラメータについて、Encode の from_to 関数を使用してエンコーディングを変換します。from_to では変換前後ともに、変数は Perl の Unicode 文字列とはみなされず、バイト文字列として処理されます。 

    # Default values
    $vars->{title}     ||= $vars->{url};
    $vars->{blog_name} ||= do {
        require URI;
        URI->new($vars->{url})->host;
    };
    $vars->{excerpt} ||= "No excerpt.";
    $vars->{timestamp} = Time::Piece->new->datetime;
値が空のパラメータについて、デフォルトの値を埋めておきます。title は url と同様、blog_name は url のホスト部分としています。timestamp には現在時刻を ISO 8601 形式の文字列で格納します。 

    eval {
        store_ping($tb_id, $vars);
        send_response(0 => "Thanks for your Ping to $tb_id");
    };

    if ($@) {
        send_response(1 => "Error while storing ping: $@");
    }
store_ping で Trackback Ping の内容をデータベースに保存します。何かエラーが発生すると例外が投げられるため、拾ってレスポンスに表示します。うまくいった場合には、成功した旨のメッセージをレスポンスに表示します。 

sub store_ping {
    my($tb_id, $vars) = @_;
    my $is_existent = -e "$dbdir/$tb_id.db";
    my @dsn = ("dbi:SQLite:dbname=$dbdir/$tb_id.db", "", "");
    my $dbh = DBI->connect(@dsn, { RaiseError => 1,
                                   AutoCommit => 1, });

    # Create table "tb" if it's first time
    init_table($dbh) unless $is_existent;
store_ping の実装です。事前にデータベースファイルが存在するかどうかをチェックし$is_existent に格納しておきます。存在しなかった場合には、データベースに接続後、init_table で CREATE TABLE 文を発行します。 

sub init_table {
    my $dbh = shift;
    $dbh->do(<<SQL);
CREATE TABLE tb (
  url    VARCHAR(255) NOT NULL,
  title  VARCHAR(255) NOT NULL,
  blog_name VARCHAR(255) NOT NULL,
  excerpt TEXT,
  timestamp DATETIME
)
SQL
    ;
}
init_table では do メソッドで CREATE TABLE の SQL 文を実行します。VARCHAR, TEXT, DATETIME などの型を指定していますが、実は SQLite では、PRIMARY KEY 以外のカラムは、どの型にしても内部的には文字列型として保存されますので、スキーマの指定は気休め程度です。 

    # Generate SQL statements
    my $sql = sprintf "INSERT INTO tb (%s) VALUES (%s)",
        join(",", @cols), join(",", ('?') x @cols);
    my $sth = $dbh->prepare($sql);
    $sth->execute(@{$vars}{@cols});
    $sth->finish();

    $dbh->disconnect();
カラム配列 @cols からプレースホルダを含む SQL 文を生成します。$sql は、 

INSERT INTO tb (url,title,blog_name,excerpt,timestamp) VALUES (?,?,?,?,?)

のような内容になります。このステートメントに、$vars のスライスをとって execute メソッドを呼び出します(*4)。 

sub send_response {
    my($error, $message) = @_;
    my $msg = encode_entities($message);
    print $query->header('text/xml'), <<XML;
<?xml encoding="utf-8"?>
<response>
  <error>$error</error>
  <message>$msg</message>
</response>
XML
    ;
}
send_response では、エラーかどうかと、内容を表すメッセージを XML にして Content-Type: text/xml で print します。メッセージは XML エンコードが必要です。

実行例

Trackback Ping クライアントを使用して Trackback を送信してみましょう。Trackback URL は、今回作成したスクリプトのパスの後ろに、/TrackbackID を付加したものになります。うまく、"Ping sent successfully" が表示されたでしょうか。

SQLite のデータベースファイルを作成するため、$dbdir のディレクトリに対し、httpd の実行ユーザで書き込み権限を許可する必要があることに注意してください。

LWP モジュールに付属するコマンドラインプログラム POST で Trackback Ping を送信すると以下のようになります。 

% POST http://localhost/tb/1234
blog_name=test&url=http%3A%2F%2Fblog.example.com%2F&title=TEST&charset=utf-8
^D
<?xml encoding="utf-8"?>
<response>
  <error>0</error>
  <message>Thanks for your Ping to 1234</message>
</response>

格納された結果は sqlite コマンドなどで確認できます。 

% sqlite /tmp/1234.db
SQLite version 2.8.6
Enter ".help" for instructions
sqlite> select * from tb;
http://blog.example.com/|TEST|test|No excerpt.|2003-11-26T23:14:56
sqlite>

Hack the Hacks

Trackback リファレンス実装である tb-standalone でも、同様に PATH_INFO から Trackback ID を取得してローカルパスにデータを保持することが可能です。

CPAN モジュール Net::TrackBack を利用して、パラメータや Trackback ID の取得処理などを隠蔽・再利用することも可能ですが、この例でいえば、あまりメリットはないでしょう。

Listings

List 1: tb_receive.pl 
#!/usr/local/bin/perl -w
# tb_receive - Trackback Server

use strict;
use CGI;
use DBI;
use HTML::Entities;
use Time::Piece;

our $dbdir = "/tmp";
our @cols  = qw(url title blog_name excerpt timestamp);

my $query = CGI->new();
   $query->charset('utf-8');
do_task($query);

sub do_task {
    my $query = shift;
    my $tb_id = munge_tb_id($query);
    my $vars = $query->Vars();

    # Some validations
    if (!$tb_id) {
        send_response(1 => "Invalid Trackback ID");
        return;
    }

    if (!$vars->{url}) {
        send_response(1 => "No url parameter (required)");
        return;
    }

    fix_encoding($vars) if $vars->{charset};

    # Default values
    $vars->{title}     ||= $vars->{url};
    $vars->{blog_name} ||= do {
        require URI;
        URI->new($vars->{url})->host;
    };
    $vars->{excerpt} ||= "No excerpt.";
    $vars->{timestamp} = Time::Piece->new->datetime;

    eval {
        store_ping($tb_id, $vars);
        send_response(0 => "Thanks for your Ping to $tb_id");
    };

    if ($@) {
        send_response(1 => "Error while storing ping: $@");
    }
}

sub fix_encoding {
    my $vars = shift;
    require Encode;
    Encode::from_to($vars->{$_},
                    $vars->{charset} => "utf-8") for @cols;
}

sub store_ping {
    my($tb_id, $vars) = @_;
    my $is_existent = -e "$dbdir/$tb_id.db";
    my @dsn = ("dbi:SQLite:dbname=$dbdir/$tb_id.db", "", "");
    my $dbh = DBI->connect(@dsn, { RaiseError => 1,
                                   AutoCommit => 1, });

    # Create table "tb" if it's first time
    init_table($dbh) unless $is_existent;

    # Generate SQL statements
    my $sql = sprintf "INSERT INTO tb (%s) VALUES (%s)",
        join(",", @cols), join(",", ('?') x @cols);
    my $sth = $dbh->prepare($sql);
    $sth->execute(@{$vars}{@cols});
    $sth->finish();

    $dbh->disconnect();
}

sub init_table {
    my $dbh = shift;
    $dbh->do(<<SQL);
CREATE TABLE tb (
  url    VARCHAR(255) NOT NULL,
  title  VARCHAR(255) NOT NULL,
  blog_name VARCHAR(255) NOT NULL,
  excerpt TEXT,
  timestamp DATETIME
)
SQL
    ;
}

sub munge_tb_id {
    my $query = shift;
    my $path_info = $query->path_info();
    $path_info && $path_info =~ m!(\w+)! && return $1;
    return;
}

sub send_response {
    my($error, $message) = @_;
    my $msg = encode_entities($message);
    print $query->header('text/xml'), <<XML;
<?xml encoding="utf-8"?>
<response>
  <error>$error</error>
  <message>$msg</message>
</response>
XML
    ;
}
*1) Apache モジュール mod_rewrite などを利用して、URL を変換して環境変数などに切り出す手法。
*2) Python でできた Blog ツール PyCS ではこの方法を利用しているようです。
*3) \w は [0-9a-zA-Z_] と同等の文字クラスです。マルチバイトや - (ハイフン)などの文字はマッチしないので注意してください。
*4) こうして SQL 文や bind する値のリストを生成すれば、カラムの数が増えた場合でも @cols に追加するだけで OK になり、DBI をインラインに記述した場合でもメンテナンスが楽になります。
]]>