ssig33

RSS My Web Site Twitter

Jan:6th:Thu

Permalink

#!/usr/bin/perl

BEGIN { $|=1; print “Content-type: text/plain; charset=Shift-JIS \n\n”; open STDERR, “>&STDOUT”; }
#BEGIN { $|=1; print “Content-type: text/plain; charset=Shift-JIS \n\n”; }
use strict ‘vars’;

use Socket;
use FileHandle;
use vars qw(%IN);
use vars qw(@DATA);
use vars qw(@FACT);
use vars qw($JIKAN); $JIKAN = time;
$ENV{‘TZ’} = “JST-9”;
umask(0);

if ( @ARGV[0] eq “湘南” && @ARGV[1] eq “白薔薇” ) {
print “test “; exit;
}

#==================================================#
# 入力データ
#==================================================#

{
my ( $query, $element, $key, $value );

if ( $ENV{‘REQUEST_METHOD’} eq “POST” ){
read(STDIN, $query, $ENV{‘CONTENT_LENGTH’});
}
@FACT = split(/&/, $query . “&” . $ENV{‘QUERY_STRING’});

foreach $element ( @FACT ) {
$element =~ tr/+/ /;
( $key, $value ) = split(/=/, $element, 2);
$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack(“H2”, $1)/eg;
$value =~ s/\r\n|\r/\n/g;
$value =~ s/[\0\x00-\x08\x0B-\x1F]//g;
$IN{$key} = $value;
# print “$key = $value\n”;
}

if ( !$IN{‘id’} || !$IN{‘pass’} ) {
exit;
}
$IN{‘namae’} = $IN{‘id’}; $IN{‘namae’} =~ s/([\W])/’%’ . unpack(‘H2’, $1)/eg;
}

#==================================================#
# アカウント確認
#==================================================#

{
open(PZ, “./demo.cgi”);
foreach ( <PZ> ) {
chomp;
if ( /^([0-9]+)\t$IN{‘id’}\t(\S+)\t$IN{‘pass’}\t\S+$/ ) {
$IN{‘FLAG’} = “$1”;
$IN{‘JIBUN’} = “$2”;
}
}
exit if ( !$IN{‘FLAG’} || !$IN{‘JIBUN’} );
}
if ( $IN{‘test’} eq “jikken” ) { print “test\t$ENV{‘QUERY_STRING’}\n”; }

#====================================================
# 日付・時刻
#====================================================

{
my ($sec, $min, $hour, $day, $mon, $year, $wday) = localtime($JIKAN);
$IN{‘DATE’} = sprintf(“%02d/%02d/%02d %02d:%02d”, $year%100, $mon+1, $day, $hour, $min);
$IN{‘MONTH’} = sprintf(“%02d”, $mon+1);
}

#==================================================#
# キャプテンJ
#==================================================#

if ( $IN{‘type’} eq “CAP” ) {
exit if ( $IN{‘FLAG’} != 1 );

# キャップ一覧
if ( $IN{‘work’} eq “LIST” ) {
my %cap;
open(LIST, “find ../handle/ |”);
foreach ( <LIST> ) {
chomp; my $file = $_; s/^..\/handle\///;
if ( /^(.+\/|)([\w\_.]+).cgi$/ ) {
open(CAP, “<$file”); my $tmp = <CAP>; chomp($tmp); $cap{“$1$2”} = “$tmp”; close(CAP);
}
}
foreach ( sort(keys(%cap)) ) { print “$_ $cap{$_}\n”; }
exit;
}

# キャップ内容
if ( $IN{‘work’} eq “VALUE” ) {
open(CAP, “<../handle/$IN{‘cap’}.cgi”); foreach ( <CAP> ) { print ” $_”; } close(CAP);
exit;
}

# キャップ登録
if ( $IN{‘work’} eq “REGIST” ) {
if ( $IN{‘new’} && -e “../handle/$IN{‘cap’}.cgi” ) {
print “<Exist Same Password>\n”; exit;
}
open(CAP, “>../handle/$IN{‘cap’}.cgi”); print CAP “$IN{‘handle’}\n$IN{‘mail’}\n”; close(CAP);
exit;
}

# キャップ変更
if ( $IN{‘work’} eq “CHANGE” ) {
$IN{‘dir’} =~ s/[^A-Za-z0-9\/]//g;
if ( !$IN{‘force’} && -e “../handle/$IN{‘dir’}$IN{‘change’}.cgi” ) {
print “<Exist Same Password>\n”; exit;
}
system(“mv -f ../handle/$IN{‘dir’}$IN{‘cap’}.cgi ../handle/$IN{‘dir’}$IN{‘change’}.cgi”);
exit;
}

# キャップ削除
if ( $IN{‘work’} eq “DELETE” ) {
$IN{‘dir’} =~ s/[^A-Za-z0-9\/]//g;
$IN{‘cap’} =~ s/[^A-Za-z0-9.\_-]//g;
unlink(“../handle/$IN{‘dir’}$IN{‘cap’}.cgi”);
exit;
}

}

