#!/usr/bin/perl

# fǗ֌W
# che.cgi Ǘ֌Ŵׂ̂ĂɈړ
#

###########################################################################################
#
#  Force 264 BBS o[WR.PA@łBiB ͐ANZXr̋to[Wj
#
# tFCU[΍ς݁Bi΃tFCU[̓IAIt\I@ݒu̓ItɂȂĂ܂j
# GabriDuke΍i`FbNR[hj͏펞IłB
# `FbNR[hłftHg̃tFCU[ɂ͗LłII
# `FbNR[hjꂽꍇɂ͑΃tFCU[Iɂ邱Ƃŉ摜`FbNR[h
# ؂ւ܂B𓊍e҂͗ɏʂȂƓełȂ悤ɂȂ܂B
# iIAIt؂ւ͊Ǘ҃[h[hݒʂɃWvł܂j
#
#  ̃XNvgɂ
#
# ̈Y΍XNvgɂ͉L̕XɂQA邢͂͂Ă܂B
# TTSAAXAdimdimAЂ݂ADPAH꒷AmmA/../AYuumiAiC`
# wzXgrTu[`Yui(http://www.cup.com/yui/)ɉB
# Ǘ҃pX[hݒTu[`̓XL[(http://www.rescue.ne.jp/)ɉB
#
#  Script written by Carl@[ http://carl.blackout.org/ ]@Last Modified on: 20/August/99
# zC`LȂ̂ŃoOƂ܂낵łB@[߂(^^)/~  by Carl
#
# <pK>
#  1.̃XNvgɉAzzĂSRIbP`B
#  2.[zzꍇ͔zz@Force 264(http://carl.blackout.org/)𖾋LĉB
#  3.̃XNvgLŔzẑ̓_IB
#  4.̃XNvgLŐݒu肷ꍇi^j͘AB
#
###########################################################################################

#----------------#
#    ݒ    #
#----------------#

$server     = 'http://erdbeeren.virtualave.net/';
$scriptroot = $server . 'cgi-bin/';
$dataroot   = '/home/zheinz/site-data/';

##################################################
# ̃XNvgtqkŐݒ
$reload = $scriptroot . 'remove.cgi';

#
# BBS ̃XNvg url Ŏw
#
$bbsscript = $scriptroot . 'che.cgi';

##################################################
# ʂ́uIvNtqkŐݒ
$modoru = $server;

# -----------------------------------------------------------------
# L^t@C̐ݒ 
# -----------------------------------------------------------------

# pX[h̋L^t@C̐ݒ
$pass = $dataroot . 'Ap8Rtml-encrypt-key.txt';

# f̓e܂L^t@C̐ݒƍőL^iy[W\pj
$file = $dataroot . 'Ap8Rtml-logdata-main.txt';

#
# ANZXOL^邩ǂ
#
# ANZXOgꍇ̋L^t@C̐ݒ
$access_log = $dataroot . 'Ap8Rtml-bbs-rm.txt';  
# ANZXOőL^iݒ萔ȏ͌Â̂珇ɍ폜j
$rescue = '1000';

# -----------------------------------------------------------------
# A GET A^bN΍
# -----------------------------------------------------------------
$counter2 = $dataroot . 'Ap8Rtml-cnt2.txt';
$tstmp    = $dataroot . 'Ap8Rtml-tstmp.txt';
#
# Ђ݂[ǂgꍇɂ͎ۂ̒l 2 {ɂ邱
#
$access_limit = 200;
@script_list = (
                '/home/zheinz/public_html/cgi-bin',
                );

# -----------------------------------------------------------------
# ̑ݒ 
# -----------------------------------------------------------------
# ̎擾ꍇ̏C
# COԂɁ{XԂꍇ@= localtime(time + 9*60*60);
($sec,$min,$hour,$mday,$mon,$year,$wday,$d,$d) = localtime(time + 17*60*60);

#
#--- KȂ̊ɍ킹ďւ鍀ځ@܂ ---
#
$youbi = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")[$wday];
$date_now = sprintf( " %02d/%02d $youbi %02d:%02d:%02d", $mon + 1, $mday, $hour, $min, $sec );
$date_num = sprintf("%02d%02d%02d%02d%02d",$mon +1,$mday,$hour,$min,$sec); # <-ύX֎~
@key = split(//, $key);
$addr = $ENV{'REMOTE_ADDR'};
$host = $ENV{'REMOTE_HOST'};
if (($host eq $addr) || ($host eq '')) { 
  $host = gethostbyaddr(pack('C4',split(/\./,$addr)),2) || $addr;
}

&filter;

#
# ō폜pXNvgN\̂ŁA͋L^B
#

$via    = $ENV{'HTTP_VIA'};
$xfor   = $ENV{'HTTP_X_FORWARDED_FOR'};
$for    = $ENV{'HTTP_FORWARDED'};
$agent  = $ENV{'HTTP_USER_AGENT'};
$trueip = &getip;
&acount;

#
# ȉtH[̎擾Ȃтɉ
#

read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@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;

  if ($name eq "target") {
    push(@RM, $value);
  }
  else {
    $FORM{$name} = $value;
  }
}

open(DB,"$pass") || &error('0');
@lines = <DB>;
close(DB);
$password = shift(@lines);
chop($password) if ($password =~ /\n$/);
($header, $password) = split(/:/, $password);
if ($password =~ /^\$1\$/) {
  $salt = 3;
} else {
  $salt = 0;
}

#--- Ciŕj--------------------------------#
&sremove;

