#!/usr/bin/perl
###########################
##  AutoRank Pro v3.0.x  ##
##################################################
##  accounts.cgi - add/edit accounts interface  ##
##################################################

package acct;

use lib '.';                                      ## You may need to set this to the full path to the directory where cgiworks.pm is located
use strict;
use cgiworks;

my %map = (
            'login'  => \&display_login,
            'remind' => \&display_remind
          );

my %fnct = (
             'display_edit'  => \&display_edit,
             'display_stats' => \&display_stats,
             'display_farm'  => \&display_farm,
             'edit_account'  => \&edit_account,
             'send_password' => \&send_password,
             'add_account'   => \&add_account
           );

print "Content-type: text/html\n\n";
$HEADER = 1;

eval {
  require 'arp.pl';
  main();
};

err("$@", 'accounts.cgi') if( $@ );
exit;

#####################################################################
##  Removing the link back to CGI Works is a copyright violation.  ##
##  Altering or removing any of the code that is responsible, in   ##
##  any way, for generating that link is strictly forbidden.       ##
##  Anyone violating the above policy will have their license      ##
##  terminated on the spot.  Do not remove that link - ever.       ##
#####################################################################

sub main {
  $TPL{'NFD1'} = $VAR::F1;
  $TPL{'NFD2'} = $VAR::F2;
  $TPL{'NFD3'} = $VAR::F3;
  if( $REQMTH eq 'GET' ) {
    if( $map{$ENV{'QUERY_STRING'}} ) {
      &{ $map{$ENV{'QUERY_STRING'}} };
    }
    else {
      display_main();
    }
  }
  elsif( $REQMTH eq 'POST' ) {
    parsepost(1);

    derr(1002, "No Function Selected") if( !$fnct{$FRM{'fnct'}} );
    &{$fnct{$FRM{'fnct'}}};

  }
}

sub display_main {
  $TPL{'CATS'} = arp::getcats();
  fparse('_account_add.htmlt');
}

sub display_edit {
  derr(1003, "Account Not Found") if( !-e "$DDIR/members/$FRM{'unm'}.dat" );
  my $md = fsplit("$DDIR/members/$FRM{'unm'}.dat");
  derr(1005, "Suspended Account") if( int($md->[20]) );
  derr(1006, "Locked Account") if( int($md->[21]) );
  derr(1004, "Invalid Password") if( !validpass($md->[18], $FRM{'pwd'}) );

  $TPL{'NFD1'} = $VAR::F1;
  $TPL{'NFD2'} = $VAR::F2;
  $TPL{'NFD3'} = $VAR::F3;
  $TPL{'EMAL'} = $md->[0];
  $TPL{'SURL'} = $md->[1];
  $TPL{'TITL'} = $md->[6];
  $TPL{'DESC'} = $md->[7];
  $TPL{'BURL'} = $md->[2];
  $TPL{'BHT'}  = $md->[3];
  $TPL{'BWD'}  = $md->[4];
  $TPL{'RURL'} = $md->[5];
  $TPL{'CAT'}  = $md->[8];
  $TPL{'CATS'} = arp::getcats($md->[8]);
  $TPL{'USER'} = $FRM{'unm'};
  $TPL{'PASS'} = $FRM{'pwd'};
  $TPL{'FLD1'} = $md->[23];
  $TPL{'FLD2'} = $md->[24];
  $TPL{'FLD3'} = $md->[25];
  fparse('_account_edit.htmlt');
}

