#!/usr/bin/perl
#
$ver = "0.04" ;
use LWP::UserAgent ;
use HTTP::Request ;
$response_body = "body" ;
$coder = "code" ;
$base = "base" ;
$| = 1 ;
my $ua = new LWP::UserAgent ;
$ua->agent ("kakiko.com check 0.02") ;
$ua->from ("check\@kakiko.com") ;
$ua->timeout (90) ;
##############################################################################
$f0 = "" ;
$f9 = "" ;
$url = $ENV{'QUERY_STRING'} ;
$url =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$url =~ s/^url=// ;
$urlx = $url ;
$urlx =~ s|(mugi)|$f0$1$f9|gi ;
##############################################################################
&getDoc($url) ;
$base =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$basex = $base ;
$basex =~ s|(\/con)|$f0$1$f9|gi ;
$basex =~ s|(file:\/+)|$f0$1$f9|gi ;
$baseb = $url ;
if($base ne '') {$baseb = $base} ;
$baseb =~ s/[0-9a-zA-Z_.\-\~]+$//gi ;
##############################################################################
$body = $response_body ;
$body =~ s//>/gi ;
$body =~ s/\n/
\n/gi ;
$body =~ s|(mugi)|$f0$1$f9|gi ;
$body =~ s|(\/con)|$f0$1$f9|gi ;
$body =~ s|(file:\/+)|$f0$1$f9|gi ;
$body =~ s|(mailto:)|$f0$1$f9|gi ;
# frame,refresh 等のリンクを追っかける
$body =~ s|src=\"([0-9a-zA-Z_.\/\-\~]+)\"|src=\"$baseb$1<\/A>\"|gi ;
$body =~ s|url=([0-9a-zA-Z_.:\/\-\~]+)|url=$1<\/A>|gi ;
##############################################################################
print "Content-type: text/html\n\n" ;
print <
飛び先のチェック by ぴょん基地の友達
飛び先のチェック (ver $ver) by ぴょん基地の友達
解析
飛び先のURL
$urlx
code = $coder
base = $basex
body =
$body