#
# fփWv
#
print "Content-type: text/html\n";
print "Location: $bbsscript\n\n";

exit;
#--- 牺̓Tu[` --------------------------------#

#--- ^G[ --------------------------------#
sub error {
  $error = $_[0];
  if ($error eq "0") {
    $error_msg = 'L^t@C̓o͂ɃG[܂B<BR><BR>';
    $error_msg .= 'ݒut@Ć̖Ap[~bVĊmFĉB';
  }
  elsif ($error eq "x") {
    $error_msg = '폜pX[hႤA폜XNvg̕spłB';
  }
  print <<"_HTML_";
Content-type: text/html

<HTML>
<HEAD>
<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=x-sjis">
<TITLE>BBS Error</TITLE>
</HEAD>
<body bgcolor="#ffffff" text="#000000" link="blue">
<!--VirtualAvenueBanner-->
<p>
<table border=0 width=100% cellpadding=2 cellspacing=3>
<tr><td bgcolor=#e54500><font color=#ffffff size=+3>
BBS Error
</font></td></tr></table>
<p>
<H3>$error_msg</H3>
uEU[߂]{^đỎʂɈړĉB<P>
</BODY>
</HTML>
_HTML_
  exit;
}

#--- e폜 --------------------------------#
sub sremove {
  open(DB,"$file") || &error('0');
  @lines = <DB>;
  close(DB);

  # IWił́Aۂ̍폜ȂĂt@C̍XV
  # Ă̂ŁA폜ꍇ݂̂ɏ悤ɃtO
  # 邱ƂɂB by gH
  #
  # ͂̃XNvg𖳈ӖɋN鈫Yh~ӖB
  
  $is_delete = 0;

  foreach $line (@lines) {
    $del = 0;
    ($number,$spwd,$date,$name,$email,$value,$subject,$link,$host,$addr,$via,$for,$trueip,$agent,$how,$dukecheck)
      = split(/\,/,$line);
    if ( (crypt($FORM{'spwd'}, substr($password, $salt, 2) ) eq $password) ||
         ($spwd && (crypt($FORM{'spwd'}, $spwd) eq $spwd ) ) ||
         (crypt( $FORM{'pwd'}, substr($password, $salt, 2) ) eq $password) ) {
       foreach $target (@RM) {
         if ($target eq $number) {
           $is_delete = $del = 1;
         }
       }
     }
    if ($del == 0) {
      push(@new, $line);
    }
  }

  if( $is_delete ){
    open(DB,">$file") || &error('0');
    print DB @new;
    close(DB);
  }
}

#--- ANZXOpf[^擾 --------------------------------#
sub acount {
  $date = $date_now;
  $href = $ENV{'HTTP_REFERER'};
  if ($href =~ /$reload/) {
    $href = "";
  } elsif ($href =~ /file:/) {
    $href = "";
  }
  open(LOG, "$access_log") || &error('0');
  @lines = <LOG>;
  close(LOG);

  $axs = @lines;
  $rescue2 = ($rescue - 2);
  if ($axs >= $rescue) {
    open(LOG,">$access_log") || &error('0');
    print LOG "[$date] $href - $host - $addr - $via - $trueip - $agent\n";
    foreach $axs (0 .. $rescue2) {
      print LOG $lines[$axs];
    }
  } else {
    open(LOG,">$access_log") || &error('0');
    print LOG "[$date] $href - $host - $addr - $via - $trueip - $agent\n";
    foreach $log (@lines) {
      print LOG $log;
    }
  }
  close(LOG);
}

#--- RhoAhX擾 --------------------------------#
sub getip {
  $sp_host   = $ENV{'HTTP_SP_HOST'};
  $client_ip = $ENV{'HTTP_CLIENT_IP'};
  $http_from = $ENV{'HTTP_FROM'};

  $trueip = $sp_host   if ($sp_host ne "");
  $trueip = $via       if ($via =~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/);
  if( $client_ip=~ s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/ ){
    $trueip = $client_ip;
  }elsif( $client_ip=~ s/^([\dA-F]{2})([\dA-F]{2})([\dA-F]{2})([\dA-F]{2})/$1$2$3$4/i){
    $client_ip = join('.', hex($1), hex($2), hex($3), hex($4)); 
    $trueip = $client_ip;
  }
  $trueip = $for       if ($for =~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/);
  $trueip = $xfor      if ($xfor =~ s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/);
  $trueip = $http_from if ($http_from ne "");
  return $trueip;
}

# A GET A^bN΍
# 30 ȓɂx̃ANZX𒴂
# XNvgNłȂ悤ɂBby gH
sub filter {
  open(DB, "$tstmp" ) || &error('0');
  @last_tstmp = <DB>;
  close(DB);

  $tmp_stmp = time;
  $onebyte = '1';  

  if( ( $tmp_stmp - $last_tstmp[0] ) > ( 30*60 ) ){

    # 30 o߁BJE^Zbg

    open(DB,">$counter2")|| &error('0');
    print DB $onebyte;
    close(DB);

    # L^

    open(DB,">$tstmp")|| &error('0');
    print DB $tmp_stmp;
    close(DB);
  }
  else{
    if( -e $counter2 ){ @cfstat2 = stat $counter2; }
    $number2 = ++$cfstat2[7];

    # ANZXߑ̏ꍇ
    # chmod ăXNvgNłȂ悤ɂ
    #
    if( $number2 > $access_limit ){
      chmod 0000, @script_list;
      &error('0');
    }
    open(DB,">>$counter2")|| &error('0');
    print DB $onebyte;
    close(DB);
  }
}
__END__