sub display_stats {
  derr(1003, "Account Not Found") if( !-e "$DDIR/members/$FRM{'unm'}.dat" );
  my $md = fsplit("$DDIR/members/$FRM{'unm'}.dat");
  derr(1004, "Invalid Password") if( !validpass($md->[18], $FRM{'pwd'}) );
  my $cd = fsplit("$DDIR/members/$FRM{'unm'}.cnt");

  $TPL{'IN'}  = int( $cd->[0] * $cd->[5] );
  $TPL{'OUT'} = $cd->[1];
  $TPL{'TIN'}  = int( $cd->[2] * $cd->[5] );
  $TPL{'TOUT'} = $cd->[3];
  my $age = (time + 3600 * $VAR::TZ) - $cd->[8];
  $TPL{'START'} = fdate($VAR::DF, $cd->[8]) . ' ' . ftime($VAR::TF, $cd->[8]);
  $TPL{'IPDAY'} = arp::getavg($TPL{'TIN'}, $age, 86400);
  $TPL{'IPWEK'} = arp::getavg($TPL{'TIN'}, $age, 604800);
  $TPL{'IPMTH'} = arp::getavg($TPL{'TIN'}, $age, 2592000);
  $TPL{'OPDAY'} = arp::getavg($TPL{'TOUT'}, $age, 86400);
  $TPL{'OPWEK'} = arp::getavg($TPL{'TOUT'}, $age, 604800);
  $TPL{'OPMTH'} = arp::getavg($TPL{'TOUT'}, $age, 2592000);

  fparse('_account_statst.htmlt');
  printstats($FRM{'unm'});
  tprint('_account_statsb.htmlt');
}

sub display_farm {
  derr(1001, "No Username Entered") if( $FRM{'unm'} eq '' );
  $TPL{'TURL'} = $VAR::IU . "?id=$FRM{'unm'}";
  fparse('_account_farm.htmlt');
}

sub display_login {
  tprint('_account_login.htmlt');
}

sub display_remind {
  tprint('_account_remind.htmlt');
}

##############################################################################
##############################################################################

sub add_account {
  checkinput(1);
  checkdup() if( $OPT::DUP );

  $TPL{'USER'} = $FRM{'user'};
  $TPL{'PASS'} = $FRM{'pass'};
  $TPL{'RURL'} = $FRM{'rurl'};
  $TPL{'BURL'} = $FRM{'burl'};
  $TPL{'BHT'}  = $FRM{'bht'};
  $TPL{'BWD'}  = $FRM{'bwd'};
  $TPL{'SURL'} = $FRM{'surl'};
  $TPL{'TITL'} = $FRM{'tit'};
  $TPL{'DESC'} = $FRM{'desc'};
  $TPL{'CAT'}  = $FRM{'cat'};
  $TPL{'TO'}   = $TPL{'EMAL'} = $FRM{'email'};
  $TPL{'FROM'} = $VAR::EM;
  $TPL{'FLD1'} = $FRM{'fld1'};
  $TPL{'FLD2'} = $FRM{'fld2'};
  $TPL{'FLD3'} = $FRM{'fld3'};
  $TPL{'TURL'} = $VAR::IU . "?id=$FRM{'user'}";
  $TPL{'LURL'} = $VAR::CU . "/accounts.cgi?login";
 
  mail($VAR::ES, freadalls("$TDIR/_email_admin.etmpl"), \%TPL) if( $OPT::ADM );
 
  my $upass = pack('u', $FRM{'pass'});
  chomp( $upass );
  
  $OPT::REV ? review($upass) : add($upass);
}

sub add {
  my $upass = shift;

  if( $upass ) {
  fjoin("$DDIR/members/$FRM{'user'}.dat", $FRM{'email'}, $FRM{'surl'}, $FRM{'burl'}, $FRM{'bht'}, $FRM{'bwd'}, $FRM{'rurl'}, $FRM{'tit'}, $FRM{'desc'}, $FRM{'cat'}, '', time, '1:1', '1.000', 'N/A', 'N/A', 'N/A', 'N/A', 'N/A', crypt($FRM{'pass'}, getsalt()), $upass, 0, 0, 0, $FRM{'fld1'}, $FRM{'fld2'}, $FRM{'fld3'});
  fjoin("$DDIR/members/$FRM{'user'}.cnt", 0, 0, 0, 0, '1:1', '1.000', $FRM{'cat'}, 0, time);
  fappend("$DDIR/dbs/sites", $FRM{'user'} . "\n");
  fappend("$DDIR/dbs/search", "$FRM{'user'}|$FRM{'tit'}|$FRM{'cat'}|$FRM{'surl'}|$FRM{'desc'}\n");
  fcreate("$DDIR/members/$FRM{'user'}.sts");

  mail($VAR::ES, freadalls("$TDIR/_email_added.etmpl"), \%TPL) if( $OPT::EML );

  fparse('_account_added.htmlt');
  }
}

