#! /usr/bin/perl # ============================================================== # ITGear Analyzer - リダイレクトCGI # created 2003/01/21 irokawa # modified 2004/03/01 irokawa # -- # jump呼び出しページのリファラの扱い # Location: 渡る # redirection: 渡らない(META) i-mode未対応 # ============================================================== use strict; my $http_URL_regex = q{\b(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f} . q{][0-9A-Fa-f])*@)?(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)} . q{*[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.} . q{[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f]} . q{[0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-} . q{Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f} . q{])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)} . q{*)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])} . q{*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} . q{)?}; my $query = $ENV{QUERY_STRING}; if ($query && $query =~ /^$http_URL_regex/) { redirection($query) } else { my $i = $ENV{HTTP_USER_AGENT} =~ /^DoCoMo|UP\.Browser|^J-PHONE|DDIPOCKET|^PDXGW|^ASTEL|^L-mode/ ? 'i/' : ''; print "Location: http://ax.itgear.jp/$i\n\n"; } sub redirection { my $url = chr2ref(shift); print < Redirection 自動的にジャンプしない場合はこちらをクリックして下さい。
$url
EOH } sub chr2ref { local($_) = @_; s/&/&/g; s//>/g; s/"/"/g; tr/\r/\n/ if $_[1]; $_; } __END__