#!/usr/local/bin/perl -w use CGI::Carp qw(fatalsToBrowser); # エラーチェック用 #----------------------------------------------------------------------------------------------- # simple env by Lilia [2003/02/05] #----------------------------------------------------------------------------------------------- use strict; use vars qw(%Ini %Prt); %Ini = ( Title => 'simple env', Rev => '0.03d', Dist => 'http://nursery.s8.xrea.com/', # ユーザー設定.. #----------------------------------------------------------------------------------------------- # GMTとの時差 TimeDiff => 9 * 60 * 60, # 日本なら 9 * 60 * 60 # アクセスログ記録 [オプション] AxsRec => 0, # ログを記録する: 1 記録しない: 0 # 記録する場合は下の2行頭の # を消して設定 # LogFile => './envlog.txt', # 記録ファイルのパス（空のファイルをアップロード） # LogMax => 500, # 最大記録件数 # 参照元（Referer）制限 [オプション] # 下のどちらかが設定されていればそれを採用してアクセスを制限（わかる人だけ） # NGRef_RE => qr#(?:1|15|2)ch|bbs(?:2\.jp|pink)|(?:j|machi|mega)bbs|ohayou|ime\.nu|renpou\.com/bbs/#i, # 正規表現：一致するもののアクセスを拒否 OKRef_RE => qr#^http://[^\?]*?(?:$ENV{HTTP_HOST}|nursery|lilia|mizuiro|strange|taiyaki)#i, # 正規表現：一致しないもののアクセスを拒否 # JavaScript等のチェック [オプション] OPTCheck => 0, # チェックする: 1 チェックしない: 0 # xrea.com ユーザー用 [特殊] XreaIns => 0, # xrea.com のバナーを挿入する: 1 挿入しない: 0 # ..ここまで #----------------------------------------------------------------------------------------------- # ファイル名の頭に「nph-」が付いていれば NPHスクリプトとして実行される NPH => ($0 =~ m|\bnph-[^/]+$|i) || 0, # IPアドレスの正規表現 Addr_RE => q/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/, ); &redir if($ENV{QUERY_STRING} && $ENV{QUERY_STRING} =~ s|^url=(https?://)|$1|i); &ctrl if($ENV{HTTP_REFERER} && ($Ini{NGRef_RE} || $Ini{OKRef_RE}) && $ENV{HTTP_REFERER} =~ m#^(?:https?|ftp)://(?!localhost/|127\.0\.0\.1/)#i); ⪯ &log if($Ini{AxsRec}); &html; exit; # サブルーチン #----------------------------------------------------------------------------------------------- sub pre { #--- 下準備みたいな感じ -------------------------------------------------------------- my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time + $Ini{TimeDiff}); $Prt{Date} = sprintf("@{[$year + 1900]}/%02d/%02d(@{[('日','月','火','水','木','金','土')[$wday]]}) %02d:%02d:%02d", $mon + 1,$mday,$hour,$min,$sec); $Prt{Addr} = $ENV{REMOTE_ADDR}; $Prt{Host} = (!$ENV{REMOTE_HOST} || $ENV{REMOTE_HOST} eq $Prt{Addr}) ? (gethostbyaddr(pack('C4', split(/\./, $Prt{Addr})), 2) || $Prt{Addr}) : $ENV{REMOTE_HOST}; ($Prt{RealHost},my $mark) = &getip; $Prt{M_RealHost} = $Prt{RealHost} . $mark; $Prt{Refer} = $ENV{HTTP_REFERER} || 'none'; if($Prt{Refer} ne 'none') { $Prt{Refer} =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg; $Prt{Refer} =~ tr/\015\012<>"/ /; } ($Prt{UAgent} = $ENV{HTTP_USER_AGENT} || '') =~ tr/\015\012<>"/ /; } # pre END sub getip { #--- 漏れを取得 -------------------------------------------------------------------- # ホスト名の形で漏れてるのは見ればわかるから無理して拾わなくてもいいかも my $spill = ($ENV{HTTP_FORWARDED} && $ENV{HTTP_FORWARDED} =~ /.*\s($Ini{Addr_RE})/) ? $1 : ($ENV{HTTP_FORWARDED} && $ENV{HTTP_FORWARDED} =~ /.*\sfor\s([\w\.\-]+)/i) ? $1 : ($ENV{HTTP_FROM} && $ENV{HTTP_FROM} =~ /($Ini{Addr_RE})/) ? $1 : ($ENV{HTTP_FROM} && $ENV{HTTP_FROM} =~ /\-\@([\w\.\-]+)/) ? $1 : ($ENV{HTTP_CLIENT_IP} && $ENV{HTTP_CLIENT_IP} =~ /($Ini{Addr_RE})/) ? $1 : ($ENV{HTTP_CLIENT_IP} && $ENV{HTTP_CLIENT_IP} =~ /^([\dA-F]{2})([\dA-F]{2})([\dA-F]{2})([\dA-F]{2})/i) ? join('.', hex($1),hex($2),hex($3),hex($4)) : ($ENV{HTTP_REMOTE_HOST} && $ENV{HTTP_REMOTE_HOST} =~ /($Ini{Addr_RE})/) ? $1 : ($ENV{HTTP_REMOTE_HOST_WP} && $ENV{HTTP_REMOTE_HOST_WP} =~ /($Ini{Addr_RE})/) ? $1 : ($ENV{HTTP_X_LOCKING} && $ENV{HTTP_X_LOCKING} =~ /($Ini{Addr_RE})/) ? $1 : ($ENV{HTTP_VIA} && $ENV{HTTP_VIA} =~ /.*\s($Ini{Addr_RE})/) ? $1 : $ENV{HTTP_SP_HOST} ? ($ENV{HTTP_SP_HOST} =~ /($Ini{Addr_RE})/) ? $1 : $ENV{HTTP_SP_HOST} : ''; # X_FORWARDED_FOR は別扱い my $xspill = ($ENV{HTTP_X_FORWARDED_FOR} && $ENV{HTTP_X_FORWARDED_FOR} =~ /($Ini{Addr_RE})/) ? $1 : ''; # 漏れを検証 my($t_hostip, $mk) = &look($spill) if($spill); # X_FORWARDED_FOR 以外の漏れを見る my($t_xhostip,$xmk) = &look($xspill) if($xspill); # X_FORWARDED_FOR の漏れを見る # X_FORWARDED_FOR には虚偽の値が入っていることがしばしばあるので 他の漏れを優先する # ただし他が虚偽(△)で X_FORWARDED_FOR の漏れが本物(☆)っぽければそっちが採用される return($t_hostip, $mk) if($t_hostip && $mk eq ' ☆'); # ☆有 X_FORWARDED_FOR 以外の漏れ return($t_xhostip,$xmk) if($t_xhostip && $xmk eq ' ☆'); # ☆有 X_FORWARDED_FOR の漏れ return($t_hostip, $mk) if($t_hostip && $mk ne ' △'); return($t_xhostip,$xmk) if($t_xhostip && $xmk ne ' △'); return($t_hostip, $mk) if($t_hostip); return($t_xhostip,$xmk) if($t_xhostip); return($Prt{Host},''); sub look { #--- IPアドレスであればホストに変換 + 簡単な真偽性チェック ---------------------- my($susp,$doubtmk) = @_; $susp =~ tr/:,;\015\012//d; $susp =~ s/<.*?>//g; if($susp =~ /^$Ini{Addr_RE}$/) { # ローカル or フェイクっぽいアドレスは△印 $doubtmk = ' △' if($susp =~ /^(?:0|10|127|172\.(?:1[6-9]|2[0-9]|3[01])|192\.168|255)\.|\.(?:0|255)$/); $susp = gethostbyaddr(pack('C4', split(/\./, $susp)), 2) || $susp; } # REMOTE_HOST と別でjpドメインなら漏れっぽいので☆印 $doubtmk = ' ☆' if($susp ne $Prt{Host} && $susp =~ /\.jp$/i && !$doubtmk); return($susp,$doubtmk); } # look END } # getip END sub html { #--- HTML出力 ----------------------------------------------------------------------- my($r) = $0 =~ m|([^/]+)$|; # 別に設置したリダイレクタがあるならそれを指定しても可 my $your_real_host = $Prt{M_RealHost}; $your_real_host =~ s/△$/(Local or Fake?)/; $your_real_host =~ s/☆$/(Spill?)/; # ホスト名とそれを含む「あなたのプロバイダ…」 my($shost) = &shrink($Prt{Host}); my($srhost,$your_home) = &shrink($Prt{RealHost}); #「あなたのホスト」で proxy っぽいやつは強調表示（やりすぎかも） my $your_host = $Prt{Host}; if($your_host =~ s#(webcache|delegate|gatekeeper|gateway|firewall|proxy|prox|anonymizer|cache|squid|flow|fire-w.*?\b|^bbs|^http|^www|^w3\b|^host|^dns|^web|^dummy|^prx|^ftp|^mail|^news|^cgi|^gate|^server|^pop|^smtp|^secure|^system|^relay|^serv\b)(\d*)#$1$2#i || $your_host =~ s#\b(dns|anon|ns|sv|fw|dn|gw|cf|fs|wc)(\d*)\b#$1$2#i) {} # 上の方が優先 # おまけ追加 - アノニマイザ系（暫定：変更・削除可）.. elsif($your_host =~ /^209\.114\.223\.1(?:39|40)$/) { $your_host = "$your_host"; $your_real_host.= ' (net HUSH?)'; } elsif($your_host =~ /^64-243-193-9[67]\.wireweb\.net$/) { $your_host = "$your_host"; $your_real_host.= ' (schematic.org?)'; } # ..おまけ追加分ここまで # jpドメインじゃない・数字が含まれていない $your_host = "$your_host" if($your_host !~ /\.jp$/i || $your_host !~ /\d/); # HTTP_CONNECTION に値が無ければ (none) を入れる $ENV{HTTP_CONNECTION} ||= '(none)'; $Ini{Title}.= '+' if($Ini{OPTCheck} == 2); my %color = ( # 基本色設定 # 背景, 文字1, 文字2, リンク（未訪問）, 訪問済みのリンク, 選択中のリンク back => '#d6dadc', text1 => '#333333', text2 => '#666666', link => '#1111af', vlink => '#6666af', alink => '#1111ee', # 強調表示するセル, 強調表示する文字, テーブルの縁 em => '#eaecec', warn => '#993333', border => '#667788' ); my $body = qq(); my $perl_ver = $^V ? (sprintf "%vd", $^V) : $]; (my $perl_info = "Perl@{[`which perl` ? (' ' . `which perl`) : '']} [v$perl_ver]") =~ tr/\015\012//d; # おまけ # xrea.com バナー my $xrea_ad = ($Ini{XreaIns} && $ENV{SERVER_NAME} && $ENV{SERVER_NAME} =~ /xrea\.com/i) ? <<"_XREA_" : '';
# XREA の広告...
 xrea ad banner _XREA_ # バナー消し（参考） my $no_kill_banner = 0; # 自動挿入されるバナーを消したくない場合は 1 に設定 my($css_opt1,$css_opt2) = (!$no_kill_banner && $ENV{SERVER_NAME} && $ENV{SERVER_NAME} =~ /3nopage\.com/i) ? (qq(\ndiv { display:none; }),'') : ('',''); my $noembed = (!$no_kill_banner && $ENV{SERVER_NAME} && $ENV{SERVER_NAME} =~ /(?:virtualave|hypermart)\.net/i && !$Ini{NPH}) ? "\n\n" : ''; my $bodyend = (!$no_kill_banner && $ENV{SERVER_NAME} && $ENV{SERVER_NAME} =~ /dk3\.com/i) ? "\n<noembed><!-- cut -->\n</body>\n<!-- cut -->\n\n" : ''; my $nobanner = ($xrea_ad || (!$no_kill_banner && $ENV{SERVER_NAME} && $ENV{SERVER_NAME} =~ /(?:netfirms|xrea)\.com/i)) ? '' : ''; my($status,$nl) = $Ini{NPH} ? ('HTTP/1.0',"\015\012") : ('Status:',"\012"); # 出力開始 print "$status 200 OK$nl", "Connection: close$nl", "Content-Type: text/html; charset=Shift_JIS$nl", "Content-Language: ja$nl", "Cache-Control: no-cache$nl", "Pragma: no-cache$nl$nl", <<"_HTML_"; $nobanner @{[$Ini{OPTCheck} ? qq(\n) : '']} $Ini{Title} $body $Ini{Title}