sub review {
  my $upass = shift;
  if( $upass ) {
  dbinsert("$DDIR/dbs/review.db", '\|', $FRM{'user'}, $FRM{'email'}, $FRM{'surl'}, $FRM{'burl'}, $FRM{'bht'}, $FRM{'bwd'}, $FRM{'rurl'}, $FRM{'tit'}, $FRM{'desc'}, $FRM{'cat'}, '', time, '1:1', '1.000', 'N/A', 'N/A', 'N/A', 'N/A', 'N/A', crypt($FRM{'pass'}, getsalt()), $upass, 0, 0, 0, $FRM{'fld1'}, $FRM{'fld2'}, $FRM{'fld3'});
  
  mail($VAR::ES, freadalls("$TDIR/_email_review.etmpl"), \%TPL) if( $OPT::EML );
  
  fparse('_account_review.htmlt');
  }
}

sub edit_account {
  checkinput(undef);
  my $md = fsplit("$DDIR/members/$FRM{'user'}.dat");
  derr(1004, "Invalid Password") if( !validpass($md->[18], $FRM{'opwd'}) );

  $TPL{'USER'} = $FRM{'user'};
  $TPL{'EMAL'} = $md->[0]  = $FRM{'email'};
  $TPL{'FROM'} = $VAR::EM;
  $TPL{'SURL'} = $md->[1]  = $FRM{'surl'};
  $TPL{'BURL'} = $md->[2]  = $FRM{'burl'};
  $TPL{'BHT'}  = $md->[3]  = $FRM{'bht'};
  $TPL{'BWD'}  = $md->[4]  = $FRM{'bwd'};
  $TPL{'RURL'} = $md->[5]  = $FRM{'rurl'};
  $TPL{'TITL'} = $md->[6]  = $FRM{'tit'};
  $TPL{'DESC'} = $md->[7]  = $FRM{'desc'};
  $md->[18] = crypt($FRM{'pass'}, getsalt());
  $md->[19] = pack('u', $FRM{'pass'});
  chomp($md->[19]);
  $TPL{'PASS'} = $FRM{'pass'};
  $TPL{'CAT'}  = $md->[8];
  $TPL{'CAT'}  = $md->[8] = $FRM{'cat'} if( $FRM{'cat'} );
  $TPL{'FLD1'} = $md->[23];
  $TPL{'FLD2'} = $md->[24];
  $TPL{'FLD3'} = $md->[25];
  $TPL{'FLD1'} = $md->[23] = $FRM{'fld1'} if( exists $FRM{'fld1'} );
  $TPL{'FLD2'} = $md->[24] = $FRM{'fld2'} if( exists $FRM{'fld2'} );
  $TPL{'FLD3'} = $md->[25] = $FRM{'fld3'} if( exists $FRM{'fld3'} );

  fjoin("$DDIR/members/$FRM{'user'}.dat", @{ $md });

  my $cd = fsplit("$DDIR/members/$FRM{'user'}.cnt");
  $cd->[6] = $TPL{'CAT'};
  fjoin("$DDIR/members/$FRM{'user'}.cnt", @{ $cd } );

  dbupdate("$DDIR/dbs/search", $FRM{'user'}, '\|', $FRM{'user'}, $md->[6], $md->[8], $md->[1], $md->[7]);

  mail($VAR::ES, freadalls("$TDIR/_email_edit.etmpl"), \%TPL) if( $OPT::EDT );

  fparse('_account_edited.htmlt');
}

