#!/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 . 'adm.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';

# Py[Wɕ\ftHgi[hۂ̕\͉ρj
$kensuu = 30; 

#
# ANZXOL^邩ǂ
#
# ANZXOgꍇ̋L^t@C̐ݒ
$access_log = $dataroot . 'Ap8Rtml-bbs-adm.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;
}

#
# ŊǗ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;

&filter;

#
# ȉ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;
}

if ($header ne 'crypt_password' || $password eq '') {
  $start = 1;
  &password;
}

#--- Ciŕj--------------------------------#
if ($ARGV[0] eq 'pas' && $FORM{'papost'} eq 'pcode') {
  &password;
}
elsif($ARGV[0] eq 'ad' && $FORM{'admin'} eq 'change' && crypt($FORM{'pwd'}, substr($password,$salt,2)) eq $password) {
  &password;
}
elsif($ARGV[0] eq 'ad' && $FORM{'admin'} eq 'cut' && crypt($FORM{'pwd'}, substr($password,$salt,2)) eq $password) {
  &remove1;
  exit;
}
elsif($ARGV[0] eq 'osr' && crypt($FORM{'pwd'}, substr($password,$salt,2)) eq $password) {
  &sremove;
  &remove1;
  exit;
}
else{
  &error('x');
  exit;
}

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 Admin Error</TITLE>
</HEAD>
<body bgcolor="#ffffff" text="#000000" link="blue">
<!--VirtualAvenueBanner-->
<p>
<table border=0 width=100% cellpadding=2 cellspacing=3>
<tr><td bgcolor=#45e500><font color=#ffffff size=+3>
BBS Admin Error
</font></td></tr></table>
<p>
<H3>$error_msg</H3>
uEU[߂]{^đỎʂɈړĉB<P>
</BODY>
</HTML>
_HTML_
  exit;
}

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

  print <<"_HTML_";
Content-type: text/html

<HTML>
<HEAD><META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=x-sjis">
<TITLE>BBS Submitter List</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 Submitter List
</font></td></tr></table>
<p>
<FONT size="+2"><B>e҈ꗗ[hiL폜ł܂j</B></FONT>  [<A href="$bbsscript">߂</A>]<P>
<FORM method="POST" action="$reload?osr">
<PRE>
    o^               e(FID)                  ^Cg               ANZXf[^(REMOTE_HOST - REMOTE_ADDR - HTTP_VIA - HTTP_FORWARDED - TrueIP - USER_AGENT)<hr>
_HTML_
  foreach $line (@lines) {
    ($number,$spwd,$date,$name,$email,$value,$subject,$link,$host,$addr,$via,$for,$trueip,$agent,$how,$dukecheck)
      = split(/\,/,$line);
    chop($subject) if ($subject =~ /\r/);
    $name  =~ s/</&lt;/ig;
    $name  =~ s/>/&gt;/ig;
    $subject  =~ s/</&lt;/ig;
    $subject  =~ s/>/&gt;/ig;
    
    $i1 = length($name);
    if ($i1 > 14) {
      $name = substr($name, 0, 14);
    } elsif ($i1 < 14) {
      $blank = ' ' x (14 - $i1);
      $name = $name . $blank;
    }
    $i2 = length($subject);
    if ($i2 > 20) {
      $subject = substr($subject, 0, 20);
    } elsif ($i2 < 20) {
      $blank = ' ' x (20 - $i2);
      $subject = $subject . $blank;
    }
    $spwd =~ s/^.*(.{11})$/$1/;
    $i3 = length($spwd);
    $blank = '-' x (13 - $i3);
    $spwd = $spwd . $blank;
    print "<INPUT type=\"checkbox\" name=\"target\" value=\"$number\">";
    print "$date - $name($spwd) - $subject - $host - $addr - $via - $for - $trueip - $agent\n";
  }
  print <<"_HTML_";
</PRE><P>
<INPUT type="hidden" name="pwd" value="$FORM{'pwd'}">
<INPUT type="submit" value="     폜     "><INPUT type="reset" value="Zbg">
</FORM><P>
</BODY>
</HTML>
_HTML_
}

#--- e폜 --------------------------------#
sub sremove {
  open(DB,"$file") || &error('0');
  @lines = <DB>;
  close(DB);
  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) {
           $del = 1;
         }
       }
    }
    if ($del == 0) {
      push(@new, $line);
    }
  }
  open(DB,">$file") || &error('0');
  print DB @new;
  close(DB);
  @lines = @new;
}

#--- Ǘ҃pX[ho^Í --------------------------------#
sub password {
  $psold = $FORM{'password_old'};
  $pas1 = $FORM{'password'};
  $pas2 = $FORM{'password2'};
  
  print <<"_HTML_";
Content-type: text/html

<HTML>
<HEAD><META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=x-sjis">
<TITLE>BBS Passwd Admin</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 Passwd Admin
</font></td></tr></table>
<p>
<H1>Ǘ҃pX[h̐ݒ\^ύX</H1>
_HTML_
  if ($start == 1 && $pas1 eq '') {
    print "Ǘ҃pX[h̃y[WŐݒ\܂B<P>\n";
  }
  elsif ($pas1 =~ /\W/) {
    print "<FONT COLOR=red>VpX[hɉpȊO̕܂܂Ă܂B</FONT><P>\n";
  }
  elsif ( $pas1 ne '' && $pas1 ne $pas2 ){
    print "<FONT COLOR=red>mF̂߂ɓ͂ꂽVpX[hv܂B</FONT><P>\n";
  }
  elsif ( $start != 1 && $psold eq '' ) {
    print "<FONT COLOR=red>pX[h͂ĉB</FONT><P>\n";
  }
  elsif ( $start != 1 && (crypt($psold, substr($password, $salt, 2) ) ne $password) ){
    print "<FONT COLOR=red>pX[hF؂܂łB</FONT><P>\n";
  }
  else {
    $now = time;
    ($p1, $p2) = unpack("C2", $now);
    $wk = $now / (60 * 60 * 24 * 7) + $p1 + $p2 - 8;
    @saltset = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
    $nsalt = $saltset[$wk % 64] . $saltset[$now % 64];
    $pwd = crypt($FORM{'password'}, $nsalt);

    if ( !open(DB,">$pass") ) { &error('0'); }
    print DB "crypt_password:$pwd\n";
    close(DB);
    print "<FONT COLOR=blue SIZE=+3>Ǘ҃pX[hݒ\܂B";
    print "<BR><A HREF=\"$bbsscript\">[mdws]</A>NbNĉB";
    print "</FONT><P>ēxύXꍇ͉LtH[ōē͂ȂĉB<P>\n";
  }
  print "<FORM method=\"POST\" action=\"$reload?pas\">\n";
  print "<INPUT type=\"hidden\" name=\"papost\" value=\"pcode\">\n";
  if ($start != 1) {
    print "pX[h <INPUT type=\"password\" name=\"password_old\" size=\"8\" maxlength=\"8\"><BR>\n";
  }
  print <<"_HTML_";
VpX[h <INPUT type="password" name="password" size="8" maxlength="8">ippWȓj<BR>
VpX[h <INPUT type="password" name="password2" size="8" maxlength="8">imF̂ߏƓpXxj<P>
<INPUT type="submit" value="     o^     ">
</FORM><P>
</BODY>
</HTML>
_HTML_
  exit;
}

#--- 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__