# あなたのホスト... $your_host [$your_real_host]
  ANSI Whois Gateway : ホスト ♪@{[($shost ne $srhost) ? qq(~ ) : ' ']}  IPアドレス ♪
BW Whois : ♪@{[($shost ne $srhost) ? qq(~ ) : ' ']} ♪
あなたのプロバイダのホームページ ? ♪
 
# 一般にアクセス・ログとして記録されそうな値...
  [$Prt{Date}] $Prt{Host} ($Prt{M_RealHost}) / $Prt{Addr}
〜 @{[($Prt{Refer} =~ /^http/i) ? qq($Prt{Refer}) : $Prt{Refer}]} - $Prt{UAgent}
 
_HTML_ print "# その他...
\n" if($Ini{OPTCheck}); # 時間のかかる場合があるので先にこれだけ print <<"_OPT_" if($Ini{OPTCheck});
  @{[($Ini{OPTCheck} == 2) ? "SNMP - @{[&snmp($Prt{Addr})]}
" : '']}
 
_OPT_ print qq(
\n\n); foreach my $key (sort keys %ENV) { # 環境変数の一覧表示 if($ENV{$key} eq '') { $ENV{$key} = qq[(none)]; } else { # タグ・改行等の修正（一部のサーバー用） $ENV{$key} =~ tr/\015\012/ /; $ENV{$key} =~ s/&/&/g; $ENV{$key} =~ s//>/g; $ENV{$key} =~ s/"/"/g; } if($key =~ /^HTTP_/) { # HTTP_XXXXXX の表示について if($key eq 'HTTP_ACCEPT' || $key eq 'HTTP_ACCEPT_CHARSET' || $key eq 'HTTP_ACCEPT_ENCODING' || $key eq 'HTTP_ACCEPT_LANGUAGE' || $key eq 'HTTP_COOKIE' || $key eq 'HTTP_IF_MODIFIED_SINCE' || $key eq 'HTTP_HOST' || $key eq 'HTTP_PRAGMA' || $key eq 'HTTP_UA_COLOR' || $key eq 'HTTP_UA_CPU' || $key eq 'HTTP_UA_OS' || $key eq 'HTTP_UA_PIXELS') { # 以上はそのまま表示 # ), qq(\n); } elsif($key eq 'HTTP_REFERER') { # HTTP_REFERER はアンダーライン付きリンク（$Prt{Refer} にはしない） print qq(), qq(\n); } elsif($key eq 'HTTP_USER_AGENT') { # HTTP_USER_AGENT は部分的に文字強調 $ENV{$key} =~ s%(\b(anon.*?\b|Turing|via\b)|BBS Write|D-Engine|DidYouSeeAnElephant|dummy|(gate|gateway)\b|libwww-perl|Microsoft URL Control|proxy|\S*Surf|\Snonymouse)%$1%ig; print qq(), qq(\n); } elsif($key eq 'HTTP_CONNECTION') { # HTTP_CONNECTION は Keep-Alive 以外をセル＆文字強調 if($ENV{$key} =~ /^Keep-Alive$/i) { # Keep-Alive だったらそのまま表示 print qq(), qq(\n); } else { # それ以外は強調表示 print qq(), qq(\n); } } elsif($key eq 'HTTP_SEPHIRA') { # Gabrienai *old print qq(), qq(\n); } else { # 他の HTTP_XXXXXX はセル＆文字強調 print qq(), qq(\n); } } elsif($key =~ /^REMOTE_/) { # REMOTE_XXXXXX はセル強調 print qq(), qq(\n); } else { # 他はそのまま表示 print qq(), qq(\n); } } my $copy = qq{
\n*script by <@{[$Ini{Dist} ? qq(a href="$Ini{Dist}") : 'span']} class="tlink" title="〜☆">Lilia (*'-')~ v$Ini{Rev}}; print "
は としてもいいが 旧い Netscape での見映えのためにこうしておく print qq(
 $key  $ENV{$key} 
 $key  $ENV{$key} 
 $key  $ENV{$key} 
 $key  $ENV{$key} 
 $key  $ENV{$key} 
 $key  $ENV{$key}   # Gabrienai 
 $key  $ENV{$key} 
 $key  $ENV{$key} 
 $key  $ENV{$key} 
\n$xrea_ad$copy\n$bodyend\n\n$noembed"; sub shrink { #--- ホスト名の頭を切る + URL化 ----------------------------------------------- my($obj,$url) = @_; $obj =~ s/\W+$//; if($obj !~ /^$Ini{Addr_RE}$/) { # "[\w\-]+" でなく "[^\.]+" としたのは日本語url対策のつもり if($obj =~ /([^\.]+)\.(com|net|org|edu|gov|int|mil|web|nom|rec|arpa|nato|firm|store|arts|info)(\.\w{2})?$/i) { $obj = "$1.$2" . ($3 ? $3 : ''); # xxx.com, xxxx.com.br など } elsif($obj =~ /([^\.]{3,})\.(\w{2})$/i) { $obj = "$1.$2"; # xxx.fr, xxx.nu など } elsif($obj =~ /([^\.]+)\.([^\.]+)\.(\w+)$/) { $obj = "$1.$2.$3"; # xxx.ne.jp, xxx.co.uk その他多数 } # もっと厳密にもできるけどこんな感じでいいと思う $url = "http://www.$obj/"; } else { $url = "http://$obj/"; } return($obj,$url); } # look END } # html END sub redir { #--- リダイレクト ------------------------------------------------------------------ my($self) = $0 =~ m|([^/]+)$|; return if($ENV{QUERY_STRING} =~ /\b\Q$self\E\b/i); # 二重呼出し return if($ENV{HTTP_REFERER} && $ENV{HTTP_REFERER} !~ m|^http://\Q$ENV{HTTP_HOST}\E\b|i); # 不正な呼出し元 $ENV{QUERY_STRING} =~ tr/\r\n"<> //d; my($status,$nl) = $Ini{NPH} ? ('HTTP/1.0',"\015\012") : ('Status:',"\012"); print "$status 200 OK$nl", "Connection: close$nl", "Content-Type: text/html; charset=Shift_JIS$nl$nl", qq(\n\n\n), "redirect\n\n\njust a sec...\n\n\n\n"; exit; } # redir END # オプション #----------------------------------------------------------------------------------------------- sub log { #--- アクセスログ記録 [削除可] ------------------------------------------------------- open(LOG, "$Ini{LogFile}"); chomp(my @lines = <LOG>); close(LOG); $#lines = $Ini{LogMax} - 2 if($Ini{LogMax} <= @lines); open(LOG, ">$Ini{LogFile}"); print LOG "[$Prt{Date}] $Prt{Host} ($Prt{M_RealHost}) / $Prt{Addr} 〜 $Prt{Refer} - $Prt{UAgent}\n"; print LOG "$_\n" foreach(@lines); close(LOG); } # log END sub ctrl { #--- 参照元（Referer）制限 [削除可] ------------------------------------------------- if(($Ini{NGRef_RE} && $ENV{HTTP_REFERER} =~ /$Ini{NGRef_RE}/) || ($Ini{OKRef_RE} && $ENV{HTTP_REFERER} !~ /$Ini{OKRef_RE}/)) { my($status,$nl) = $Ini{NPH} ? ('HTTP/1.0',"\015\012") : ('Status:',"\012"); print "$status 503 Service Unavailable$nl", "Retry-After: 3600$nl", "Connection: close$nl", "Content-Type: text/html$nl$nl", # あまり刺激しないように <<"_ERR_"; # サーバーに合わせて編集可 <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN"> <HTML><HEAD> <TITLE>503 Service Unavailable</TITLE> </HEAD><BODY> <H1>503 Service Unavailable</H1> The server is temporarily unable to service your request due to maintenance downtime or capacity problems.<P> Please try again later.<P> </BODY></HTML> _ERR_ exit; } } # ctrl END sub snmp { #--- SNMPチェック [削除可] ---------------------------------------------------------- #* $Ini{OPTCheck} == 2 の場合のみ行う（無料サーバーの大部分では不能） use Socket; local $| = 1; local(*SOCKET); my $chkhost = shift; my($retry,$timeout,$port,$count,$data,$raddr) = (3,2,161,1,'',''); my $packet = pack('C*', 0x30,0x27, # length 0x27 = 39 0x02,0x01,0x00, # version 0x00 = 0 0x04,0x06,0x70,0x75,0x62,0x6c,0x69,0x63, # community name "public" 0xa1,0x1a, # get_next_request 0x02,0x01,0x01, # request_id 0x01 0x02,0x01,0x00,0x02,0x01,0x00, # no error 0x30,0x0f, # length 0x0f = 15 0x30,0x0d, # length 0x0d = 13 0x06,0x09,0x2b,0x06,0x01,0x02,0x01,0x06,0x0d,0x01,0x04, # tcpConnRemAddress 1.3.6.1.2.1.6.13.1.4 0x05,0x00 # null pudding ); my $chkaddr = inet_aton($chkhost) || return "invalid host: $chkhost"; my $paddr = sockaddr_in($port, $chkaddr); my $proto = getprotobyname('udp'); socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || return "socket error: $!"; connect(SOCKET, $paddr) || return "connect error: $!"; while(1) { send(SOCKET, $packet, 0) || return "send error: $!"; my $rin = ''; vec($rin, fileno(SOCKET), 1) = 1; my $found_no = select($rin, undef, undef, $timeout); if($found_no == 1) { $raddr = recv(SOCKET, $data, 128, 0); close(SOCKET); return "closed: $count time(s)" if($raddr eq ''); return "<b>open</b>: $count time(s)"; # else } if($count >= $retry) { close(SOCKET); return "invalid community name: $count times"; } $count++; } } # snmp END # 参考 #----------------------------------------------------------------------------------------------- # Force 264, PRX4EVER, たるおのうたたね部屋, Grand Cru, とくめいアクセス 他 # & special thanks to << Team MIZUIRO >> # Script END