sub send_password {
  my $found = 0;
  
  for( @{ dread("$DDIR/members", '\.dat$') } ) {
    my $md = fsplit("$DDIR/members/$_");
    
    if( $md->[0] eq $FRM{'email'} ) {
      $found = 1;
      
      my $user = $_;
      $user =~ s/\.dat$//g;
      $TPL{'PASS'} = unpack('u', $md->[19]);
      $TPL{'USER'} = $user;
      $TPL{'TO'}   = $FRM{'email'};
      $TPL{'FROM'} = $VAR::EM;
      $TPL{'TURL'} = $VAR::IU . "?id=$user";
      $TPL{'LURL'} = $VAR::CU . "/accounts.cgi?login";
      
      mail($VAR::ES, freadalls("$TDIR/_email_remind.etmpl"), \%TPL);
      last;
    }
  }
  close(DB);

  derr(1013, 'E-mail Address Not Found') unless($found);  
  fparse('_account_reminded.htmlt');
}

sub printstats {
  my $id = shift;
  open(FILE, "$DDIR/members/$id.sts") || err($!, 'stats');
  for( reverse <FILE> ) {
    my @stats = split(/\|/, $_);
    $TPL{'DATE'} = $stats[0];
    $TPL{'IN'}   = int( $stats[1] * $stats[6] );
    $TPL{'OUT'}  = $stats[2];
    $TPL{'TIN'}  = int( $stats[3] * $stats[6] );
    $TPL{'TOUT'} = $stats[4];
    my $age = $stats[11] - $stats[7];
    $TPL{'IPDAY'} = arp::getavg($TPL{'TIN'}, $age, 86400);
    $TPL{'IPWEK'} = arp::getavg($TPL{'TIN'}, $age, 604800);
    $TPL{'IPMTH'} = arp::getavg($TPL{'TIN'}, $age, 2592000);
    $TPL{'OPDAY'} = arp::getavg($TPL{'TOUT'}, $age, 86400);
    $TPL{'OPWEK'} = arp::getavg($TPL{'TOUT'}, $age, 604800);
    $TPL{'OPMTH'} = arp::getavg($TPL{'TOUT'}, $age, 2592000);
    $TPL{'RANK'}  = $stats[8];
    $TPL{'CRANK'} = $stats[9];
    fparse('_account_statsm.htmlt');
  }
  close(FILE);
}

sub checkdup {
  for( @{ dread("$DDIR/members", '\.dat') } ) {
    my $md = fsplit("$DDIR/members/$_");
    derr(1021, "Duplicate Account") if( $FRM{'surl'} eq $md->[1] || $FRM{'tit'} eq $md->[6] );
  }

 
  if( $OPT::REV ) {
    open(REV, "$DDIR/dbs/review.db") || serr($!, "$DDIR/dbs/review.db");
    for( <REV> ) {
      my @md = split(/\|/, $_);
      derr(1021, "Duplicate Account") if( $FRM{'surl'} eq $md[2] || $FRM{'tit'} eq $md[7] );
    }
    close(REV);
  }
}

