#!/usr/local/bin/perl # Copyright 2002 Benjamin Trott. # This code is released under the Artistic License. use strict; use lib qw(. ./ext); use IP_Base; my $Charset = 'euc-jp'; my $DataDir = "./tbdir"; my $RSSDir = "./rssdir"; my $tbpath = "./tb.cgi"; my $Pkey = "0628"; my $TrackbackUrl = './'; my $vDir = '.'; unshift @INC, './lib'; use vars qw( $VERSION ); $VERSION = '1.02.20040903'; use CGI qw( :standard ); eval('charset $Charset'); my $pms = param('__mode'); my $oth; my $mode; ($mode, $oth)=split(/\?/, $pms) if( $pms ); unless ($mode) { my $r1 = rindex($ENV{SCRIPT_NAME}, "/"); unless( substr($ENV{SCRIPT_NAME}, $r1+1) eq "tb.cgi" ){1;}else{ my $tb_id = munge_tb_id(get_tb_id()); respond_exit("No TrackBack ID (tb_id)") unless $tb_id; my $url=delTag(param('url')); respond_exit("No URL (url)") unless $url; my $title=delTag(param('title')); $title ||=$url; my $excerpt=delTag(param('excerpt')); my $blog_name=delTag(param('blog_name')); my $cset=delTag(param('charset')); my ($header, $footer, $custom, $ping_msg, $custom_admin, $lst, $blogname_max, $title_max, $excerpt_max, $mto)=get_custom(); my ($sendmail_path, $mail_address)=split(/\x02/, $mto); require Jcode; my $code = { 'utf-8'=>'utf8','iso-2022-jp'=>'jis','shift_jis'=>'sjis','euc-jp'=>'euc' }->{lc($cset)} || Jcode::getcode($excerpt . $title . $blog_name); my $dummy; ($title, $dummy)=split(/\n/, Jcode->new($title, $code)->jfold($title_max)->euc()); ($excerpt, $dummy)=split(/\n/, Jcode->new($excerpt, $code)->jfold($excerpt_max)->euc()); ($blog_name, $dummy)=split(/\n/, Jcode->new($blog_name, $code)->jfold($blogname_max)->euc()); my $rej=is_reject($ENV{'REMOTE_HOST'}, $ENV{'REMOTE_ADDR'}, $url); # IPスパムフィルターでチェックします if ( $rej ) { ## IP Spam Filter Start_! my $uhk = IP_Base::_allow_url_domain($url,'./ipcheck'); if (IP_Base::_check_ip_base($ENV{'REMOTE_ADDR'},'./ipcheck',$uhk,'TB',$url)==0){ $rej = 0;} ## IP Spam Filter End_! } # 連続ひらがなが内容に含まれているかどうか確認 if ( $rej ) { my $bbdy = $excerpt; if ($bbdy !~ m/(\xA4[\xA1-\xF3]){2}/) { $rej = 0;} } if( $rej ) { send_email($tb_id, $sendmail_path, $mail_address, $url, $rej); add_data($tb_id, $title, $excerpt, $blog_name, $url, time, $ENV{'REMOTE_HOST'}, $ENV{'REMOTE_ADDR'}); make_nicky_log($tb_id); respond_exit(); } respond_exit("Reject"); } } elsif( $mode eq 'num' ){ my $tb_id=param('tb_id'); my $str=header()."document.write('("; if( $tb_id ){ my @data=get_data($tb_id); my $i=0; for my $record(@data){ my($tb_idr, $dummy)=split(/\x01/, $record); $i++ if( $tb_id eq $tb_idr ); } $str .= "$i"; }else{ $str .= "no tb_id"; } print $str, ")')\n"; } elsif ($mode eq 'red' ){ my $tb_id="20040421A"; open WD, ">./junkfile2"; print WD redirect("./nicky.cgi"); print WD "bac\n"; close WD; # print redirect("tb.cgi" . "?__mode=list&tb_id=$tb_id"); print redirect("./nicky.cgi" . "?__mode=list&tb_id=$tb_id"); } elsif ($mode eq 'list') { put_list(); } elsif ($mode eq 'testreject' ){ my $ip=param('ip'); my $hn=param('hn'); my $url=param('url'); print header(); print "\n"; if( isTBadmin() ){ my $ret=is_reject($hn, $ip, $url); if( $ret ){ print "Pass\n"; }else{ print "Reject\n"; } } print "\n"; } elsif ($mode eq 'delete') { die "You are not authorized" unless isTBadmin(); my $tb_id = munge_tb_id(get_tb_id()); die("No TrackBack ID (tb_id)") unless $tb_id; my $index = param('index') || 0; delete_tb($tb_id, $index); make_nicky_log($tb_id); print redirect(url() . "?__mode=list&tb_id=$tb_id"); } elsif ($mode eq 'rss') { my $tb_id = munge_tb_id(get_tb_id()); respond_exit("No TrackBack ID (tb_id)") unless $tb_id; my @data=get_data($tb_id); my @rssdat; for my $record( @data ){ my($tb_idr, $title, $excerpt, $blog_name, $url, $time, $host, $addr)= split(/\x01/, $record); if( $tb_id eq $tb_idr ){ @rssdat=(@rssdat, $record); }elsif( $tb_id =~ /alldata/ ){ @rssdat=(@rssdat, $record); } } respond_exit(undef, generate_rss($tb_id, @rssdat)); } elsif ($mode eq 'send_ping') { require Jcode; require LWP::UserAgent; my $ua = LWP::UserAgent->new; $ua->agent("TrackBack/$VERSION"); my @qs = map $_ . '=' . encode_url(Jcode->new(param($_) || '', 'euc')->utf8()),qw( title excerpt blog_name ); push @qs, "url=".encode_url(param('url') || ''); push @qs, "charset=utf-8"; my $ping = param('ping_url') or ping_form_exit("No ping URL"); my $req; if ($ping =~ /\?/) { $req = HTTP::Request->new(GET => $ping . '&' . join('&', @qs)); } else { $req = HTTP::Request->new(POST => $ping); $req->content_type('application/x-www-form-urlencoded'); $req->content(join('&', @qs)); } my $res = $ua->request($req); ping_form_exit("HTTP error: " . $res->status_line) unless $res->is_success; my($e, $msg) = $res->content =~ m!(\d+).*(.+?)!s; $e ? ping_form_exit("Error: $msg") : ping_form_exit("Ping successfuly sent"); } elsif ($mode eq 'send_form') { ping_form_exit($oth); } elsif ($mode eq 'PassWord' ) { &password_form(); } elsif ($mode eq 'setup_password'){ print password_done(); } elsif ($mode eq 'dummy_password' ){ print dummy_password(); } elsif ($mode eq 'custom'){ edit_tb(); } elsif ($mode eq 'write_custom'){ write_custom(); } sub get_tb_id { my $tb_id = param('tb_id'); unless ($tb_id) { if (my $pi = path_info()) { ($tb_id = $pi) =~ s!^/!!; } } $tb_id; } sub munge_tb_id { my($id) = @_; return '' unless $id; $id =~ tr/a-zA-Z0-9/_/cs; $id; } sub delete_tb{ my($tb_id, $index)=@_; my @data=get_data($tb_id); my $tb_idr; my @ary; my $tb_file = get_file_name($tb_id); open FH, ">" . $tb_file; binmode FH; for my $item(@data){ ($tb_idr, @ary)=split(/\x01/, $item); if( $tb_id eq $tb_idr ){ print FH $item."\x02" unless( $index == $ary[4] ); }else{ print FH $item."\x02"; } } close FH; } sub is_reject{ my(@listdat)=@_; my $ret=1; my $dat=from_file("./reject_list.cgi"); my $line; my @ysl; my $ys; $dat=~s/\r//g; $dat=~s/\r| //g; for $line(split(/\n/, $dat)){ @ysl=split(/\./, $line); for $ys(@listdat){ if( substr($line, length($line)-1) eq '*' ){ if( $ys =~ /^$line/ ){ $ret=0; last; } }else{ if( $ys =~ /^$line$/ ){ $ret=0; last; } } } last if( !$ret ); } $ret; } sub get_file_name{ my($tb_id)=@_; my $y=substr($tb_id, 0, 4); my $m=substr($tb_id, 4, 2); "$DataDir/$y$m.cgi"; } sub del_daytb { my($year, $month, $day, $daysub)=@_; my $tb_id = "$year$month$day$daysub"; my $itemid = "$year$month$day"; my $tb_file= get_file_name($tb_id); my @data = get_data($tb_id); my @ary; my $tb_idr; my $ds; my $dsubord; $dsubord=ord($daysub); open FH, ">" . $tb_file; binmode FH; for my $item(@data){ ($tb_idr, @ary)=split(/\x01/, $item); if( $tb_idr !~ /$itemid[A-Za-z]/ ){ print FH $item."\x02"; }else{ $ds=ord(substr($tb_idr, 8)); if( $ds == $dsubord ){ }elsif( $ds < $dsubord ){ print FH $item."\x02"; }else{ print FH $itemid; print FH sprintf("%c\x01", $ds-1); print FH "$ds\x01"; for $ds(@ary){ print FH "$ds\x01"; } print FH "\x02"; } } } close FH; } sub make_nicky_log { my($tb_id)=@_; my $year=substr($tb_id, 0, 4); my $month=substr($tb_id, 4, 2); my $day=substr($tb_id, 6, 2); my $daysub=substr($tb_id, 8, 1); local *WD; eval('require("./nicky.cgi")'); unless( $@ ){ ReadSetup(); initial2nd(); MakeHTMLone($year, $month, $day, $daysub, 0); MakeLastHTMLsub(); } } sub get_data { my($tb_id)=@_; my $tb_file = get_file_name($tb_id); my $all_dat; if( open FH, $tb_file ){ binmode FH; while (){ $all_dat.=$_; } close FH; } split(/\x02/, $all_dat); } sub add_data { my($tb_idr, $title, $excerpt, $blog_name, $url, $time, $host, $addr)=@_; my $tb_id=$_[0]; my $tb_file = get_file_name($tb_id); open FH, ">>$tb_file"; binmode FH; print FH "$tb_idr\x01$title\x01$excerpt\x01$blog_name\x01$url\x01$time\x01$host\x01$addr\x02"; close FH; } sub generate_rss { my($tb_id, @data) = @_; my $rss = qq(TB: $tb_id\n); # my $max = $limit ? $limit - 1 : $#$data; # for my $i (@{$data}[0..$max]) { # $rss .= sprintf "%s%s%s\n", xml('title', $i->{title}), # xml('link', $i->{url}), xml('description', $i->{excerpt}) if $i; # } my $max = 50; for my $record (@data[0..$max]) { my($tb_idr, $title, $excerpt, $blog_name, $url, $time, $host, $addr)= split(/\x01/, $record); $rss .= sprintf "%s%s%s\n", xml('title', $title), xml('link', $url), xml('description', $excerpt) if $record; } $rss . qq(); } sub put_list { my $tb_id = munge_tb_id(get_tb_id()); my ($header, $footer, $custom, $ping_msg, $custom_admin, $lst)=get_custom(); die("No TrackBack ID (tb_id)") unless $tb_id; my $url_me = url(); my @week_str=('(Sun)','(Mon)','(Tue)','(Wed)','(Thu)','(Fri)','(Sat)'); my $url_nicky=$url_me; $url_nicky=~s/tb.cgi/nicky.cgi/; $url_nicky="$url_nicky?DT=$tb_id#$tb_id"; my($title, $msgall)=get_nicky_file($tb_id); my($msg, $dummy)=split(/
|
/, $msgall); $msg=delTag($msg); $title=delTag($title); $dummy=from_file("./tb_admin.cgi"); my($dummy1, $page_title)=split(/\n/, $dummy); $ping_msg=~s/\$url_ping/$url_me\/$tb_id/g; $ping_msg=~s/\$tb_id/$tb_id/g; $ping_msg=~s/\$url_nicky/$url_nicky/g; $ping_msg=~s/\$title/$title/g; $ping_msg=~s/\$msg/$msg/g; $header=~s/\$url_ping/$url_me\/$tb_id/g; print header(-charset => $Charset), $header, $ping_msg; my @data = get_data($tb_id); my $i = 0; my $logged_in = isTBadmin(); my $cstr; my $templ; @data=reverse(@data) if( $lst eq "new" ); for my $record (@data) { my($tb_idr, $title, $excerpt, $blog_name, $url, $ltime, $host, $addr)=split(/\x01/, $record); if( $tb_idr eq $tb_id ){ my($csec,$cmin,$chour,$cday,$cmon,$cyear,$cwday,$cyday,$cisdst)= localtime $ltime; my $ts=sprintf("%04d/%02d/%02d%s %02d:%02d", $cyear+1900, $cmon+1, $cday, @week_str[($cwday%7)], $chour, $cmin); $templ=$custom; $templ=~s/\$url/$url/g; $templ=~s/\$tb_title/$title/g; $blog_name ||= "[No blog name]"; $templ=~s/\$blog_name/$blog_name/g; $excerpt ||= "[No excerpt]"; $templ=~s/\$excerpt/$excerpt/g; $templ=~s/\$time/$ts/g; $cstr=$logged_in ? qq([DELETE]) : ''; $templ=~s/\$delete/$cstr/g; print $templ; $i++; } } if( isTBadmin() ){ $page_title=~s/\n|\r|\t//g; while( $page_title=~s/ $// ){} $custom_admin=~s/\$msg/$msg/g; $custom_admin=~s/\$title/$title/g; $custom_admin=~s/\$page_title/$page_title/g; $custom_admin=~s/\$url_nicky/$url_nicky/g; print $custom_admin; } $footer=~s/\$url_ping/$url_me\/$tb_id/g; print $footer; } sub send_email { my($tb_id, $sendmail_path, $mail_address, $url, $rej)=@_; my($subject)="=?ISO-2022-JP?B?GyRCJUglaSVDJS8lUCVDJS9ETENOGyhC?="; if( $sendmail_path && $mail_address ){ open(FH, "|$sendmail_path -t -Fnicky"); binmode FH; print FH "To: $mail_address\n"; print FH "Subject: $subject\n"; print FH "Content-Type: text/plain; charset=ISO-2022-JP\n"; print FH "Content-Transfer-Encoding: 7bit\n"; print FH "\n"; print FH "from : $ENV{REMOTE_HOST}($ENV{REMOTE_ADDR})\n"; print FH " $url\n"; print FH "agent : $ENV{HTTP_USER_AGENT}\n\n"; print FH "http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}\?tb_id=$tb_id&__mode=list\n\n"; if( !$rej ){ print FH "REJECT\n\n"; } close FH; } } sub respond_exit { print "Content-Type: text/xml; charset=EUC-JP\n\n"; print qq(\n\n); if ($_[0]) { printf qq(1\n%s\n), xml('message', $_[0]); } else { print qq(0\n) . ($_[1] ? $_[1] : ''); } print "\n"; exit; } sub ping_form_exit { my($oth) = @_; my($subp, $subv)=split(/=/, $oth); my $ping_url_str; my $ping_url_for_blog; my($header,$footer,$custom,$ping_msg,$custom_admin, $lst)=get_custom(); print header(), $header; unless( $oth ){ print $footer; exit; }elsif( $subp eq "ping_url" ){ $ping_url_str=""; $ping_url_for_blog="この記事へのTrackBack先URL"; }elsif( $oth =~ /successfuly/ ){ print "
"; if( isTBadmin() ){ print "送信しました\n"; }else{ print "ありがとうございました。\n"; } print "
"; print "
\n"; exit; }else{ print "@_" if @_; print "\n"; exit; } print <
TrackBack送信用フォーム

$ping_url_for_blog $ping_url_str
 
TrackBackを実装されていない方は以下のフォームにて送ってください
ページのタイトル:
記事のタイトル:
記事の概要:
URL:
HTML if( isTBadmin() ){ my $str; my $p=rindex($subv, "/"); my $tb_id=substr($subv, $p+1); my($title, $msgall)=get_nicky_file($tb_id); my($msg, $dummy)=split(/
/, $msgall); $msg=delTag($msg); $title=delTag($title); my $url_nicky=substr($subv, 0, $p); $url_nicky=~s/tb.cgi/nicky.cgi/; $url_nicky="$url_nicky?DT=$tb_id#$tb_id"; my $put_url="nicky.cgi?DT=$tb_id#$tb_id"; $dummy=from_file("./tb_admin.cgi"); my($dummy1, $page_title)=split(/\n/, $dummy); $page_title=~s/\n|\r|\t//g; while( $page_title=~s/ $// ){}; print $custom_admin; } print $footer; exit; } sub password_form { my($header, $footer, $custom, $ping_msg, $custom_admin, $lst)=get_custom(); my $str_sb=""; my $page_title=""; print header(); print $header; if( -e "./tb_admin.cgi" ){ my $dummy; $str_sb = <　

HTML # if( isTBadmin() ){ my $dat=from_file("./tb_admin.cgi"); ($dummy, $page_title)=split(/\n/, $dat); $page_title =~ s/\r|\n//g; # } }else{ unless( -d "./tbdir" ){ mkdir("./tbdir", 0777); unless( -d "./tbdir" ){ print "tb.cgiを設置したフォルダにCGIからのライト権がありません。
tb.cgiを設置したフォルダのパーミッションにCGIからのライト権を追加してください。
\n"; exit; } mkdir("./rssdir", 0777); } } print < $str_sb Password
　
Page Title
　

HTML exit; } sub isadmin{ my($pass)=@_; my $rtn=0; $pass=~s/\r|\n|\t| //g; open FH, "./tb_admin.cgi"; binmode FH; my $past_pass=; close FH; $past_pass =~ s/\r|\n| //g; $rtn = 1 if( $past_pass eq crypt($pass, $Pkey) ); $rtn; } sub isTBadmin{ require CGI::Cookie; my %cookies = CGI::Cookie->fetch; my $rtn = 0; return $rtn unless $cookies{nkytb}; my $key = $cookies{nkytb}->value || return $rtn; isadmin( $key ); } sub password_done{ my($header, $footer, $custom, $ping_msg, $custom_admin, $lst)=get_custom(); my $key = param('key'); my $str = $header; my $flag=0; if( -e "./tb_admin.cgi" ){ my $old_key = param('old_key'); my $past_pass; my $oky; if( isadmin( $old_key ) ){ $flag=1; }else{ $str .= "invalid password."; } }else{ $flag=1; } if( $flag ){ my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time + 60*24*60*365); $wday = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday') [$wday]; $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon]; my $datec = sprintf("%s, %02d\-%s\-%04d %02d:%02d:%02d GMT",$wday,$mday,$mon,$year+1900,$hour,$min,$sec); my $path=$ENV{REQUEST_URI}; if( $path eq "" ){ $path=$ENV{SCRIPT_NAME}; } print "Set-Cookie: nkytb=$key; expires=$datec;path=$path;\n"; print header(); my $page_title=param('page_title'); open FH, ">./tb_admin.cgi"; binmode FH; print FH crypt($key, $Pkey); print FH "\n$page_title"; close FH; $str .= "Done."; }else{ print header(); } $str .= "
"; $str; } sub dummy_password{ my $str; my($header, $footer, $custom, $ping_msg, $custom_admin, $lst)=get_custom(); if( isTBadmin() ){ require CGI::Cookie; my $path=$ENV{REQUEST_URI}; if( $path eq "" ){ $path=$ENV{SCRIPT_NAME}; } my $key=""; my $cookie = CGI::Cookie->new(-name => 'nkytb', -value => $key, -path => $path, -expires => '-1M'); $str = header(-cookie => $cookie); }else{ $str = header(); $str .= "Invalid PC
"; } $str .= $header; $str .= "dummy password done."; $str .= $footer; $str; } sub delTag{ my($str)=@_; my($p1,$p2); my $dst1; my $dst2; $str=~s/&/&/g; $str=~s/\"/"/g; return $str unless( $str =~ // ){ last if( $str !~ /"); if( $p1 > $p2 ){ $str=~s/>/>/; } $p1=index($str, "<"); $dst1=substr($str, 0, $p1); $dst2=substr($str,$p1); $p2=index($dst2, ">"); if( $p2 > 0 ) { $dst2=substr($dst2, $p2+1); } else { $dst2=$dst2; } $str = "$dst1$dst2"; } $str=~s//>/g; $str; } sub get_nicky_file { my($opt)=@_; my $str=""; my($y, $m, $d, $ds); my($Date, $Title, $Message, $GrpFileName, $Layout, $CommentRecv, $fit_size, $RepLayout, $tbRcv, $ctg, $NickyFname); $y=substr($opt, 0, 4); $m=substr($opt, 4, 2); $d=substr($opt, 6, 2); $ds=substr($opt, 8, 1); require('./nicky.cgi'); eval('($NickyFname, $ctg)=&getNickyFname($y, $m, $d, $ds, 0)'); if( $@ ){ $NickyFname="$vDir/$y/$m$d$ds.nky"; } if( open(FH, $NickyFname) ){ binmode(FH); while(){ $str .= $_; } close(FH); } ($Date, $Title, $Message, $GrpFileName, $Layout, $CommentRecv, $fit_size, $RepLayout, $tbRcv) = split(/\x01/, $str); ($Title, $Message); } sub get_custom{ my($str, $header, $footer, $custom, $ping_msg, $custom_admin, $lst, $blogname_max, $title_max, $excerpt_max, $mto); if( open FH, "./tb_custom.cgi" ){ binmode FH; $str .= $_ while ; close FH; ($header, $footer, $custom, $ping_msg, $custom_admin, $lst, $blogname_max, $title_max, $excerpt_max, $mto)=split(/\x01/, $str); }else{ $header=< Trackback

HEADER $footer=<
TrackBackを実装されていない方は以下のフォームにて送ってください
ページのタイトル：
記事のタイトル：
記事の概要：
URL：
FOOTER $custom=<
\$tb_title
タイトル\$blog_name
概要\$excerpt
\$time\$delete

CUSTOM $ping_msg=<記事：\$title
トラックバック送信先URI:\$url_ping
PING_MSG $custom_admin=<以下のメッセージは管理PC用からのみ表示されます。

nicky!からTrackBackを送信する際はこちらのフォームに入力します。
送信先URL：
ページのタイトル：
記事のタイトル：
記事の概要：
記事のURL： URI

管理PC用メッセージここまで

CUSTOM_ADMIN $lst="new"; $blogname_max = $title_max = $excerpt_max = 1024; } ($header, $footer, $custom, $ping_msg, $custom_admin, $lst, $blogname_max, $title_max, $excerpt_max, $mto); } sub edit_tb { my($header, $footer, $custom, $ping_msg, $custom_admin, $lst, @lmax)=get_custom(); my $str=header(); unless( isTBadmin() ){ print $str, "\n\n", $header, "invalid access", $footer; exit; } $header=~s/
Ver $VERSION
Sort.↑Old　 ↑New
Header.


Ping Message.


Footer.


TrackBack.


Admin.

Blogname Max Length= , Title Max Length= , Excerpt Max Length=
sendmail path 　mail address

HTML print $str; } sub write_custom { my $str=header(); unless( isTBadmin() ){ print $str, "\n\ninvalid access"; exit; } my $header=param('header'); my $footer=param('footer'); my $custom=param('custom'); my $ping_msg=param('ping_msg'); my $custom_admin=param('custom_admin'); my $lst=param('sortlist'); my $blogname_max=param('blogname_max'); my $title_max=param('title_max'); my $excerpt_max=param('excerpt_max'); my $smpath=param('sendmail_path'); my $mailaddress=param('mail_address'); $header=~s/\r//g; $footer=~s/\r//g; $custom=~s/\r//g; $ping_msg=~s/\r//g; $custom_admin=~s/\r//g; $smpath=~s/\r|\n//g; $mailaddress=~s/\r|\n//g; if( open FH, ">./tb_custom.cgi" ){ binmode FH; print FH "$header\x01"; print FH "$footer\x01"; print FH "$custom\x01"; print FH "$ping_msg\x01"; print FH "$custom_admin\x01"; print FH "$lst\x01"; print FH "$blogname_max\x01"; print FH "$title_max\x01"; print FH "$excerpt_max\x01"; print FH "$smpath\x02"; print FH "$mailaddress"; close FH; $str.="Done\n"; }else{ $str.="Do not file Write\n"; } print $str; } sub goto_keisicho { #print "\n"; exit; } my(%Map, $RE); BEGIN { %Map = ('&' => '&', '"' => '"', '<' => '<', '>' => '>'); $RE = join '|', keys %Map; } sub xml { (my $s = defined $_[1] ? $_[1] : '') =~ s!($RE)!$Map{$1}!g; # "<$_[0]>" . enc($s) . "\n"; "<$_[0]>" . $s . "\n"; } sub encode_url { (my $str = $_[0]) =~ s!([^a-zA-Z0-9_.-])!uc sprintf "%%%02x", ord($1)!eg; $str; } sub from_file { my($file) = @_; local *FH; my $c=""; if( open FH, $file ){ binmode FH; { local $/; $c = } close FH; } $c; } __END__ =head1 NAME tb-standalone - Standalone TrackBack =head1 DESCRIPTION The standalone TrackBack tool serves two purposes: 1) it allows non-Movable Type users to use TrackBack with the tool of their choice, provided they meet the installation requirements; 2) it serves as a reference point to aid developers in implementing TrackBack in their own systems. This tool is a single CGI script that accepts TrackBack pings through HTTP requests, stores the pings locally in the filesystem, and can return a list of pings either in RSS or in a browser-viewable format. It can also be used to send pings to other sites. It is released under the Artistic License. The terms of the Artistic License are described at I. =head1 REQUIREMENTS You'll need a webserver capable of running CGI scripts (this means, for example, that this won't work with BlogSpot-hosted blogs). You'll also need perl, and the following Perl modules: =over 4 =item * File::Spec =item * Storable =item * CGI =item * CGI::Cookie =item * LWP =back The first four are core modules as of perl 5.6.0, I believe, and LWP is installed on most hosts. Furthermore LWP is only required if you wish to B TrackBack pings. =head1 INSTALLATION Installation of the standalone TrackBack tool is very simple. It's just one CGI script, F, along with two text files that define the header and footer HTML for the public list of TrackBack pings. =over 4 =item 1. Configure tb.cgi You'll need to edit the script to change the I<$DataDir>, I<$RSSDir>, and I<$Password> settings. B BEFORE INSTALLING THE TOOL.> I<$DataDir> is the path to the directory where the TrackBack data files will be stored; I<$RSSDir> is the path to the directory where the static RSS files will be generated; I<$Password> is your secret password that will allow you to delete TrackBack pings, when logged in. After setting I<$DataDir> and I<$RSSDir>, you'll need to create both of these directories and make them writeable by the user running the CGI scripts. In most cases, this means that you must set the permissions on these directories to 777. =item 2. Upload Files After editing the settings, upload F, F, and F in ASCII mode to your webserver into a directory where you can run CGI scripts. Set the permissions on F to 755. =back =head1 USAGE =head2 Sending Pings To send pings from the tool, go to the following URL: http://yourserver.com/cgi-bin/tb.cgi?__mode=send_form where I is the URL where you installed F. Fill out the fields in the form, then press I. =head2 Receiving Pings To use the tool in your existing pages, you'll need to do two things: =over 4 =item 1. Link to TrackBack listing First, you'll need to add a link to each of your weblog entries with a link to the list of TrackBack pings for that entry. You can do this by adding the following HTML to your template: TrackBack You'll need to change C to the proper URL for I on your server. And, depending on the weblogging tool that you use, you'll need to change C<[TrackBack ID]> to a unique post ID. See the L to determine the proper tag to use for the tool that you use, to generate a unique post ID. =item 2. Add RDF TrackBack uses RDF embedded within your web page to auto-discover TrackBack-enabled entries on your pages. It also uses this information when building a threaded list of a cross-weblog "discussion". For these purposes, it is useful to embed the RDF into your page. Add the following to your weblog template so that it is displayed for each of the entries on your page: As above, the tags that you should use for C<[TrackBack ID]>, C<[Entry Title]>, and C<[Entry Permalink]> all depend on the weblogging tool that you are using. See the L. =back =head2 Conversion Table =over 4 =item * Blogger TrackBack ID = C$BlogItemNumber$E> Entry Title = CPostSubjectEE$BlogItemSubject$EE/PostSubjectE> Entry Permalink = C$BlogItemArchiveFileName$E#E$BlogItemNumber$E> =item * GreyMatter TrackBack ID = C<{{entrynumber}}> Entry Title = C<{{entrysubject}}> Entry Permalink = C<{{pagelink}}> =item * b2 TrackBack ID = C?php the_ID() ?E> Entry Title = C?php the_title() ?E> Entry Permalink = C?php permalink_link() ?E> =item * pMachine TrackBack ID = C<%%id%%> Entry Title = C<%%title%%> Entry Permalink = C<%%comment_permalink%%> =item * Bloxsom TrackBack ID = C<$fn> Entry Title = C<$title> Entry Permalink = C<$url/$yr/$mo/$da#$fn> Thanks to Rael for this list of conversions. =back =head1 POSSIBLE USES =over 4 =item 1. Content repository Like Movable Type's TrackBack implementation, this standalone script can be used to power a distributed content repository. The value of the I parameter does not necessarily have to be an integer, because all it is used for is a filename (B that this is not true of most other TrackBack implementations). For example, if you run a site about cats, and want to have a way for users to ping your site with entries they write about their own cats, you could set up a TrackBack URL like F, then give that URL out on your site. End users could then associate this URL with a I category in their own blog, and ping you whenever they wrote about cats. =item 2. Building block You can use this simple implementation as a building block, or a guide, for implementing TrackBack in your own system. It illustrates the core functionality of the TrackBack framework, onto which you could add bells and whistles (IP banning, password-protected TrackBacks, etc). =item 3. Centralized tool This TrackBack tool requires that the end user have the ability to run CGI scripts on their server. For many users (eg BlogSpot users), this is not an option. For such users, a centralized system (based on this tool, perhaps) would be ideal. =back =cut