#!/usr/local/bin/perl # Copyright 2002 Benjamin Trott. # This code is released under the Artistic License. # tb for nicky ver 20080209 use strict; my $Charset = 'euc-jp'; my $DataDir = "./tbdir"; my $RSSDir = "./rssdir"; my $tbpath = "./tb.cgi"; my $Pkey = "0628"; my $TrackbackUrl = './'; my $vDir = '.'; my $SPMRCV = "OFF"; 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{'HTTP_HOST'}, $ENV{'HTTP_ADDR'}, $url); my $hlen=$excerpt; if( $rej && (((($title !~ /\xA4[\xA1-\xF3]/) && ($excerpt !~/\xA4[\xA1-\xF3]/)) || ($excerpt =~ /test.com/)) || (5 < ($hlen=~s/[a-z]//gi)) || (10 > length($excerpt))) ){ $rej = 0; } my $len=length($excerpt); my $jlen=($hlen=~s/[a-z]//gi); open(WD, ">./junk.log"); print WD "[$excerpt], len=$len, jlen=$jlen, rej=$rej\n"; close WD; if( $rej ) { add_data($tb_id, $title, $excerpt, $blog_name, $url, time, $ENV{'HTTP_HOST'}, $ENV{'HTTP_ADDR'}); make_nicky_log($tb_id); send_email($tb_id, $sendmail_path, $mail_address, $url, $rej); respond_exit(); } else { eval('require("./nicky.cgi")'); unless( $@ ){ ReadSetup(); initial2nd(); if( $SPMRCV ne "OFF" ){ send_email($tb_id, $sendmail_path, $mail_address, $url, $rej); } } } 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("./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!It is a list that seems for the spam data to be included it.
The spam data is deleted when clicking.
\n"; if( opendir(RDD, "./tbdir/") ){ for $fname( readdir(RDD) ){ if( $fname =~ /^[1-9][0-9][0-9][0-9][0-1][0-9]\.cgi$/ ){ $alldat=""; if( open(RD, "tbdir/$fname") ){ binmode RD; while(