if ( $IN{‘type’} eq “SERVICE” ) {
exit if ( $IN{‘FLAG’} != 1 );

# qb5 からファイルゲット!
&GetFile(“qb5.2ch.net”, “test/jennu/$IN{‘page’}”, “$IN{‘file’}”);
if ( $IN{‘mod’} =~ /^[0-7]{3,4}$/ ) {
system(“chmod $IN{‘mod’} $IN{‘file’}”);
}
my $tmp = (stat(“$IN{‘file’}”))[9]; chomp($tmp);
print “receive\t$tmp\n”;
exit;

}

if ( $IN{‘type’} eq “REPAIR” ) {
exit if ( $IN{‘FLAG’} != 1 );

# .dat の検索
if ( $IN{‘work’} eq “FIND” ) {
exit if ( !-d “../$IN{‘bbs’}/dat” || $IN{‘key’} !~ /^[0-9]{10}$/ );
my @log = &SearchDat( $IN{‘bbs’}, $IN{‘key’} );
foreach ( @log ) { print “$_”; }
exit;
}

# sss のリスト
if ( $IN{‘work’} eq “SSS” ) {
exit if ( !-d “./sss” || $IN{‘key’} !~ /^[0-9]{10}$/ );
my %log; my $count = 3;
open(SSS, “ls -t1 ./sss/$IN{‘key’}\* |”);
foreach ( <SSS> ) {
open(HEAD, “head -n 1 $_ |”); my $title = <HEAD>;
close(HEAD);
chomp; chomp($title); $title =~ s/.*<>//g;
print “$_\t$title\n”; $count—;
last unless ($count);
} close(SSS);
exit;
}

# .dat & sss 混合データ
if ( $IN{‘work’} eq “DEL” ) {
exit if ( !-e “$IN{‘file’}” || $IN{‘key’} !~ /^[0-9]{10}$/ );
my %log; my %del; my $count = 8; my $file;

open(MOTO, “<$IN{‘file’}”);
foreach ( <MOTO> ) {
chomp; my @line = split(/<>/);
if ( @line[2] =~
/^([0-9]{2,4})\/([0-9][0-9])\/([0-9][0-9])\S*\s([0-9][0-9]):([0-9][0-9]):?([0-9][0-9]|)/
) {
if ( $1 > 1900 ) {
@line[8] = “$1$2$3$4$5$6”;
} elsif ( $1 > 90 ) {
@line[8] = “19$1$2$3$4$5$6”;
} else {
@line[8] = “20$1$2$3$4$5$6”;
}
$log{@line[8]} = length($_) +1;
}
} close(MOTO);

open(SSS, “ls -t1 ./sss/$IN{‘key’}\* |”);
foreach $file ( <SSS> ) {
chomp($file); $file =~ s/.*\///g; $count—;
open(DAT, “<./sss/$file”);
foreach ( <DAT> ) {
chomp; my @line = split(/<>/);
if ( @line[2] =~
/^([0-9]{2,4})\/([0-9][0-9])\/([0-9][0-9])\S*\s([0-9][0-9]):([0-9][0-9]):?([0-9][0-9]|)/
) {
if ( $1 > 1900 ) {
@line[8] = “$1$2$3$4$5$6”;
} elsif ( $1 > 90 ) {
@line[8] = “19$1$2$3$4$5$6”;
} else {
@line[8] = “20$1$2$3$4$5$6”;
}
if ( $log{@line[8]} eq “” ) {
$log{@line[8]} = length +1;
$del{@line[8]} = “$_\n”;
}
}
} close(DAT);
last unless ($count);
} close(SSS);

open(DEL, “>./sss/_$IN{‘key’}”);
foreach ( sort(keys(%del)) ) {
print DEL $del{$_}; print “$_\t$del{$_}”;
}
close(DEL);

exit;
}

# データ復活
if ( $IN{‘work’} eq “DAT” ) {
exit if ( !-e “$IN{‘file’}” || !-e “./sss/_$IN{‘key’}” || $IN{‘key’}
!~ /^[0-9]{10}$/ );
exit if ( $IN{‘file’} =~ /kako|_datArea/ && !-d
“../../_datArea/$IN{‘bbs’}” );
system(“mv -f $IN{‘file’} ./sss/.$IN{‘key’}$JIKAN”);
open(DAT, “<./sss/.$IN{‘key’}$JIKAN”); my @log =
(<DAT>); close(DAT);
open(SSS, “<./sss/_$IN{‘key’}”); my @del =
(<SSS>); close(SSS);
foreach ( grep(/^[0-9]+$/, keys(%IN)) ) {
my $num = $IN{$_} -1; $_—;
if ( @log[$_] && @log[$_] !~
/<>[0-9][0-9]/ && @del[$num] =~
/<>[0-9][0-9]/ ) {
@log[$_] = @del[$num];
}
}
open(NEW, “>./sss/_$IN{‘key’}$JIKAN”); foreach ( @log ) { print
NEW “$_”; } close(NEW);
if ( $IN{‘file’} =~ /kako|_datArea/ ) {
system(“mv -f ./sss/_$IN{‘key’}$JIKAN
../../_datArea/$IN{‘bbs’}/pool/$IN{‘key’}.dat”);
$IN{‘file’} =~ s/.dat$//;
unlink(“$IN{‘file’}.html”. “$IN{‘file’}.html.gz”,
“$IN{‘file’}.dat.gz”);
} else {
system(“mv -f ./sss/_$IN{‘key’}$JIKAN $IN{‘file’}”);
}
unlink(“./sss/_$IN{‘key’}”);
exit;
}

# sss > .dat
if ( $IN{‘work’} eq “MOVE” ) {
exit if ( !-e “./sss/$IN{‘sss’}” || !-d “../$IN{‘bbs’}/” || -e
“../$IN{‘bbs’}/dat/$IN{‘key’}.dat” );
system(“mv -f ./sss/$IN{‘sss’} ../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
open(DAT, “<../$IN{‘bbs’}/dat/$IN{‘key’}.dat”); my @log =
(<DAT>); close(DAT);
my $num = @log; my $title = $log[0]; chomp($title); $title =~
s/.*<>//g;
open(SJT, “>>../$IN{‘bbs’}/subject.txt”); flock(SJT, 2);
print SJT “$IN{‘key’}.dat<>$title ($num)\n”; close(SJT);
}

exit;
}

if ( $IN{‘FLAG’} == 1 ) {

# ファイル一覧
&LIST($IN{‘dir’}, $IN{‘option’}) if ( $IN{‘exec’} eq “LIST”
&& $IN{‘dir’} );

# ファイル検索
&FIND($IN{‘dir’}, $IN{‘name’}) if ( $IN{‘exec’} eq “FIND”
&& $IN{‘dir’} && $IN{‘name’} );

# ファイル時系列
&PERIOD($IN{‘dir’}) if ( $IN{‘exec’} eq “PERIOD”
&& $IN{‘dir’} );

# ファイル中身(cgiとか過去ログ)
&DATA($IN{‘file’}) if ( $IN{‘exec’} eq “DATA”
&& -e “$IN{‘file’}” );

}

#==================================================#
# KKフィールド
#==================================================#

if ( $IN{‘type’} eq “ATF” ) {
exit unless ( $IN{‘FLAG’} &3 );

exit unless ( $IN{‘FLAG’} &33 );

exit;
}

#==================================================#
# どこでも移動
#==================================================#

if ( $IN{‘type’} eq “TRANSFER” ) {
exit unless ( $IN{‘FLAG’} &5 );

# 倉庫
if ( $IN{‘work’} eq “KAKO” ) {
if ( !-e “../$IN{‘bbs’}/dat/$IN{‘key’}.dat” ) {
print ”
<i>データが見つかりません!</i><br>\n”;
exit;
}
if ( !-d “../../_datArea/” || !-d “../../_datArea/$IN{‘bbs’}/” ) {
print ”
<i>この板には倉庫がありません!</i><br>\n”;
exit;
} elsif ( !-d “../../_datArea/$IN{‘bbs’}/pool/” ) {
mkdir(“../../_datArea/$IN{‘bbs’}/pool/”, 0755);
}
open(HEAD, “head -n 1 ../$IN{‘bbs’}/dat/$IN{‘key’}.dat |”); my $title
= <HEAD>; close(HEAD);
chomp($title); $title =~ s/.*<>//g;
system(“mv ../$IN{‘bbs’}/dat/$IN{‘key’}.dat
../../_datArea/$IN{‘bbs’}/pool/”);
if ( -e “../../_datArea/$IN{‘bbs’}/pool/$IN{‘key’}.dat” ) {
print ”
<label>$title</label><br>\n”;
} else {
print ”
<i>倉庫が存在しないか書き込み\不\能\で
す!</i><br>\n”;
}
exit;
}

# 復活
if ( $IN{‘work’} eq “DAT” ) {
exit if ( $IN{‘key’} !~ /[0-9]{10}/ || $IN{‘bbs’} =~ /\W/ );
if ( !-d “../$IN{‘bbs’}/” || !-d “../$IN{‘bbs’}/dat” ) {
print ”
<i>板が存在しないか引っ越し済みで
す!</i><br>\n”; exit;
}
my @log = grep(/$IN{‘key’}.dat/, &SearchDat( $IN{‘bbs’},
$IN{‘key’}));
if ( !@log ) {
print ”
<i>倉庫orデータが存在しません!</i><br>\n”;
} elsif ( @log[0] =~ /\/dat\// ) {
print ”
<i>このスレッドは現役です!</i><br>\n”;
} elsif ( @log[0] !~ /\/_datArea\// ) {
print ”
<i>このスレッドはHTML化済みで
す!</i><br>\n”;
}
my $file = @log[0]; chomp($file);
system(“mv $file ../$IN{‘bbs’}/dat/”);
if ( -e “../$IN{‘bbs’}/dat/$IN{‘key’}.dat” ) {
open(DAT, “<../$IN{‘bbs’}/dat/$IN{‘key’}.dat”); @log =
(<DAT>); close(DAT);
my $num = @log; my $title = $log[0]; chomp($title); $title =~
s/.*<>//g;
open(SJT, “>>../$IN{‘bbs’}/subject.txt”); flock(SJT,
2); print SJT “$IN{‘key’}.dat<>$title ($num)\n”;
close(SJT);
print ”
<label>$title</label><br>\n”;
} else {
print ” <i>異常事態!
キャプテンに報告を!</i><br>\n”;
}
exit;
}

# 掲示板移動
if ( $IN{‘work’} eq “BBS” ) {
exit if ( $IN{‘key’} !~ /[0-9]{10}/ || $IN{‘bbs’} =~ /\W/ ||
$IN{‘ita’} =~ /\W/ );
if ( !-d “../$IN{‘ita’}/” || !-d “../$IN{‘ita’}/dat” ) {
print ”
<i>移動先の板が存在しません!</i><br>\n”;
exit;
}
if ( !-e “../$IN{‘bbs’}/dat/$IN{‘key’}.dat” ) {
print ”
<i>移動するデータが存在しません!</i><br>\n”;
exit;
}
my $bango = $IN{‘key’};
while ( -e “../$IN{‘ita’}/dat/$bango.dat”) {
$bango++;
}
system(“mv -f ../$IN{‘bbs’}/dat/$IN{‘key’}.dat
../$IN{‘ita’}/dat/$bango.dat”);
if ( -e “../$IN{‘ita’}/dat/$bango.dat” ) {
open(DAT, “<../$IN{‘ita’}/dat/$bango.dat”); my @log =
(<DAT>); close(DAT);
my $num = @log; my $title = $log[0]; chomp($title); $title =~
s/.*<>//g;
open(SJT, “>>../$IN{‘ita’}/subject.txt”); flock(SJT,
2); print SJT “$bango.dat<>$title ($num)\n”; close(SJT);
if ( $IN{‘move’} =~ /<>/ || $IN{‘move’} =~
/[\0\x00-\x1F]/ ) {
$IN{‘move’} = “”; # 最後は必ず「 <br> 」に。
}
open(MOVE, “>../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
print MOVE
“移転しました。<>移転<>移転<>
$IN{‘move’}http://$IN{‘basho’}/test/read.cgi/$IN{‘ita’}/$bango/
<>移転したよ?\n”;
close(MOVE); system(“chmod 0555 ../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
print ” <label>>
$IN{‘server’}/$IN{‘ita’}/$bango</label><br>\n”;

} else {
print ” <i>異常事態!
キャプテンに報告を!</i><br>\n”;
}
exit;
}

# サーバ間移動
if ( $IN{‘work’} eq “SERVER” ) {
exit if ( $IN{‘key’} !~ /[0-9]{10}/ || $IN{‘bbs’} =~ /\W/ ||
$IN{‘ita’} =~ /\W/ );
if ( !-d “../$IN{‘ita’}/” || !-d “../$IN{‘ita’}/dat” ) {
print ”
<i>移動先の板が存在しません!</i><br>\n”;
exit;
}
my $bango = $IN{‘key’};
while ( -e “../$IN{‘ita’}/dat/$bango.dat”) {
$bango++;
}
&GetFile($IN{‘server’}, “$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
open(DAT, “<./sss/_$JIKAN”); my @log = (<DAT>);
close(DAT);
my $num = @log; my $title = $log[0]; chomp($title);
if ( $IN{‘move’} =~ /<>/ || $IN{‘move’} =~
/[\0\x00-\x1F]/ ) {
$IN{‘move’} = “”; # 最後は必ず「 <br> 」に。
}
$IN{‘move’} =~ s/([\W])/’%’ . unpack(‘H2’, $1)/eg;
if ( $title =~
/.+<>.*<>.+<>.+<>.*/
&& $num > 1 ) {
system(“mv ./sss/_$JIKAN ../$IN{‘ita’}/dat/$bango.dat”); $title =~
s/.*<>//g;
open(SJT, “>>../$IN{‘ita’}/subject.txt”); flock(SJT,
2); print SJT “$bango.dat<>$title ($num)\n”; close(SJT);
&TaninNano($IN{‘server’},
“test/sikasi.cgi?id=$IN{‘namae’}&pass=$IN{‘pass’}&type=TRANSFER&work=TRANS&bbs=$IN{‘bbs’}&key=$IN{‘key’}&basho=$ENV{‘SERVER_NAME’}&ita=$IN{‘ita’}&bango=$bango&move=$IN{‘move’}”);

print ” <label>>
$IN{‘server’}/$IN{‘ita’}/$bango</label><br>\n”;

} else {
my $file = “../$IN{‘bbs’}/dat/$IN{‘key’}.dat”; $file =~ s/([\W])/’%’
. unpack(‘H2’, $1)/eg;
&TaninNano($IN{‘server’},
“test/sikasi.cgi?id=$IN{‘namae’}&pass=$IN{‘pass’}&type=TRANSFER&work=GET&file=$file”);

if ( @DATA[0] =~
/.+<>.*<>.+<>.+<>.*/
) {
open(DAT, “>../$IN{‘ita’}/dat/$bango.dat”);
foreach ( @DATA ) {
print $_;
} close(DAT);
$num = @DATA; $title = $DATA[0]; chomp($title); $title =~
s/.*<>//g;
open(SJT, “>>../$IN{‘ita’}/subject.txt”); flock(SJT,
2); print SJT “$bango.dat<>$title ($num)\n”; close(SJT);
&TaninNano($IN{‘server’},
“test/sikasi.cgi?id=$IN{‘namae’}&pass=$IN{‘pass’}&type=TRANSFER&work=TRANS&bbs=$IN{‘bbs’}&key=$IN{‘key’}&basho=$ENV{‘SERVER_NAME’}&ita=$IN{‘ita’}&bango=$bango&move=$IN{‘move’}”);

print ” <label>>
$IN{‘server’}/$IN{‘ita’}/$bango</label><br>\n”;

} else {
print ” <i>異常事態!
キャプテンに報告を!</i><br>\n”;
}
}
exit;
}

# 移動跡
if ( $IN{‘work’} eq “TRANS” ) {
exit if ( $IN{‘key’} !~ /[0-9]{10}/ || $IN{‘bbs’} =~ /\W/ || !-e
“../$IN{‘bbs’}/dat/$IN{‘key’}.dat” );
system(“mv -f ../$IN{‘bbs’}/dat/$IN{‘key’}.dat ./sss/$IN{‘key’}$JIKAN
“);
open(MOVE, “>../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
print MOVE
“移転しました。<>移転<>移転<>
$IN{‘move’}http://$IN{‘basho’}/test/read.cgi/$IN{‘ita’}/$IN{‘bango’}/
<>移転したよ?\n”;
close(MOVE); system(“chmod 0555 ../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
exit;
}

# subject.txt
if ( $IN{‘work’} eq “LIST” ) {
exit if ( $IN{‘ita’} =~ /\W/ || !-e “../$IN{‘ita’}/” );
&DATA(“../$IN{‘ita’}/subject.txt”); exit;
}

# もしものための。。。
if ( $IN{‘work’} eq “GET” && $IN{‘FLAG’} &33 ) {
&DATA($IN{‘file’}); exit;
}

exit;
}

#==================================================#
# スレッド
#==================================================#

if ( $IN{‘type’} eq “THREAD” ) {
exit unless ( $IN{‘FLAG’} &9 );

# タイトル
if ( $IN{‘work’} eq “FIRST” ) {
foreach ( grep(s/^T=//, @FACT) ) {
s/%([0-9a-fA-F][0-9a-fA-F])/pack(“H2”, $1)/eg;
if ( /(\w+)\/([0-9]+)/ ) {
open(DAT, “<../$1/dat/$2.dat”); my @line =
(<DAT>); close(DAT);
if ( @line ) {
my $first = @line[0]; chomp($first); my $num = @line;
print “$1/$2 $first $num\n”;
} else {
my ( $bbs, $key ) = ( $1, $2 );
my @log = grep(/$key.dat/, &SearchDat( $bbs, $key ));
if ( @log ) {
my $file = @log[0]; chomp($file);
open(HEAD, “head -n 1 $file |”); my $first = <HEAD>;
close(HEAD); chomp($first);
if ( $first ) {
print “$bbs/$key $first $file\n”;
} else {
print “$bbs/$key <i>データ不明</i>\n”;
}
} else {
print “$bbs/$key <i>データ不明</i>\n”;
}
}
}
}
exit;
}

# 削除
if ( $IN{‘work’} eq “DELE” ) {
if ( !-e “../$IN{‘bbs’}/dat/$IN{‘key’}.dat” || $IN{‘past’} eq “kako” )
{
my @log = grep(/$IN{‘key’}.dat/, &SearchDat( $IN{‘bbs’},
$IN{‘key’} ));
if ( @log ) {
my $file = @log[0]; chomp($file);
system(“mv -f $file ./sss/$IN{‘key’}$JIKAN “);
if ( -e “./sss/$IN{‘key’}$JIKAN” ) {
$file =~ s/.dat//;
unlink(“$file.html”. “$file.html.gz”, “$file.dat.gz”);
} else {
print ”
<i>削除できませんでした!</i><br>\n”;
exit;
}
} else {
print ”
<i>削除できませんでした!</i><br>\n”;
exit;
}
} else {
system(“mv -f ../$IN{‘bbs’}/dat/$IN{‘key’}.dat
./sss/$IN{‘key’}$JIKAN “);
}
if ( -e “./sss/$IN{‘key’}$JIKAN” ) {
print ”
<label>削除しまし
た。。。</label><br>\n”
} else {
print ”
<i>削除できませんでした!</i><br>\n”;
}
exit;
}

# 移動 板
if ( $IN{‘work’} eq “MOVE” ) {
if ( !-e “../$IN{‘bbs’}/dat/$IN{‘key’}.dat” || !-d
“../$IN{‘ita’}/dat/” ) {
print ”
<i>移動できませんでした!</i><br>\n”;
exit;
}
my $bango = $IN{‘key’};
while ( -e “../$IN{‘ita’}/dat/$bango.dat”) {
$bango++;
}
system(“mv -f ../$IN{‘bbs’}/dat/$IN{‘key’}.dat
../$IN{‘ita’}/dat/$bango.dat”);
if ( -e “../$IN{‘ita’}/dat/$bango.dat” ) {
open(DAT, “<../$IN{‘ita’}/dat/$bango.dat”); my @log =
(<DAT>); close(DAT);
my $num = @log; my $title = $log[0]; chomp($title); $title =~
s/.*<>//g;
open(SJT, “>>../$IN{‘ita’}/subject.txt”); flock(SJT,
2); print SJT “$bango.dat<>$title ($num)\n”; close(SJT);
open(MOVE, “>../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
print MOVE
“移転しました。<>移転<>移転<>
$IN{‘move’}http://$IN{‘basho’}/test/read.cgi/$IN{‘ita’}/$bango/
<>移転したよ?\n”;
close(MOVE); system(“chmod 0555 ../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
print ”
<label>移動しまし
た。。。</label><br>\n”;
} else {
print ”
<i>移動できませんでした!</i><br>\n”;
}
exit;
}

# 移動 サーバ
if ( $IN{‘work’} eq “GETS” ) {
if ( !-d “../$IN{‘ita’}/dat/” ) {
print ”
<i>移動できませんでした!</i><br>\n”;
exit;
}
my $bango = $IN{‘key’};
while ( -e “../$IN{‘ita’}/dat/$bango.dat”) {
$bango++;
}
&GetFile($IN{‘server’}, “$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
open(DAT, “<./sss/_$JIKAN”); my @log = (<DAT>);
close(DAT);
my $num = @log; my $title = $log[0]; chomp($title);
if ( $title =~
/.+<>.*<>.+<>.+<>.*/
&& $num > 1 ) {
system(“mv ./sss/_$JIKAN ../$IN{‘ita’}/dat/$bango.dat”); $title =~
s/.*<>//g;
if ( -e “../$IN{‘ita’}/dat/$bango.dat” ) {
open(SJT, “>>../$IN{‘ita’}/subject.txt”); flock(SJT,
2); print SJT “$bango.dat<>$title ($num)\n”; close(SJT);
$IN{‘move’} =~ s/([\W])/’%’ . unpack(‘H2’, $1)/eg;
&TaninNano($IN{‘server’},
“test/sikasi.cgi?id=$IN{‘namae’}&pass=$IN{‘pass’}&type=THREAD&work=TRANS&bbs=$IN{‘bbs’}&key=$IN{‘key’}&basho=$ENV{‘SERVER_NAME’}&ita=$IN{‘ita’}&bango=$bango&move=$IN{‘move’}”);

print ”
<label>移動しまし
た。。。</label><br>\n”;
} else {
print ”
<i>移動できませんでした!</label><br>\n”;
}
} else {
print ”
<i>移動できませんでした!</label><br>\n”;
}
exit;
}

# 移動跡
if ( $IN{‘work’} eq “TRANS” ) {
exit if ( $IN{‘key’} !~ /[0-9]{10}/ || $IN{‘bbs’} =~ /\W/ || !-e
“../$IN{‘bbs’}/dat/$IN{‘key’}.dat” );
system(“mv -f ../$IN{‘bbs’}/dat/$IN{‘key’}.dat ./sss/$IN{‘key’}$JIKAN
“);
open(MOVE, “>../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
print MOVE
“移転しました。<>移転<>移転<>
$IN{‘move’}http://$IN{‘basho’}/test/read.cgi/$IN{‘ita’}/$IN{‘bango’}/
<>移転したよ?\n”;
close(MOVE); system(“chmod 0555 ../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
exit;
}

# 停止
if ( $IN{‘work’} eq “STOP” ) {
if ( !-e “../$IN{‘bbs’}/dat/$IN{‘key’}.dat” ) {
print ”
<i>停止できませんでした!</label><br>\n”;
}
if ( $IN{‘stop’} && $IN{‘stop’} !~ /<>/ )
{
$IN{‘stop’} =
“停止しました。<>停止<>停止<> $IN{‘stop’}
<>停止したよ?\n”;
} else {
$IN{‘stop’} =
“停止しました。<>停止<>停止<>
停止しちゃいました。。。( ̄ー ̄)ニヤリッ <>停止したよ?\n”;
}
open(DAT, “>>../$IN{‘bbs’}/dat/$IN{‘key’}.dat”); print
DAT “$IN{‘stop’}”; close(DAT);
system(“chmod 0555 ../$IN{‘bbs’}/dat/$IN{‘key’}.dat”);
if ( -w “../$IN{‘bbs’}/dat/$IN{‘key’}.dat” ) {
print ”
<i>停止できませんでした!</i><br>\n”;
} else {
print ”
<label>停止しまし
た。。。</label><br>\n”;
}
exit;
}

exit;
}

#==================================================#
# レス
#==================================================#

if ( $IN{‘type’} eq “RES” ) {
exit unless ( $IN{‘FLAG’} &17 );

# タイトル
if ( $IN{‘work’} eq “FIRST” ) {
foreach ( grep(s/^T=//, @FACT) ) {
s/%([0-9a-fA-F][0-9a-fA-F])/pack(“H2”, $1)/eg;
if ( /(\w+)\/([0-9]+)/ ) {
open(DAT, “<../$1/dat/$2.dat”); my @line =
(<DAT>); close(DAT);
if ( @line ) {
my $first = @line[0]; chomp($first); my $num = @line;
print “$1/$2 $first $num\n”;
} else {
my ( $bbs, $key ) = ( $1, $2 );
my @log = grep(/$key.dat/, &SearchDat( $bbs, $key ));
if ( @log ) {
my $file = @log[0]; chomp($file);
open(HEAD, “head -n 1 $file |”); my $first = <HEAD>;
close(HEAD); chomp($first);
if ( $first ) {
print “$bbs/$key $first $file\n”;
} else {
print “$bbs/$key <i>データ不明</i>\n”;
}
} else {
print “$bbs/$key <i>データ不明</i>\n”;
}
}
}
}
exit;
}

# データ出力
if ( $IN{‘work’} eq “DAT” ) {
my @log = grep(/$IN{‘key’}.dat/, &SearchDat( $IN{‘bbs’},
$IN{‘key’} ));
&DATA(@log[0]); exit;
}

# 削除
if ( $IN{‘work’} eq “DELETE” ) {
my $file = “../$IN{‘bbs’}/dat/$IN{‘key’}.dat”;
if ( !-e “$file” ) {
my @log = grep(/$IN{‘key’}.dat/, &SearchDat( $IN{‘bbs’},
$IN{‘key’} ));
if ( !@log ) {
print “1234
<i>削除できませんでした!</i><br>\n”;
exit;
}
$file = @log[0]; chomp($file);
}
if ( $IN{‘abone’} && $IN{‘abone’} !~
/[0-9<>]/ ) {
$IN{‘text’} =
“$IN{‘abone’}<>$IN{‘abone’}<>$IN{‘abone’}<>$IN{‘abone’}<>$IN{‘abone’}\n”;

} else {
$IN{‘text’} =
“あぼーん<>あぼーん<>あぼーん<>あぼー
ん<>あぼーん\n”;
}
system(“mv $file ./sss/$IN{‘key’}$JIKAN”);
if ( !-e “./sss/$IN{‘key’}$JIKAN” ) {
print “1234
<i>削除できませんでした!</i><br>\n”;
exit;
} elsif ( $file =~ /\/kako\/|\/_datArea\// ) {
$file =~ s/.dat//;
unlink(“$file.html”. “$file.html.gz”, “$file.dat.gz”);
$file = “../../_datArea/$IN{‘bbs’}/pool/$IN{‘key’}.dat”;
}
open(SSS, “<./sss/$IN{‘key’}$JIKAN”); my @sss =
(<SSS>); close(SSS);
foreach ( sort { $b <=> $a; } (grep(/^([0-9]+)$/,
keys(%IN))) ) {
if ( $IN{$_} eq “a” ) {
print “$_ a @sss[$_]”;
@sss[$_] = “$IN{‘text’}”;
} elsif ( $IN{$_} eq “c” ) {
print “$_ c @sss[$_]”;
@sss[$_] = “”;
}
}
open(DAT, “>$file”);
foreach ( @sss ) {
if ( $_ ) {
print DAT “$_”;
}
} close(DAT);
if ( -s $file ) {
print “1234
<label>以上のレスを削除しまし
た。。。</i><br>\n”;
} else {
print “1234
<i>削除できませんでした!</i><br>\n”;
}
exit;
}

exit;
}

exit;

#==================================================#
# 汎用サブルーチン
#==================================================#

# ファイル一覧
sub LIST
{
my ( $dir, $option ) = @_;
$option = ( $option )? “-$option “: “”;
open(LIST, “ls -1a $option$dir |”);
foreach ( <LIST> ) {
print “$_”;
}
}

# ファイル検索
sub FIND
{
my ( $dir, $name ) = @_;
open(SAGAS, “find $dir -name ‘$name’ |”);
foreach ( <SAGAS> ) {
print “$_”;
} close(SAGAS);
}

# ファイル時系列
sub PERIOD
{
my $dir = @_[0]; my %MON;
$MON{‘Jan’} = “01”; $MON{‘Feb’} = “02”; $MON{‘Mar’} = “03”; $MON{‘Apr’}
= “04”; $MON{‘May’} = “05”; $MON{‘Jun’} = “06”;
$MON{‘Jul’} = “07”; $MON{‘Aug’} = “08”; $MON{‘Sep’} = “09”; $MON{‘Oct’}
= “10”; $MON{‘Nov’} = “11”; $MON{‘Dec’} = “12”;
open(PERIOD, “ls -tl $dir | grep -e ‘^-’ |”);
my @log = (<PERIOD>); close(PERIOD);
foreach ( grep(s/ +/\t/g, @log) ) {
chomp; my @line = split(/\t/);
my $tmp = sprintf(“%02d/%02d %s %d %s”, $MON{@line[5]}, @line[6],
@line[7], @line[4], @line[8]);
print “$tmp\n”;
}
}

# ファイル中身(cgiとか過去ログ)
sub DATA
{
my ( $file ) = @_[0];
open(DATA, “<$file”); foreach ( <DATA> ) { print
“$_”; } close(DATA);
}

# .dat 検索
sub SearchDat
{
my ( $bbs, $key ) = @_; my $head = substr($key, 0, 4); my @log;
open(SAGAD, “find ../$bbs/dat/$key\* ../$bbs/kako/$head\* -name
‘$key.dat’ |”); my @log = (<SAGAD>); close(SAGAD);
if ( @log ) {
return( @log );
}
@log = ();
open(SAGAK, “find ../../_datArea/$bbs/pool/
../../_datArea/$bbs/kako/$head\* ../../_datArea/$bbs/oyster/$head\*
-name ‘$key.dat’ |”); my @log = (<SAGAK>); close(SAGAK);
if ( @log ) {
return( @log );
}
}

#====================================================
# 他サーバ
#====================================================

sub GetFile
{

my ( $server, $page, $file ) = ( @_ ); my ( $inad, $scad, $head, $data
);

eval {
local($SIG{ALRM}) = sub{ die “時間切れになっちゃいました。\n”; };
alarm(15);

$inad = inet_aton($server) || die “存在しないアドレスです。\n”;
$scad = pack_sockaddr_in(80, $inad);
socket(SOCK, PF_INET, SOCK_STREAM, 0) || die “ソケットを生成できません。\n”;
connect(SOCK, $scad) || die “接続できません。\n”;
select(SOCK); $|= 1; select(STDOUT);

print SOCK “GET http://$server/$page HTTP/1.0\r\nHost:
$server\r\nUser-Agent: Monazilla/1.00 ($ENV{‘SERVER_NAME’})\r\n\r\n”;

open(GET, “>./sss/_$JIKAN”);
while ( <SOCK> ) {
$page = “$_”;
last if ( $page !~ /\S/ );
}
while ( <SOCK> ) {
print GET “$_”;
}
close(GET);

close(SOCK); alarm(0);
};

if ( $file && -s “./sss/_$JIKAN” ) {
system(“mv -f ./sss/_$JIKAN $file”);
}

}

sub TaninNano
{

my ( $server, $page, $method ) = ( @_ ); my ( $inad, $scad, $head,
$data );

if ( $server eq “localhost” ) { $page = “+saku/$page”; }

eval {
local($SIG{ALRM}) = sub{ die “時間切れになっちゃいました。\n”; };
alarm(30);

$inad = inet_aton($server) || die “存在しないアドレスです。\n”;
$scad = pack_sockaddr_in(80, $inad);
socket(SOCK, PF_INET, SOCK_STREAM, 0) || die “ソケットを生成できません。\n”;
connect(SOCK, $scad) || die “接続できません。\n”;
select(SOCK); $|= 1; select(STDOUT);

print SOCK “GET http://$server/$page HTTP/1.0\r\nHost:
$server\r\nUser-Agent: Monazilla/1.00 ($ENV{‘SERVER_NAME’})\r\n\r\n”;

while ( <SOCK> ) {
$method = “$_”;
last if ( $method !~ /\S/ );
}
while ( <SOCK> ) { push(@DATA, “$_”); }
# while ( <SOCK> ) { $head .= “$_”; last if ($_ !~ /\S/);
}
# while ( <SOCK> ) { $data .= “$_”; print
“$_<br>”; }
close(SOCK);
alarm(0);
};

}

  1. kasei-san reblogged this from hitode909
  2. hitode909 reblogged this from rikukoike
  3. glasssaga2 reblogged this from rikukoike
  4. satoshi-yuki reblogged this from tomitakeflash
  5. tomitakeflash reblogged this from rikukoike
  6. rikukoike posted this