#!/usr/bin/perl # #AutoProxyChecker1.0 # #ﾇｱﾇﾃﾉXﾉNﾉ菲vﾉgﾇﾕﾅA #Proxyﾇ宣vﾇﾌﾇﾍﾇﾈﾉzﾉXﾉgﾇ菩ｸﾇ�ﾇﾍﾇ�ﾇﾁﾅA #臚ﾉzﾉXﾉgﾇ危舵ｵﾇ淤|ﾅ[ﾉg8080/3128/80ﾇﾃ鞦ﾇ雁�鄂ﾇ�ﾇﾈﾇﾇﾃﾇ寡�ﾅB #�貮ﾁﾇﾍﾇ�裙笄ﾇ頁A馮筮/�s筮ﾇﾃﾉtﾉ@ﾉCﾉ翩翫Lﾇｵﾇﾐﾇ�ﾅB #猩�x襞鄂ﾇｵﾇ�ﾉzﾉXﾉgﾇ管ｬﾇ｢ﾇ淺ﾕﾅA遏襞鄂ﾇｵﾇﾐﾇｼﾇﾒﾅB # #GETﾇ�ﾇﾈﾉtﾉ@ﾉCﾉ翩管ﾕﾅA�t�ﾆﾇﾃpenv.cgiﾇ♭ｫﾇ｢ﾇ寡�ﾅB(ﾉXﾉNﾉ菲vﾉg猩諟竊) # #socketﾇﾃ馮ﾇｶﾇｻﾇ｢ﾉTﾅ[ﾉoﾇ管ﾕ�uﾇ寡ｴﾇﾐﾇｼﾇﾒﾅB #lockﾉfﾉBﾉ衙Nﾉgﾉ�(777)ﾇ宝pﾇｵﾇ滔�鐡絲�ﾆﾇ輔~ﾇｵﾇ淺｢ﾇﾐﾇ�ﾅB $|=1; #perlﾇ緩fﾅ[ﾉ^ﾇﾃﾉoﾉbﾉtﾉ@ﾅ[ﾇ管�ﾇﾇ�ﾇｼﾇｻﾇ｢ $cginame='nph-prox.cgi'; $method = 'POST'; $title = 'AutoProxyChecker'; $body=''; $checkmax =30;#猩�xﾇ緩`ﾉFﾉbﾉNﾇ�ﾇﾈ迚�ﾂﾉTﾅ[ﾉo�� $timeout = 15;#15�b芟ﾇ烏ETﾇ寡ｴﾇｻﾇｩﾇ｡ﾇ�ﾇﾁﾅA馮�s筮 $new_file = './log.dat';#襞迸ﾇｵﾇ�ﾇ｢ﾉtﾉ@ﾉCﾉ�(666) $deny_file = './deny.dat';#馮�s筮ﾇ隻ｻﾇ｡ﾇ�ﾉzﾉXﾉgﾇﾃﾉtﾉ@ﾉCﾉ�(666) $allow_file = './allow.dat';#馮筮ﾇ隻ｻﾇ｡ﾇ�ﾉzﾉXﾉgﾇﾃﾉtﾉ@ﾉCﾉ�(666) $host = 'www.xxx.or.jp';#ﾇｱﾇﾃﾉXﾉNﾉ菲vﾉgﾇ母uﾇ�ﾇﾈﾉzﾉXﾉgﾅB $ip = '130.55.32.114';#ﾇｱﾇﾃﾉXﾉNﾉ菲vﾉgﾇ母uﾇ�ﾇﾈﾉzﾉXﾉgﾇﾃIPﾉAﾉhﾉ衙XﾅB $uri='http://www.zzz.or.jp/~zzz/penv.cgi';#GETﾇ�ﾇﾈURL(ﾇ寡ｴﾇﾍﾇ滝uﾉTﾉCﾉgﾇ撰ﾇ♭ｫﾇ｢ﾅB) ## print "HTTP/1.0 200 OK\n";#nph-xxx.cgiﾇ寡ﾕ�K &jikan;#鵆芟ﾇ母ﾟ蠢ﾇ�ﾇﾈﾇﾇﾃﾅB &lock;#��鐡絲�ﾆﾇ輔~ﾇ�ﾇﾈﾇ�ﾇﾇﾃﾉ酲bﾉN紂軆 &decode; &html if($buffer eq '');#�ｸﾇ暇tﾉHﾅ[ﾉﾄ簗 &html unless( ($ENV{'HTTP_REFERER'} eq '') || ($ENV{'HTTP_REFERER'} =~/$cginame/));#�s黻ﾉAﾉNﾉZﾉXﾅHﾅH if ($] >= 5.0) { # socket ﾇ壁ｬﾇｩﾇｧﾇｮﾇﾐﾇ症ｻﾇ｢ eval 'use Socket'; } else { eval 'require "sys/socket.ph"'; } #$printall = '0';#GETﾇ�ﾇﾍﾇ淺ｴﾇ��ﾇ壁�ﾇﾗﾇ滂\鮓ﾇ�ﾇﾈﾇｩﾇｫﾇｧﾇｩﾅB $Referer = 'http://www.goo.ne.jp/'; $From = ''; $machine='';$port=''; $cmd = "GET $uri HTTP/1.0\r\n"; $cmd .= "User-Agent: Mozilla/4.04; (Neko/98; G3)\r\n"; $cmd .= "Pragma: no-cache\r\n"; $cmd .= "Referer: $Referer\r\n" if $Referer; $cmd .= "From: $From\r\n" if $From; $cmd .= "Accept: */*\r\n"; $cmd .= "\r\n"; &mainprog; &ended(); ################################### sub mainprog{ print "Content-type: text/html\n\n"; print <<"_HTML_"; $title $body $title
[�ｸ][馮筮][馮�s筮][ﾉ`ﾉFﾉbﾉN汯]
_HTML_ &readlog unless(@lines);#襞迸ﾉ菲Xﾉgﾇ鼻linesﾇ喜ｫﾇ鉎� &readlog2;#襞迸遖ﾇ�(馮筮)ﾇ鼻lines2ﾇ喜ｫﾇ鉎� &readlog3;#襞迸遖ﾇ�(馮�s筮)ﾇ鼻lines3ﾇ喜ｫﾇ鉎� #�肓ﾇﾃ襞迸絖ﾇ緩}ﾉbﾉ`ﾇ�ﾇﾈﾉzﾉXﾉgﾇﾕ顫膂ﾇ�ﾇﾈﾅB unless($retry){ foreach $line3(@lines3){ $test=$line3;$test=~s/\n//g;($test, $value) = split(/:/,$test); $NOCHECK{$test}='deny'; } foreach $line2(@lines2){ $test=$line2;$test=~s/\n//g;($test, $value,$x) = split(/:/,$test); $NOCHECK{$test}="$value:$x"; } } foreach $line(@lines){ $line=~s/\n//g; if($NOCHECK{$line}){ print "ﾅ�$line:$NOCHECK{$line}
\n"; }else{ $CHECK{$line}='1'; } } print "
\n"; undef @lines; undef @proxy; foreach (sort keys %CHECK){ push(@lines,"$_\n") if(length($_)>4); print "$_
\n"; } if(scalar(@lines)>$checkmax){ print '
ﾇ�ﾇﾐﾇｼﾇﾒﾅBﾉ`ﾉFﾉbﾉNﾇ�ﾇﾈﾉTﾅ[ﾉoﾇﾃ�鏞募ｽﾇﾁﾇｵﾇ淺ど貮�ﾇ｢ﾅB
'; &ended(); } if(scalar(@lines)== 0){ print '鷏絳ﾇｻﾉTﾅ[ﾉoﾇ∝ｩﾇ ﾇ�ﾇﾋﾇﾐﾇｼﾇﾒ...
'; &ended(); } &writelog;#鷏絳ﾇﾃﾉ菲Xﾉg@linesﾇ戊�ﾇｴ鍄ﾇ� print "ﾉTﾅ[ﾉoﾉ菲Xﾉgﾇ慕ﾏ�ｨﾇｵﾇﾐﾇｵﾇ�
�]糲:
\n"; foreach $line(@lines){ next if(length($line)<3); print "\n$line
"; $line=~s/\n//g; #ﾉ`ﾉFﾉbﾉN汯ﾇ器帝~ﾇｵﾇ�靉釿ﾅA$deny_fileﾇ劃heckingﾇ隻ｵﾇ溘Lﾇｵﾇ淺ｮﾇでB #渹犂ﾅF遏絲�ﾆﾇｵﾇ�鵆ﾅAchecking鞆�孤寡 ﾇ｡ﾇ�ﾉzﾉXﾉgﾇﾕ遏ﾉ`ﾉFﾉbﾉNﾇ�ﾇﾍﾇﾐﾇｼﾇﾒﾅB open(LOG,">>$deny_file") || &ended('$deny_file write error'); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG "$line:checking\n"; eval 'flock(LOG,8);'; close(LOG); if($line=~/:/){#ﾉ|ﾅ[ﾉg駢棏ﾇ�ﾇ ﾇﾍﾇ打Aﾇｪﾇﾃﾇ､ﾅ[ﾇ隻ﾃﾇ�鄂ﾇ�ﾇﾈﾅB ($line, $port) = split(/:/,$line); next if($port=~/\D/); $result=eval{ &hostcheck($line, $port);};$result='timeout' if $@; $end=&results($line,$port,$result); next if($end eq 'nxt'); }else{ $port='8080';#鳬ﾇﾈﾉ|ﾅ[ﾉg諟釛 $result=eval{ &hostcheck($line, $port);}; $result='timeout' if $@;#timeoutﾇｵﾇ�靉釿ﾅA闢ﾇﾃevalﾇ‥ieﾇ�ﾇﾈﾇﾃﾇ嫁A$@ﾇ�薰齒ﾅB $end=&results($line,$port,$result);#$resultﾇﾃ�ﾇ管ﾊﾇ｡ﾇ淒Aﾉtﾉ@ﾉCﾉ肛�ﾇｴ鍄ﾇE鵈ﾇﾃ鞨ﾇ募瑙ﾋﾇ�ﾇﾈﾅB next if($end eq 'nxt'); $port='3128'; $result=eval{ &hostcheck($line, $port);};$result='timeout' if $@; $end=&results($line,$port,$result); next if($end eq 'nxt'); $port='80'; $result=eval{ &hostcheck($line, $port);};$result='timeout' if $@; $end=&results($line,$port,$result); next if($end eq 'nxt'); } #8080/3128/80ﾇ ﾇﾈﾇ｢ﾇﾕﾅA獷犂ﾇﾃﾉ|ﾅ[ﾉgﾇ蛾ｽ罇 print "$line:$port:$result 膂�鏞ｩﾇﾁ馮ﾇｶﾇﾐﾇｼﾇﾒﾅB
\n"; open(LOG,">$deny_file") || &ended('$deny_file write error'); push(@lines3,"$line:$result\n"); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG @lines3; eval 'flock(LOG,8);'; close(LOG);next; }#foreach #ﾇ�ﾇﾗﾇ淺ﾃﾉ`ﾉFﾉbﾉN鍼蜩ﾅA$new_fileﾇ戊粭吮ｪ open(LOG,">$new_file") || &ended('$allow_file write error'); close(LOG); open(LOG,">$deny_file") || &ended('$deny_file write error'); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG @lines3; eval 'flock(LOG,8);'; close(LOG); print "
裙笄:
" if(@proxy); print @proxy; print "
鍼ﾇｵﾇﾐﾇｵﾇ�...\n\n"; &ended(); }#mainprog ################################### sub results{ local($line,$port,$result) = @_; print "$line:$port:$result
\n" if($printsome); if($result eq 'use'){ print "$line:$port:膂�鏞ｩﾇﾁ馮ﾇｶﾇﾐﾇ�ﾅB
\n"; push(@proxy,"$line:$port:
"); open(LOG,">>$allow_file") || &ended('$allow_file write error'); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG "$line:$port\n"; eval 'flock(LOG,8);'; close(LOG);return "nxt"; }elsif($result eq 'use-mole'){ print "$line:$port:膂�鏞ｩﾇﾁ馮ﾇｶﾇﾐﾇ�ﾇ�ﾅAIPﾇ菩`ﾇｶﾇ淺｢ﾇﾐﾇ�ﾅB
\n"; push(@proxy,"$line:$port:X
"); open(LOG,">>$allow_file") || &ended('$allow_file write error'); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG "$line:$port:X\n";#ﾇﾍﾇ�ﾇ ﾇﾍﾇ打A:Xﾇ包t筍ﾇ�ﾇﾈﾅB eval 'flock(LOG,8);'; close(LOG);return "nxt"; }elsif($result eq 'forbid'){ print "$line:$port:膂�鏞ｩﾇﾁﾇﾕ胱驃ﾇ�ﾇﾍﾇ淺｢ﾇﾐﾇ�ﾅB
\n"; open(LOG,">$deny_file") || &ended('$deny_file write error'); push(@lines3,"$line:$result\n"); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG @lines3; eval 'flock(LOG,8);'; close(LOG);return "nxt"; }elsif($result eq 'no'){ print "$line:$port:膂�鏞ｩﾇﾁ糺�ｵﾇﾐﾇｼﾇﾒﾅB
\n"; open(LOG,">$deny_file") || &ended('$deny_file write error'); push(@lines3,"$line:$result\n"); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG @lines3; eval 'flock(LOG,8);'; close(LOG);return "nxt"; }elsif($result=~/BadHostname/){ print "$line:$port:ﾉzﾉXﾉgﾉGﾉ簀[(IPﾉAﾉhﾉ衙Xﾇ餓ｸﾇﾍ晗ﾇ�ﾇ浅ｫﾇ｢ﾇ寡�ﾅB)
\n"; open(LOG,">$deny_file") || &ended('$deny_file write error'); push(@lines3,"$line:$result\n"); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG @lines3; eval 'flock(LOG,8);'; close(LOG);return "nxt"; }elsif($result eq 'timeout'){ print "$line:$port:ﾉ^ﾉCﾉﾄﾉAﾉEﾉgﾇｵﾇﾐﾇｵﾇ�ﾅB
\n"; open(LOG,">$deny_file") || &ended('$deny_file write error'); push(@lines3,"$line:$result\n"); eval 'flock(LOG,2);'; seek(LOG,0,0); print LOG @lines3; eval 'flock(LOG,8);'; close(LOG);return "nxt"; } return "moreport";# }#results ################################### sub hostcheck{ local($machine, $port) = @_; local($content, $mole,$buf); $connect=&connect_socket($machine, $port); if($connect ne 'OK'){#齊�ｱ�s print "$machine:$port:$connect\n
" if ($printall); return $connect; } $content=''; $mole='';$forbid=''; print S $cmd; while ($buf = ) { print "$buf
" if ($printall); $content='1' if($buf=~/kusi-ok-desu/);#penv.cgiﾇ贋ﾐﾇﾐﾇﾍﾇﾈ�｡�ﾇｻ�城ﾒﾇ�ﾇ ﾇﾍﾇ賎ET�ｨ蝸 $mole='1' if($buf=~/$ip/);#ﾇｱﾇﾃﾉXﾉNﾉ菲vﾉgﾇ菩ﾆﾇｩﾇ�IPﾉAﾉhﾉ衙Xﾇ�ﾇ ﾇﾍﾇ打Aﾇﾍﾇ淺｢ﾇﾈ $mole='1' if($buf=~/$host/ && $uri!~/$host/);#ﾉzﾉXﾉgﾇﾃ靉釿ﾇﾅB $forbid='1' if($buf=~/forbidden/i); $forbid='1' if($buf=~/Access.*Denied/i); } close(S); shutdown(S, 2) if !eof(S); # 齊�ｱ�凬?? $SIG{'ALRM'} = 'IGNORE';#ﾉAﾉ簀[ﾉﾄﾇ‰ｬﾇ｡ﾇ淺鱚ﾇ�ﾇｼﾇﾈ alarm(0);#timeoutﾉAﾉ簀[ﾉﾄﾇ倣帝~ﾇ�ﾇﾈﾅB if($content && $mole){ return "use-mole";#馮筮砡ﾇ貮！Pﾇ菩`ﾇｶﾇﾈ }elsif($content){ return "use";#馮筮砡ﾇ迂Pﾇ菩`ﾇｶﾇｻﾇ｢ }elsif($forbid){ return "forbid";#黻ﾇｵﾇゅ~�ﾋﾇ�ﾇﾍﾇ淺｢ﾇﾈ }else{ return "no";#馮ﾇｶﾇｻﾇ｢ﾅHﾅHﾅH } }#hostcheck ################################### sub connect_socket { my($machine, $port) = @_; my($sockaddr) = 'S n a4 x8'; eval '$Inet = &AF_INET' || ($Inet = 2); eval '$Stream = &SOCK_STREAM' || ($Stream = 1); chop($localhost = `hostname`); my($name, $aliases, $proto) = getprotobyname('tcp'); my($name, $aliases, $type, $len, $localaddr) = gethostbyname($localhost); #my($name, $aliases, $type, $len, $remaddr) = gethostbyname($machine); if ($machine =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) { $remaddr = pack('C4', $1, $2, $3, $4); } else { local(@temp) = gethostbyname($machine); unless (@temp) { return "BadHostname";#ﾉzﾉXﾉgﾇｩﾇﾁIPﾇ∬oﾇｼﾇｻﾇ｢靉釿ﾅB } $remaddr = $temp[4]; } my($local_pack) = pack($sockaddr, $Inet, 0, $localaddr); my($remote_pack) = pack($sockaddr, $Inet, $port, $remaddr); socket(S, $Inet, $Stream, $proto) || return "Socket: $!"; bind(S, $local_pack) || return "Bind: $!"; $SIG{'ALRM'} = 'timed_out';#ﾉAﾉ簀[ﾉﾄﾇ‰ｬﾇ｡ﾇ�ﾇ隻ｴﾇﾃ鞨ﾇ母ﾋ alarm($timeout);#$timeout�b蜩ﾇ緩Aﾉ簀[ﾉﾄﾇ報ｬﾇﾁﾇ�ﾅB #$timeout�b狃�ﾇ看A鞨ﾇ�ﾇ寡ｴﾇｻﾇ｢ﾉzﾉXﾉgﾇﾕ馮ﾇｶﾇｻﾇ｢ﾇ隻ｻﾇ�ﾅB connect(S, $remote_pack) || return "Connect: $!"; alarm($timeout); select(S); $| = 1; select(STDOUT); return "OK"; } ################################### sub readlog{ #菶@linesﾇ緩酲Oﾇ菩ｫﾇ鉎ﾞ open(DB,"$new_file") || &ended('$new_file open error'); seek(DB,0,0); @lines = ; close(DB); }#readlog sub writelog{ #菶@linesﾇ碧酲Oﾇ願�ﾇｴ鍄ﾇﾞ open(DB,">$new_file") || &ended('$new_file write error'); seek(DB,0,0); print DB @lines; close(DB); }#readlog sub readlog2{ #菶@lines2ﾇ蛎llowﾉ酲Oﾇ菩ｫﾇ鉎ﾞ open(DB,"$allow_file") || &ended('$allow_file open error'); seek(DB,0,0); @lines2 = ; close(DB); }#readlog sub readlog3{ #菶@lines3ﾇ嚇enyﾉ酲Oﾇ菩ｫﾇ鉎ﾞ open(DB,"$deny_file") || &ended('$deny_file open error'); seek(DB,0,0); @lines3 = ; close(DB); }#readlog3 sub ended{ #ﾉGﾉ簀[ﾉgﾉ篷bﾉvﾇ親xitﾇ慕sﾇｧﾇ�ﾇﾇ貮ﾘﾇﾃﾇﾇﾃﾅB unlink($lockfile);#ﾉ酲bﾉNﾉtﾉ@ﾉCﾉ翩暮gﾇ�ﾇﾈﾇｻﾇﾁﾅA#ﾇ戊｡ﾇ�ﾅB print "\n\n $_[0] \n"if($_[0]);#ﾇｱﾇﾃ輳ﾇﾕ醂顫筮ﾇ寡�ﾅB exit; }#ended sub timed_out { local($sig) = @_; die "\nConnection timed out. (SIG$sig)\n"; }#timed_out sub html { print "Content-type: text/html\n\n"; print <<"_HTML_"; $title $body
$title
[馮筮][馮�s筮][ﾉ`ﾉFﾉbﾉN汯]

馮阨裴

ﾇｱﾇﾃproxy checkﾇﾕ鰉螫麝ﾇ！nternetﾉﾜﾅ[ﾉUﾇ癌ｻ竊ﾇﾃ阨裴ﾇﾃ竊ﾇ回�ﾇ駕ﾒ腋ﾇ�ﾇﾈﾉTﾅ[ﾉrﾉXﾇ寡�ﾅB
ﾇｱﾇﾃﾉTﾅ[ﾉrﾉXﾇ宝pﾇ�ﾇﾈ靉釿ﾇﾕ狃竊ﾇﾃ阨裴ﾇ暮ﾛﾇﾘ�ｸﾇﾍﾇﾈ�Kﾇ♭Lﾇﾋﾇﾐﾇ�ﾅB
  1. ﾇｱﾇﾃﾉTﾅ[ﾉrﾉXﾇﾕﾇ ﾇｻﾇ�鬩麋ﾇﾃ�ｲ獷ﾇ管ｮﾇ｢ﾇ滄gﾇｵﾇ溪�ﾇ�ﾇ｢ﾅAﾇｱﾇﾃﾉTﾅ[ﾉrﾉXﾇ宝pﾇ�ﾇﾈ鴦ﾇ管ﾊﾇﾋ薰齒ﾇ�ﾇﾈ猩�ﾇﾃ�s穽ﾇ危舵ｵﾇ滄ﾑﾇﾕ�ｲ獷ﾇ暮ﾐﾇｼﾇﾒﾅB
  2. ﾇｱﾇﾃﾉTﾅ[ﾉrﾉXﾇ募冶ｫ�ど基�ﾇ�ﾇﾈ�Iﾇ蛾gﾇｵﾇ淺ﾕﾇ｢ﾇﾘﾇﾐﾇｼﾇﾒﾅB
  3. ﾇｱﾇﾃﾉTﾅ[ﾉrﾉXﾇﾕ\\鉤\ﾇｻﾇわ帝~ﾇ�ﾇﾈﾇｱﾇ隻♭Lﾇﾋﾇﾐﾇ�ﾅB
ﾇ�ﾇﾈ�Oﾇ看A ﾇｱﾇﾁﾇﾃﾉyﾅ[ﾉWﾇ�ﾇｴﾇﾒﾇ千ﾏ�ﾆﾇｵﾇ淺｢ﾇﾈﾇｱﾇ隻穂m珖ﾇｵﾇ淺ど貮�ﾇ｢ﾅB
Max10ﾉzﾉXﾉg/15�bﾉ^ﾉCﾉﾄﾉAﾉEﾉgﾇﾃ�ﾋﾇ寡�ﾅB
�ｸ:(猩輳ﾇ癌ﾍﾇｬﾇﾃﾉTﾅ[ﾉoﾇ菩ｸﾇｵﾇﾐﾇ�ﾅB)
www.test.com
prox.fin.com:10080
portﾇ暮w棏ﾇｵﾇｻﾇ｢ﾇ�8080-3128-80ﾇﾃ鞦ﾇ緩`ﾉFﾉbﾉNﾇｵﾇﾐﾇ�ﾅB


Option:
莉犹�\\鮓(for DEBUG)
ﾉTﾅ[ﾉoﾇﾃ糺�簿Sﾇ滂\\鮓
遏ﾉ`ﾉFﾉbﾉN(ﾉ`ﾉFﾉbﾉN遖ﾉ菲Xﾉgﾇ隻ﾃ關籌ﾇ壁ｵﾇ�ﾇどｻﾇ｢靉釿ﾅB)
�ﾋ�_ﾅF
  1. ﾉlﾉbﾉgﾉ霰[ﾉN�Iﾇ岩�ﾇ｢ﾅE鵆芟ﾇ�ﾇｩﾇｩﾇﾈﾉTﾅ[ﾉoﾇ管ﾕ馮筮\ﾇ寡 ﾇ｡ﾇ淺ﾉ^ﾉCﾉﾄﾉAﾉEﾉgﾇｵﾇ淺ｵﾇﾐﾇ｢ﾇﾐﾇ�ﾅB
  2. ﾉ|ﾅ[ﾉg8080ﾇ暇AﾉNﾉZﾉX肭釥ﾇ�ﾇﾍﾇ�靉釿ﾅA篌ﾇ緩|ﾅ[ﾉg80ﾇ俄ｬ\砡\ﾇ寡 ﾇ｡ﾇ淺鱚ﾇ�ﾇﾍﾇﾐﾇ�ﾅB
  3. ﾉ|ﾅ[ﾉg諟釛ﾇ暮w棏ﾇｵﾇ�靉釿ﾅAﾉ`ﾉFﾉbﾉN遖ﾇ菲Xﾉgﾇ顔蕊｡ﾇ淺｢ﾇ淺遏ﾉ`ﾉFﾉbﾉNﾇ�ﾇﾍﾇﾐﾇ�ﾅB
  4. 遏ﾉ`ﾉFﾉbﾉNﾇ�ﾇﾍﾇ�靉釿ﾅAﾉ`ﾉFﾉbﾉN遖ﾇ菲Xﾉgﾇ顔蕊｡ﾇ淺｢ﾇ淺ﾅAﾉ菲Xﾉgﾇ器ｫ筍ﾇ�ﾇﾍﾇ淺ｵﾇﾐﾇ｢ﾇﾐﾇ�ﾅB
  5. ﾇｱﾇﾁﾇﾃﾉyﾅ[ﾉWﾇ緩AﾉNﾉZﾉXﾇ寡ｴﾇｻﾇ｢靉釿ﾇﾕ黻ﾇｵﾇ｢裙笄ﾇ��貮ﾁﾇﾍﾇﾐﾇｼﾇﾒﾅB
_HTML_ &ended(); }#html END sub decode{ #猩釞�IﾇｻﾉfﾉRﾅ[ﾉhﾅ��ｦ�鏞ﾃ�南ｸ if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } #else { $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/,$buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/ /\n/g;$value =~ s/ﾅ@/\n/g; $value =~ s/\r/\n/g;$value =~ s/\n\n/\n/g; $FORM{$name} = $value; } $url = $FORM{'host'};$printall = $FORM{'printall'};$retry = $FORM{'retry'}; $printsome = $FORM{'printsome'}; @lines = split(/\n/,$url); }#decode END sub lock{ $lockfile = './lock/lock-file.lock'; $filedata = -M "$lockfile"; unlink "$lockfile" if ($filedata > 0.01);#15�∽孤暇酲bﾉNﾉtﾉ@ﾉCﾉ翩慕ﾌ顫 $retry = 5; while (!symlink(".", $lockfile)) { if (--$retry <= 0) { print "Content-type: text/html\n\n"; print <<"_HTML_"; $title $body ﾉTﾅ[ﾉoﾇ∫ｨ飄ﾇｵﾇ淺｢ﾇﾐﾇ�ﾅB(仼ﾇｩﾇ�馮汯ﾇｩﾇﾇｵﾇﾍﾇﾐﾇｼﾇﾒﾅB[?])
ﾇﾐﾇ�ﾇﾃ紂籌ﾇ管ｮ萢ﾇ｢ﾇｵﾇﾐﾇ�ﾅB

�庭ｴﾅF
ﾇ ﾇｻﾇ�ﾇ�馮汯ﾇ喜r汯ﾇ賀狩ｱﾇ��ﾇﾍﾇ�靉釿ﾅA迚昞15�∽孤ﾕﾇ寡ｴﾇﾐﾇｼﾇﾒﾅB
ﾇｱﾇﾍﾇﾕﾅACGI鵆ﾇﾃ繒�ｺ�ﾟ蜚ﾇ緩酲bﾉNﾉtﾉ@ﾉCﾉ翩宝pﾇ｢ﾇ淺｢ﾇﾈﾇ�ﾇﾅA黻靂ﾇ願Iﾇｵﾇｻﾇｩﾇ｡ﾇ�靉釿ﾅA ﾉ酲bﾉNﾉtﾉ@ﾉCﾉ翩�馗ﾇﾈﾇ�ﾇﾇ寡�ﾅB15�∽候ﾟﾇ淺打A馗ﾇｵﾇ�ﾉ酲bﾉNﾉtﾉ@ﾉCﾉ翩�鬩�ﾆ�Iﾇ顔ﾌ顫ﾇ�ﾇﾍﾇﾐﾇ�ﾇﾃﾇ嫁A遏筮砡ﾇ寡�ﾅB _HTML_ exit; } sleep(1); } #ﾉ酲bﾉNﾉtﾉ@ﾉCﾉ翩ｱﾇｱﾇﾐﾇ� }#lock END sub jikan{#$dateﾇ企鑈霽簿南ｸﾇｵﾇﾐﾇ�ﾅB $times = time;#18鵆芟鵆辣ﾇ�ﾇ ﾇﾈﾇｻﾇﾁﾅA$times = time+18*60*60ﾇ隻�ﾇﾈﾅB ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($times); $min = "0$min" if ($min < 10); $month++;$year=$year+1900; $youbi = ('��','裨','竭','�ﾖ','�','�','�y') [$wday]; $date = "$month/$mday($youbi)$hour:$min"; $month = "0$month" if ($month < 10); $mday = "0$mday" if ($mday < 10); $dateindex = "$year$month$mday"; if( $hour > 8 && $hour < 22){#愰9鵆ﾇｩﾇﾁ10鵆ﾇﾐﾇ蛾gﾇｶﾇｻﾇ｢ﾇﾊﾇｧﾇ管�ﾇﾈﾅB print "Content-type: text/html\n\n"; print <<"_HTML_"; $title $body

$date 蟐銜ﾅAﾉTﾅ[ﾉrﾉXﾇ輔x驃ﾇｵﾇ淺ｮﾇﾋﾇﾐﾇ�ﾅB


ﾇ ﾇｵﾇｩﾇﾁﾇｽﾅAﾇｾ閼ﾇど貮�ﾇ｢ﾅB _HTML_ exit; } }#jikan END __END__ # #GETﾇ�ﾇﾈﾇ�ﾇﾇﾃpenv.cgiﾇﾃﾉ\ﾅ[ﾉX ##! /usr/local/bin/perl #print "Content-type: text/plain\n\n"; #print "kusi-ok-desu\n"; # foreach (sort keys %ENV){ # print "$_=$ENV{$_} \n"; # } #exit; #__END__