ishinaoの日記_ で

個人的には、「日記本文HTML中にその日記に対するTrackBack Ping URL?がRDF形式で埋め込まれており、そのTrackBack Ping URLに__mode=rssという引数をつけて呼ぶと、その日記に対するTrackBack一覧がRSS形式で取得できる」という仕様を実装してもらえるとありがたいなーと思っています。

というのが書かれていて、ふとhns-tb.cgiにその機能が未実装だということに気が付いた。
とりあえずこういうときはめんどくさいので Blog Developer's Cookbook : Trackback Ping 一覧を RSS 出力する_ からほぼパクって、テキトーに書き換える。
ねぎ式_ で配布している状態とのdiffという感じで。

--- hns-tb.cgi.orig	Thu Feb 10 17:12:57 2005
+++ hns-tb.cgi	Sat Jun 25 09:36:26 2005
@@ -7,10 +7,75 @@
 use Jcode;
 use SimpleDB::Scalar;
 use vars qw($DataDir);
+use HNS::System;
+use XML::RSS;
 
 require './config.ph';
 
 $DataDir ||= "$HNS::System::DiaryDir/trackback/";
+our $tb_prefix = jcode($HNS::System::Title)->utf8 ;
+our $tb_link   = "${HNS::System::MyDiaryURI}hns-tb.cgi";
+
+sub hack_rss_node {
+    my $rss = shift;
+    $rss =~ s@<\?xml .*?>\n*@@s;
+    $rss =~ s@<!DOCTYPE rss .*?>\n*@@s;
+    return $rss;
+}
+
+sub send_rss {
+    my($cgi, $rss) = @_;
+    my $rss_node = hack_rss_node($rss->as_string);
+    print $cgi->header('text/xml'), <<XML;
+<?xml version="1.0" encoding="utf-8"?>
+<response>
+  <error>0</error>
+  $rss_node
+</response>
+XML
+    ;
+}
+
+sub show_rss {
+    my($cgi, $id) = @_;
+    my $rss = XML::RSS->new(version => 0.91);
+    $rss->channel(
+        title => "$tb_prefix: $id",
+        link  => "$tb_link/$id",
+        description => "Trackback Discussion on $id",
+    );
+
+	open (F, "<$DataDir/$id") or error($!);
+	while(<F>){
+		my ($title, $excerpt, $url, $blog_name) = split("\t",$_);
+	        $rss->add_item(
+			title => jcode($title)->utf8,
+			link  => $url,
+        	);
+	}
+	close (F);
+    send_rss($cgi, $rss);
+}
+
+sub sendmail($)
+{
+	my $msg = shift;
+	my $email = $HNS::System::UserMail;
+	my $tomail = $HNS::System::MesMail;
+	my $sendmail = '/usr/local/bin/sendmail -t -f';
+
+	my $mail = "";
+	$mail .= "To: $tomail\n";
+	$mail .= "From: $email\n";
+	$mail .= "Content-Type: text/plain; charset=iso-2022-jp\n";
+	$mail .= $msg;	
+
+	Jcode::convert( \$mail, "jis");
+	open(OUT, "| $sendmail $tomail");
+	print OUT $mail;
+	close(OUT);
+	exit;
+}
 
 sub html_convert
 {
@@ -82,27 +147,16 @@
 
 my ($id) = ($ENV{REQUEST_URI} =~ m!cgi/(\d{9}\d*)!);
 
-#error 'invalid id' unless($id =~ /\d+/);
+error 'invalid id' unless($id =~ /\d+/);
 
-my $cgi = new CGI;
+my $cgi = CGI->new();
+   $cgi->charset('utf-8');
 
 if($cgi->param('__mode') eq 'rss'){
-    print "Content-Type: text/xml\r\n\r\n";
-    print "RSS\n";
+	show_rss($cgi, $id);
     exit;
 }
 
-$id = $cgi->param('tb_id') unless($id =~ /\d+/);
-error 'invalid id' unless($id =~ /\d+/);
-
-#my $id = "";
-#
-#my @params = $cgi->param();
-#foreach my $param (@params) {
-#  $id = sprintf("%s%s\t%s\n", $id,$param,$cgi->param($param));
-#}
-
-
 my $title = jcode($cgi->param('title'))->euc;
 my $excerpt = jcode($cgi->param('excerpt'))->euc;
 my $url = jcode($cgi->param('url'))->euc;
@@ -113,10 +167,16 @@
 my $orig_excerpt = $excerpt;
 my $orig_url = $url;
 my $orig_blog_name = $blog_name;
+my $blog_name_subject = jcode($blog_name)->mime_encode;
 
 # URL が空だったら error;
 error "URL is empty" unless($url);
 
+#block trackback spam
+if ($url =~ /casino/){
+error 'You are not allowed to send TrackBack pings'; 
+}
+
 # 要約は 255 文字程度で折る
 $excerpt = truncate_body($excerpt, 255);
 
@@ -130,8 +190,6 @@
 print F "\n";
 close F;
 
-system("chmod 666 $DataDir/$id"); 
-
 print "Content-Type: text/xml\r\n\r\n";
 print <<EOF;
 <?xml version="1.0" encoding="iso-8859-1"?>
@@ -146,24 +204,15 @@
 $last_modified = time;
 untie $last_modified;
 
-my $mailto = 'ore@yar-3.net';
-my $sendmail = '/usr/lib/sendmail';
+	my $mail = "";
+	$mail .= "Subject: [hns] trackback $blog_name_subject $id\n";
+	$mail .= "\n";
+	$mail .= "title: $orig_title\n$orig_blog_name\n";
+	$mail .= "$orig_excerpt\n $orig_url\n";
+	$mail .= "-- \n";
+	$mail .= "trackback sender by $HNS::System::Author\n\n";
+	$mail .= "from $ENV{'REMOTE_HOST'} $ENV{'REMOTE_ADDR'}\n";
+	$mail .= "UA $ENV{'HTTP_USER_AGENT'} \n";
+
+sendmail($mail);
 
-     my $msg = "";
-     $msg .= "To: $mailto\n";
-     $msg .= "From: $mailto\n";
-     $msg .= "Content-Type: text/plain; charset=iso-2022-jp\n";
-     $msg .= "Subject: trackback $orig_blog_name $id\n";
-     $msg .= "\n";
-     $msg .= "title: $orig_title\n$orig_blog_name\n";
-     $msg .= "$orig_excerpt\n $orig_url\n";
-     $msg .= "-- \n";
-     $msg .= "trackback sender by yar-3\n\n";
-     $msg .= "from $ENV{'REMOTE_HOST'} $ENV{'REMOTE_ADDR'}\n";
-     $msg .= "UA $ENV{'HTTP_USER_AGENT'} \n";
-
-
-     Jcode::convert( \$msg, "jis");
-     open(OUT, "| $sendmail $mailto");
-     print OUT $msg;
-     close(OUT);

サーバーにXML::RSSモジュールが無いのであればsub_showrssで

sub add_item {
    my ($title, $url) = @_;
    my $item = <<"RSS";
<item>
  <title>$title</title> 
  <link>$url</link> 
</item>
 RSS
;
   return $item;
}

みたいなsubを呼んで追記するのでもいいかもしれない。