mitsudori/2ch-master-mirror
1
1
Fork 0
Code Issues Pull requests Actions Projects Releases Wiki Activity
2ch-master-mirror/_bg/Rock54_Collect.cgi

223 lines
5.8 KiB
Plaintext
Raw Normal View History

new file: README.md new file: _bg/.htaccess new file: _bg/F35lastBBS.txt new file: _bg/Rock54.txt new file: _bg/Rock54_Collect.cgi new file: _bg/f15.cgi new file: _bg/f22.cgi new file: _bg/f22info.cgi new file: _bg/f35.cgi new file: _bg/index.html new file: _bg/lastbbs.txt new file: _bg/lastbbs15.txt new file: _bg/logs/20100928.txt new file: _bg/logs/20100929.txt new file: _bg/logs/20100930.txt new file: _bg/logs/20101001.txt new file: _bg/logs/20101002.txt new file: _bg/logs/Rock54-110-10-1.txt new file: _bg/logs/Rock54-110-10-2.txt new file: _bg/logs/Rock54-110-9-28.txt new file: _bg/logs/Rock54-110-9-29.txt new file: _bg/logs/Rock54-110-9-30.txt new file: _bg/logs/proxy_log.txt new file: _bg/pool.cgi new file: _boo80server/boo80server.cgi new file: _boo80server/index.html new file: bbs-entry.cgi new file: bbs-main.cgi new file: bbs.cgi new file: home/bbs-entry.cgi new file: home/bbs-main.cgi new file: home/fox.cgi new file: targz/2chbg.tar.gz new file: targz/2chboo.tar.gz new file: targz/2chhan.tar.gz
2024-12-03 05:19:09 +00:00
#!/usr/bin/perl --
# R54_Collect.cgi
# Rock54.txt <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ă<EFBFBD><C482>鑕<EFBFBD>u
=comment
2.00 2008/02/24 <09><><EFBFBD>t<EFBFBD>ǂ<EFBFBD><C782><EFBFBD>
2.01 2008/12/29 <09><><EFBFBD><EFBFBD><EFBFBD>H<EFBFBD>Ȃ񂾂<C882><F182BE82><EFBFBD><EFBFBD>B<EFBFBD>B<EFBFBD>B
2.02 2009/06/28 update<74><65><EFBFBD>̃<EFBFBD><CC83>X<EFBFBD>|<7C><><EFBFBD>X<EFBFBD>w<EFBFBD>b<EFBFBD>_<EFBFBD><5F><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>̂ʼn<CC82><C589><EFBFBD>
2.03 2010/01/03 <09><><EFBFBD>t<EFBFBD>ǂ<EFBFBD><C782><EFBFBD>PASS<53><53><EFBFBD>ĂȂ񂾂<C882><F182BE82><EFBFBD><EFBFBD>H<EFBFBD>i<EFBFBD><69><EFBFBD>j<EFBFBD>ƁA<C681>A<EFBFBD>A<EFBFBD><41><EFBFBD>@<40>̃`<60>F<EFBFBD>b<EFBFBD>N<EFBFBD>i<EFBFBD><69><EFBFBD>΁j
=cut
use LWP::UserAgent;
use strict;
# <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>g<EFBFBD>̖<EFBFBD><CC96>O
my $My_name = "Rock54_Collect";
my $Version = '2.03(2010/01/03)';
# FreeBSD <20>ł͂<C582><CD82><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ȃ<EFBFBD><C882>Ǝ~<7E>܂<EFBFBD><DC82><EFBFBD><EFBFBD>Ⴄ<EFBFBD>݂<EFBFBD><DD82><EFBFBD><EFBFBD>B<EFBFBD>B<EFBFBD>B
$SIG{'ALRM'} = "IGNORE";
# <20><><EFBFBD><EFBFBD><EFBFBD>Ă<EFBFBD><C482><EFBFBD><EFBFBD><EFBFBD><EFBFBD>X<EFBFBD>g<EFBFBD><67><EFBFBD>ݒu<DD92><75><EFBFBD><EFBFBD><EFBFBD>ꏊ<EFBFBD>B
my $Collect_PATH = '.';
my $Rock54_Text = "$Collect_PATH/Rock54.txt";
# rock54 <20>I<EFBFBD><49>URI
my $Rock54_server_name = "rock54.2ch.net";
# rock54 <20>I<EFBFBD>ւ̃<D682><CC83>N<EFBFBD>G<EFBFBD>X<EFBFBD>g
my $Collect_URI = "Rock54/_Collect/Rock54.txt";
# rock54 <20>I<EFBFBD>ւ̃<D682><CC83>N<EFBFBD>G<EFBFBD>X<EFBFBD>g<EFBFBD>i Rock54_Collect.cgi <20>擾<EFBFBD>p<EFBFBD>j
my $CollectCGI_URI = "Rock54/_Collect/Rock54_Collect.txt";
# LWP::UserAgent<6E>I<EFBFBD>u<EFBFBD>W<EFBFBD>F<EFBFBD>N<EFBFBD>g
my $UserAgent = LWP::UserAgent->new(
agent => "Monazilla/1.00 Rock54_Collect (+http://rock54.2ch.net/)",
timeout => 5,
);
# <20>t<EFBFBD>@<40>C<EFBFBD><43><EFBFBD>n<EFBFBD><6E><EFBFBD>h<EFBFBD><68><EFBFBD>p
my $FileHandle;
# <20>擾<EFBFBD><E693BE><EFBFBD>t<EFBFBD><74><EFBFBD>O<EFBFBD>p
my $GetList;
# HTML <20>e<EFBFBD><65><EFBFBD>v<EFBFBD><76><EFBFBD>[<5B>g<EFBFBD>B
my %Html;
# --- <20><><EFBFBD><EFBFBD><EFBFBD>܂<EFBFBD><DC82>̃<EFBFBD><CC83>v<EFBFBD><76><EFBFBD>C<EFBFBD><43><EFBFBD>b<EFBFBD>Z<EFBFBD>[<5B>W<EFBFBD>̃G<CC83><47><EFBFBD>e<EFBFBD>B<EFBFBD>e<EFBFBD>B<EFBFBD>w<EFBFBD>b<EFBFBD>_<EFBFBD>Ƃ<EFBFBD>
$Html{content} = <<"EOS";
Content-type: text/html; charset=Shift_JIS
Rock54-Collect-Version: %s
Rock54-Collect-Status: %s
EOS
# --- HTML<4D>w<EFBFBD>b<EFBFBD>_<EFBFBD><5F><EFBFBD><EFBFBD><EFBFBD>isprintf<74>ŏo<C58F>͂<EFBFBD><CD82>邱<EFBFBD>Ɓj
$Html{header} = <<"EOS";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html lang="ja">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
<meta http-equiv="Content-Style-Type" content="text/css">
<link rel="start" href="/index.html">
<style type="text/css">
<!--
BODY { background: #FEFEFE; color: #000; margin: 10px; }
ADDRESS { text-align: right; }
-->
</style>
<title>Rock54_Collect $Version</title>
</head>
EOS
# --- <20>Ō<EFBFBD><C58C>̂Ƃ<CC82><C682><EFBFBD>
$Html{footer} =<<"EOS";
<address>Rock54_Collect $Version</address>
</body>
</html>
EOS
# <20><><EFBFBD><EFBFBD><EFBFBD>Ȃ<EFBFBD><C882>͂<EFBFBD><CD82>ǂ炟
{
$SIG{'PIPE'} = $SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = \&SigExit;
}
# <20>~<7E>߂<EFBFBD><DF82>ꂽ<EFBFBD>Ƃ<EFBFBD>
sub SigExit{
Error("94", shift);
}
# <20>G<EFBFBD><47><EFBFBD>[
sub Error{
my $number = shift;
my $err = shift;
my %Messages = (
'00',"<22>Ƃ<EFBFBD><C682>ķ<EFBFBD><C4B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>(߁<><DF81>)<29><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!!",
'01',"<22>Ƃ<EFBFBD><C682>ķ<EFBFBD><C4B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>(߁<><DF81>)<29><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!!!",
'90',"<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>n<EFBFBD>Q<EFBFBD><51><EFBFBD>ˁB",
'91',"<22>Ƃ<EFBFBD><C682>܂<EFBFBD><DC82><EFBFBD><EFBFBD>ł<EFBFBD><C582><EFBFBD>[01]<5D>i<EFBFBD>L<EFBFBD>E<EFBFBD>ցE<D681>M<EFBFBD>j<EFBFBD><6A><EFBFBD>ް<EFBFBD>",
'92',"<22>Ƃ<EFBFBD><C682>܂<EFBFBD><DC82><EFBFBD><EFBFBD>ł<EFBFBD><C582><EFBFBD>[02]<5D>i<EFBFBD>L<EFBFBD>E<EFBFBD>ցE<D681>M<EFBFBD>j<EFBFBD><6A><EFBFBD>ް<EFBFBD>",
'93',"<22>Ƃ<EFBFBD><C682>܂<EFBFBD><DC82><EFBFBD><EFBFBD>ł<EFBFBD><C582><EFBFBD>[03]<5D>i<EFBFBD>L<EFBFBD>E<EFBFBD>ցE<D681>M<EFBFBD>j<EFBFBD><6A><EFBFBD>ް<EFBFBD>",
'94',"<22>Ƃ<EFBFBD><C682>܂<EFBFBD><DC82><EFBFBD><EFBFBD>ł<EFBFBD><C582><EFBFBD>[04]<5D>i<EFBFBD>L<EFBFBD>E<EFBFBD>ցE<D681>M<EFBFBD>j<EFBFBD><6A><EFBFBD>ް<EFBFBD>",
'95',"<22>Ƃ<EFBFBD><C682>܂<EFBFBD><DC82><EFBFBD><EFBFBD>ł<EFBFBD><C582><EFBFBD>[05]<5D>i<EFBFBD>L<EFBFBD>E<EFBFBD>ցE<D681>M<EFBFBD>j<EFBFBD><6A><EFBFBD>ް<EFBFBD>",
'96',"<22>Ƃ<EFBFBD><C682>܂<EFBFBD><DC82><EFBFBD><EFBFBD>ł<EFBFBD><C582><EFBFBD>[06]<5D>i<EFBFBD>L<EFBFBD>E<EFBFBD>ցE<D681>M<EFBFBD>j<EFBFBD><6A><EFBFBD>ް<EFBFBD>",
'97',"<22>Ƃ<EFBFBD><C682>܂<EFBFBD><DC82><EFBFBD><EFBFBD>ł<EFBFBD><C582><EFBFBD>[07]<5D>i<EFBFBD>L<EFBFBD>E<EFBFBD>ցE<D681>M<EFBFBD>j<EFBFBD><6A><EFBFBD>ް<EFBFBD>",
'98',"<22>Ƃ<EFBFBD><C682>܂<EFBFBD><DC82><EFBFBD><EFBFBD>ł<EFBFBD><C582><EFBFBD>[08]<5D>i<EFBFBD>L<EFBFBD>E<EFBFBD>ցE<D681>M<EFBFBD>j<EFBFBD><6A><EFBFBD>ް<EFBFBD>",
'99',"---- $err",
);
my %Response = (
'00','Complete',
'01','Complete+',
'90','Forbbiden',
'91','Error[$err]',
'92',"Error[write $err]",
'93',"Error[rename $err]",
'94',"Error[SIG $err received]",
'95',"Error[updateCGI $err]",
'96',"Error[renameCGI $err]",
'97',"Error[getCGI1 $err]",
'98',"Error[getCGI2 $err]",
'99',"----",
);
$Html{message} = sprintf $Html{content}, $Version, $Response{$number} ;
$Html{message} .= $Html{header};
$Html{message} .= <<"EOS";
<body>
<h1>Rock54_Collect</h1>
<p>$Messages{$number}</p>
$Html{footer}
EOS
# $| = 1; # <20><><EFBFBD>ꗬ<EFBFBD><EA97AC><EFBFBD><EFBFBD><EFBFBD>~<7E>߂Ă݂<C482><DD82>B
print $Html{message};
exit;
}
################################################################################
# <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>B
MAIN:
{
# <20>Ăяo<D18F><6F><EFBFBD><EFBFBD><EFBFBD>l<EFBFBD>̃`<60>F<EFBFBD>b<EFBFBD>N<EFBFBD><4E><EFBFBD>낢<EFBFBD><EB82A2><EFBFBD>B
$ENV{REMOTE_HOST} eq '' and
# $ENV{REMOTE_ADDR} ne '206.223.147.35' and # banana238
$ENV{REMOTE_ADDR} ne '206.223.151.67' and # tiger509
# $ENV{REMOTE_ADDR} ne '192.168.1.21' and # baila6.jp<6A>p
Error('90');
Error('90') unless $ENV{HTTP_USER_AGENT} eq "Monazilla/1.00 Rock54_Summon (+http://rock54.2ch.net/)"
or $ENV{HTTP_USER_AGENT} eq "Monazilla/1.00 Rock54_Cron (+http://rock54.2ch.net/)";
# <20><><EFBFBD><EFBFBD> Rock54.txt <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɍs<C98D><73><EFBFBD>B
# $UserAgent->default_header('Authorization' => 'Basic Q29sbGVjdDpkZWNjaURvbg==');
# BASIC<49>F<EFBFBD><46>
$UserAgent->credentials("$Rock54_server_name:80", "Entrance Rock54", "Collect", "borracho");
my $Response = $UserAgent->get("http://$Rock54_server_name/$Collect_URI");
# <20><><EFBFBD><EFBFBD><EFBFBD>荞<EFBFBD>ݐ<EFBFBD><DD90><EFBFBD>
if ($Response->is_success) {
my $Get_Rock54list = $Response->content;
# <20><><EFBFBD><EFBFBD><EFBFBD>ŏ<EFBFBD><C58F><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
open $FileHandle, ">$Rock54_Text.tmp" or Error('92', $!); # <20>擾<EFBFBD>Ɏ<EFBFBD><C98E>s
print $FileHandle $Get_Rock54list;
close $FileHandle;
# <20><><EFBFBD>O<EFBFBD><4F><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>B
rename "$Rock54_Text.tmp", $Rock54_Text or Error('93', $!); # <20><><EFBFBD>O<EFBFBD>ύX<CF8D>Ɏ<EFBFBD><C98E>s
$GetList = 1; # <20>擾<EFBFBD>n<EFBFBD>j
}
else {
Error('91',$Response->status_line); # <20>擾<EFBFBD>Ɏ<EFBFBD><C98E>s
}
# Rock54_Collect.cgi <20>̍X<CC8D>V<EFBFBD><56><EFBFBD>񂪗L<F182AA97><4C><EFBFBD>΂<EFBFBD><CE82><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɍs<C98D><73><EFBFBD>B
if ($ENV{QUERY_STRING} eq 'update') {
# <20><><EFBFBD><EFBFBD> Rock54_Collect.cgi <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɍs<C98D><73><EFBFBD>B
my $Response = $UserAgent->get("http://$Rock54_server_name/$CollectCGI_URI");
# <20><><EFBFBD><EFBFBD><EFBFBD>荞<EFBFBD>ݐ<EFBFBD><DD90><EFBFBD>
if ($Response->is_success) {
my $Get_Rock54_CollectCGI = $Response->content;
# <20><><EFBFBD><EFBFBD><EFBFBD>ŏ<EFBFBD><C58F><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
open $FileHandle, ">$Collect_PATH/$My_name.txt" or Error('95', $!); # <20>擾<EFBFBD>Ɏ<EFBFBD><C98E>s;
print $FileHandle $Get_Rock54_CollectCGI;
close $FileHandle;
# <20><><EFBFBD>݂̃p<CC83>[<5B>~<7E>b<EFBFBD>V<EFBFBD><56><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>擾
my $CGI_Permission = (stat "$Collect_PATH/$My_name.cgi")[2];
# <20><><EFBFBD>@<40>e<EFBFBD>X<EFBFBD>g
my $Perl_Response = system 'perl', '-wc', "./$My_name.txt";
Error('98', $Perl_Response) if $Perl_Response;
# <20><><EFBFBD>O<EFBFBD><4F><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
rename "$Collect_PATH/$My_name.txt", "$Collect_PATH/$My_name.cgi" or Error('96', $!); # <20><><EFBFBD>O<EFBFBD>ύX<CF8D>Ɏ<EFBFBD><C98E>s
chmod $CGI_Permission, "$Collect_PATH/$My_name.cgi"; # <20>p<EFBFBD>[<5B>~<7E>b<EFBFBD>V<EFBFBD><56><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>킹<EFBFBD><ED82B9><EFBFBD>B
$GetList = 2; # <20>擾<EFBFBD>n<EFBFBD>j
}
else {
# <20><><EFBFBD><EFBFBD><EFBFBD>荞<EFBFBD>݂Ɏ<DD82><C98E>s<EFBFBD><73><EFBFBD><EFBFBD><EFBFBD>牽<EFBFBD><E789BD><EFBFBD><EFBFBD><EFBFBD>Ȃ<EFBFBD><C882>B
Error('97',$Response->status_line); # <20>擾<EFBFBD>Ɏ<EFBFBD><C98E>s
}
}
Error('00') if $GetList == 1; # <20><><EFBFBD>X<EFBFBD>g<EFBFBD>̂ݎ擾<DD8E><E693BE><EFBFBD><EFBFBD>
Error('01') if $GetList == 2; # <20><><EFBFBD>X<EFBFBD>g<EFBFBD>{<7B><><EFBFBD>t<EFBFBD>ǂ<EFBFBD><C782>擾<EFBFBD><E693BE><EFBFBD><EFBFBD>
# <20><><EFBFBD><EFBFBD><EFBFBD>܂<EFBFBD><DC82>B
exit;
}
__END__
Reference in a new issue Copy permalink