sub checkinput {
  my $adding = shift;
  derr(1012, "Username Taken") if( $adding && (-e "$DDIR/members/$FRM{'user'}.dat" || dbselect("$DDIR/dbs/review.db", $FRM{'user'}, '\|')) );

  checkbans();

  derr(1008, "Invalid E-mail Address") if( $FRM{'email'} !~ /^[\w\d][\w\d\,\.\-]*\@([\w\d\-]+\.)+([a-zA-Z]{3}|[a-zA-Z]{2})$/ );
  derr(1009, "Invalid Site URL") if( $FRM{'surl'} !~ /^http:\/\/[\w\d\-\.]+\.[\w\d\-\.]+/ );
  derr(1009, "Invalid Banner URL") if( $FRM{'burl'} ne '' && $FRM{'burl'} !~ /^http:\/\/[\w\d\-\.]+\.[\w\d\-\.]+/ );
  derr(1009, "Invalid Reciprocal URL") if( $OPT::RCP && $FRM{'rurl'} !~ /^http:\/\/[\w\d\-\.]+\.[\w\d\-\.]+/ );
  derr(1010, "Site Title Oversized") if( length( $FRM{'tit'} ) > int( $VAR::MT ) );
  derr(1010, "Description Oversized") if( length( $FRM{'desc'} ) > int( $VAR::MD ) );
  derr(1010, "Username Too Short") if( $adding && length( $FRM{'user'} ) < 4 );
  derr(1010, "Username Too Long") if( $adding && length( $FRM{'user'} ) > 8 );
  derr(1011, "Invalid Character In Username") if( $FRM{'user'} !~ m/^[a-zA-Z0-9]+$/gi );
  derr(1010, "Password Too Short") if( length( $FRM{'pass'} ) < 4 );
  derr(1001, "Title or Description Blank") if( $FRM{'tit'} eq '' || $FRM{'desc'} eq '' );

  ## Check user defined fields
  derr(1001, "$VAR::F1 Left Blank") if( $OPT::FD1 && $FRM{'fld1'} eq '' );
  derr(1001, "$VAR::F2 Left Blank") if( $OPT::FD2 && $FRM{'fld2'} eq '' );
  derr(1001, "$VAR::F3 Left Blank") if( $OPT::FD3 && $FRM{'fld3'} eq '' );

  ## Check URLs that were supplied
  if( $OPT::LWP && $OPT::CHU ) {
    require 'lwp.pl';
    lwp::checkurl($FRM{'surl'});
    lwp::checkurl($FRM{'burl'}) if( $FRM{'burl'} ne '' );
    lwp::checkurl($FRM{'rurl'}) if( $FRM{'rurl'} ne '' );
  }

  ## If a banner URL is supplied, check the width and height
  if( $FRM{'burl'} ne '' ) {
    derr(1017, "Banner Height Too Large") if( $FRM{'bht'} > $VAR::BH );
    derr(1017, "Banner Width Too Large") if( $FRM{'bwd'} > $VAR::BW );
    $FRM{'bht'} = $VAR::BH if( $FRM{'bht'} eq '' );
    $FRM{'bwd'} = $VAR::BW if( $FRM{'bwd'} eq '' );
  }

  ## If no banner is supplied, but a default banner has been setup, use the default
  if( $FRM{'burl'} eq '' && $VAR::DB ne '' ) {
    $FRM{'burl'} = $VAR::DB;
    $FRM{'bht'}  = $VAR::DH;
    $FRM{'bwd'}  = $VAR::DW;
  }

  for( keys %FRM ) {
    $FRM{$_} =~ s/\|//g;
    $FRM{$_} =~ s/\r//g;
    $FRM{$_} =~ s/\n//g;
  }
}

sub checkbans {
  my( @files ) = qw(email.ban url.ban word.ban);
  my( $file, $ban );
  
  foreach $file ( @files ) {
    my $bans = freadall("$DDIR/dbs/$file");

    foreach $ban ( @{ $bans } ) {
      next if( $ban eq '' );
      chomp( $ban );
      derr(1007, "Banned Domain '$ban'") if( $file eq "url.ban" && $FRM{'surl'} =~ m/$ban/gi );
      derr(1007, "Banned E-Mail '$ban'") if( $file eq "email.ban" && $FRM{'email'} =~ m/$ban/gi);
      derr(1007, "Banned Word '$ban'") if( $file eq "word.ban" && $FRM{'desc'} =~ m/\b$ban\b/gi);
      derr(1007, "Banned Word '$ban'") if( $file eq "word.ban" && $FRM{'tit'} =~ m/\b$ban\b/gi);
    }
  }
}