#!/usr/bin/perl -w
#--------------------------------------------------------------------------------------------------------
# redirect'r by Lilia [2006-05-17]
#--------------------------------------------------------------------------------------------------------
# 単なるリダイレクタ
# 下記のようにして呼出すだけ
# 例:
# http://your.host.com/go.cgi?http://target.com/foo.html * リダイレクト先のURLそのまま
# http://your.host.com/go.cgi?url=http://target.com/foo.html * url=...
# http://your.host.com/go.cgi?target.com/foo.html * http:// 省略
# http://your.host.com/go.cgi?http//target.com/foo.html * : 省略
# http://your.host.com/go.cgi?http://target.com/foo.html%%section * # はそのままでは無効なので %% で代用
# http://your.host.com/go.cgi?...foo.html * $base_url 部分を "..." で省略
# 必要なら以下にも目を通して設定
#use strict;
my($self) = $0 =~ m|([^/\\ \?]+)(?:\?.*)?$|; # スクリプト名は自動取得するので変更しても大丈夫
my $base_url = '';
&error unless($ENV{QUERY_STRING}); # 直接呼出し
&error if($ENV{QUERY_STRING} =~ /\b\Q$self\E\b/i); # 二重呼出し
# 参照元制限..
my @restricted = ( # ここで設定する参照元(Referer)以外は拒否
$ENV{HTTP_HOST}, # 同一アカウントに置く場合はたいていこれだけでOK
# qw(http://your.host.com friend.org strange) # それ以外はスペースで区切って部分指定
);
if(@restricted && $ENV{HTTP_REFERER}) {
for(@restricted) { undef(@restricted), last if($ENV{HTTP_REFERER} =~ /\Q$_\E/i); }
&error if(@restricted);
}
# ..ここまで
# 参考: 参照元制限 正規表現版(わかるなら上の配列版をコメントアウトしてこっちをつかってもいいかも)..
#my $good_referer = qr%^http://[^\?]*?(?:\Q$ENV{HTTP_HOST}\E|friend\.org|strange)%i;
#&error if(defined $good_referer && $ENV{HTTP_REFERER} && $ENV{HTTP_REFERER} !~ /$good_referer/);
# ..ここまで
# ベースURL(リダイレクト先URLが "..." で始まっている場合、このURLで補完する)
#$base_url = 'http://target.com/';
my $s_mark = '%%'; # 変更する場合は問題がないように注意
my $url = $ENV{QUERY_STRING};
$url =~ tr/\r\n\f\t//d;
$url =~ s/\s+$//;
$url =~ s/^\s+//;
$url =~ s/^url=//i;
$url =~ s/^(.*)$s_mark/$1#/; # "#" にもどす(最後の一個だけ)
$url =~ s%^\.\.\.%$base_url% if($base_url);
$url =~ s%^([^\.:/]+)(?=//)%$1:%;
$url = "http://$url" unless($url =~ m%^[^:/]+://%);
$url =~ s/(["'<>])/'%' . uc(unpack('H2', $1))/eg; # for safety
(my $url_escaped = $url) =~ tr/ /+/;
# あとはお好みで
print qq`Content-Type: text/html\n\n`,
qq`
redirection
<![CDATA[<!-- remove this line -->
`;
exit;
sub error {
print "Content-Type: text/plain\n\n", 'ERROR!'; # or 'text/html' for buggy UA
exit;
}
# Script END
]]>