F:\WEBSITES\testbed\zipped\yabb_svn_new\branches\2.5.2\cgi-bin\yabb2\Sources\Security.pl F:\WEBSITES\testbed\zipped\yabb_svn_new\trunk\cgi-bin\yabb2\Sources\Security.pm
############################################################################### ###############################################################################
# Security.pl                                                                 # # Security.pm                                                                 #
  # $Date: 01.05.16 $                                                           #
############################################################################### ###############################################################################
# YaBB: Yet another Bulletin Board                                            # # YaBB: Yet another Bulletin Board                                            #
# Open-Source Community Software for Webmasters                               # # Open-Source Community Software for Webmasters                               #
# Version:        YaBB 2.5.2                                                  # # Version:        YaBB 2.6.12                                                 #
# Packaged:       October 21, 2012                                            # # Packaged:       January 5, 2016                                             #
# Distributed by: http://www.yabbforum.com                                    # # Distributed by: http://www.yabbforum.com                                    #
# =========================================================================== # # =========================================================================== #
# Copyright (c) 2000-2012 YaBB (www.yabbforum.com) - All Rights Reserved.     # # Copyright (c) 2000-2016 YaBB (www.yabbforum.com) - All Rights Reserved.     #
# Software by:  The YaBB Development Team                                     # # Software by:  The YaBB Development Team                                     #
#               with assistance from the YaBB community.                      # #               with assistance from the YaBB community.                      #
############################################################################### ###############################################################################
  # use strict;
  # use warnings;
  # no warnings qw(uninitialized once redefine);
  use CGI::Carp qw(fatalsToBrowser);
  our $VERSION = '2.6.12';
   
$securityplver = 'YaBB 2.5.2 $Revision: 1.0 $'; $securitypmver = 'YaBB 2.6.12 $Revision: 1651 $';
   
# Updates profile with current IP, if changed from last IP. # Updates profile with current IP, if changed from last IP.
# Will only actually update the file when .vars is being updated anyway to save extra load on server. # Will only actually update the file when .vars is being updated anyway to save extra load on server.
if (${$uid.$username}{'lastips'} !~ /^$user_ip\|/) { if ( ${ $uid . $username }{'lastips'} !~ /^$user_ip\|/xsm ) {
   ${$uid.$username}{'lastips'} = "$user_ip|${$uid.$username}{'lastips'}";    ${ $uid . $username }{'lastips'} = "$user_ip|${$uid.$username}{'lastips'}";
   ${$uid.$username}{'lastips'} =~ s/^(.*?\|.*?\|.*?)\|.*/$1/;     ${ $uid . $username }{'lastips'} =~ s/^(.*?\|.*?\|.*?)\|.*/$1/xsm; 
} }
   
$scripturl = "$boardurl/$yyexec.$yyext"; $scripturl = "$boardurl/$yyexec.$yyext";
$adminurl  = "$boardurl/AdminIndex.$yyaext"; $adminurl  = "$boardurl/AdminIndex.$yyaext";
   
# BIG board check # BIG board check
if ($INFO{'board'}  =~ m~/~) { ($INFO{'board'},  $INFO{'start'}) = split('/', $INFO{'board'}); }  if ( $INFO{'board'} =~ m{/}xsm ) { 
if ($INFO{'num'}    =~ m~/~) { ($INFO{'num'},    $INFO{'start'}) = split('/', $INFO{'num'}); }     ( $INFO{'board'}, $INFO{'start'} ) = split /\//xsm, $INFO{'board'}; 
if ($INFO{'letter'} =~ m~/~) { ($INFO{'letter'}, $INFO{'start'}) = split('/', $INFO{'letter'}); } }
if ($INFO{'thread'} =~ m~/~) { ($INFO{'thread'}, $INFO{'start'}) = split('/', $INFO{'thread'}); }  if ( $INFO{'num'} =~ m{/}xsm ) { 
     ( $INFO{'num'}, $INFO{'start'} ) = split /\//xsm, $INFO{'num'};
  }
  if ( $INFO{'letter'} =~ m{/}xsm ) {
     ( $INFO{'letter'}, $INFO{'start'} ) = split /\//xsm, $INFO{'letter'};
  }
  if ( $INFO{'thread'} =~ m{/}xsm ) {
     ( $INFO{'thread'}, $INFO{'start'} ) = split /\//xsm, $INFO{'thread'};
  }
   
# BIG thread check # BIG thread check
$curnum = $INFO{'num'} || $INFO{'thread'} || $FORM{'threadid'}; $curnum = $INFO{'num'} || $INFO{'thread'} || $FORM{'threadid'};
if ($curnum ne '') { if ( $curnum ne q{} ) {
   if ($curnum =~ /\D/) { &fatal_error("only_numbers_allowed","Thread ID: '$curnum'"); }     if ( $curnum =~ /\D/xsm ) { 
   if (!-e "$datadir/$curnum.txt") {         fatal_error( 'only_numbers_allowed', "Thread ID: '$curnum'" ); 
       eval { require "$datadir/movedthreads.cgi" };     } 
       &fatal_error("not_found","$datadir/$curnum.txt") if !$moved_file{$curnum};     if ( !-e "$datadir/$curnum.txt" ) { 
       while (exists $moved_file{$curnum}) {         if ( eval { require Variables::Movedthreads; 1 } ) { 
           $curnum = $moved_file{$curnum};             if ( !$moved_file{$curnum} ) { 
           next if exists $moved_file{$curnum};                 fatal_error( 'no_topic_found', $curnum ); 
           if (!-e "$datadir/$curnum.txt") { &fatal_error("not_found","$datadir/$curnum.txt"); }            }
       }             while ( exists $moved_file{$curnum} ) { 
       $INFO{'num'} = $INFO{'thread'} = $FORM{'threadid'} = $curnum;                 $curnum = $moved_file{$curnum}; 
   }                 next if exists $moved_file{$curnum}; 
                 if ( !-e "$datadir/$curnum.txt" ) {
   &MessageTotals('load', $curnum);                     fatal_error( 'no_topic_found', $curnum ); 
   $currentboard = ${$curnum}{'board'};                 } 
} else {             } 
   $currentboard = $INFO{'board'};             $INFO{'num'} = $INFO{'thread'} = $FORM{'threadid'} = $curnum; 
}        }
     }
if ($currentboard ne '') {  
   if ($currentboard !~ /\A[\s0-9A-Za-z#%+,-\.:=?@^_]+\Z/) { &fatal_error("invalid_character","$maintxt{'board'}"); }     MessageTotals( 'load', $curnum ); 
   if (!-e "$boardsdir/$currentboard.txt") { &fatal_error("cannot_open","$boardsdir/$currentboard.txt"); }     $currentboard = ${$curnum}{'board'}; 
   ($boardname, $boardperms, $boardview) = split(/\|/, $board{"$currentboard"});  }
   my $access = &AccessCheck($currentboard, '', $boardperms);  else { 
   if (!$iamadmin && $access ne "granted" && $boardview != 1) { &fatal_error("no_access"); }     $currentboard = $INFO{'board'}; 
   
   # Determine what category we are in.  
   $catid = ${$uid.$currentboard}{'cat'};  
   ($cat, $catperms) = split(/\|/, $catinfo{"$catid"});  
   $cataccess = &CatAccess($catperms);  
   unless ($annboard ne "" && $currentboard eq $annboard) {  
       if (!$cataccess) { &fatal_error("no_access"); }  
   }  
   
   $bdescrip = ${$uid.$currentboard}{'description'};  
   
   # Create Hash %moderators and %moderatorgroups with all Moderators of the current board  
   foreach (split(/, ?/, ${$uid.$currentboard}{'mods'})) {  
       &LoadUser($_);  
       $moderators{$_} = ${$uid.$_}{'realname'};  
   }  
   foreach (split(/, /, ${$uid.$currentboard}{'modgroups'})) {  
       $moderatorgroups{$_} = $_;  
   }  
   
   if ($staff) {  
       $iammod = &is_moderator($username,$currentboard);  
       $staff = 0 if !$iammod && !$iamadmin && !$iamgmod;  
   }  
   
   unless ($iamadmin) {  
       my $accesstype = "";  
       if ($action eq "post") {  
           if ($INFO{'title'} eq 'CreatePoll' || $INFO{'title'} eq 'AddPoll') {  
               $accesstype = 3;    # Post Poll  
           } elsif ($INFO{'num'}) {  
               $accesstype = 2;    # Post Reply  
           } else {  
               $accesstype = 1;    # Post Thread  
           }  
       }  
       my $access = &AccessCheck($currentboard, $accesstype);  
       if ($access ne "granted") { &fatal_error("no_access"); }  
   }  
   
   fopen(BOARDFILE, "$boardsdir/$currentboard.txt") || &fatal_error("not_found","$boardsdir/$currentboard.txt", 1);  
   while ($yyThreadLine = <BOARDFILE>) {  
       if ($yyThreadLine =~ m~\A$curnum\|~o) { last; }  
   }  
   fclose(BOARDFILE);  
   chomp $yyThreadLine;  
   
} else {  
   ### BIG category check  
   $currentcat = $INFO{'cat'} || $INFO{'catselect'};  
   if ($currentcat ne '') {  
       if ($currentcat =~ m~/~)  { &fatal_error("no_cat_slash"); }  
       if ($currentcat =~ m~\\~) { &fatal_error("no_cat_backslash"); }  
       if ($currentcat ne '' && $currentcat !~ /\A[\s0-9A-Za-z#%+,-\.:=?@^_]+\Z/) { &fatal_error("invalid_character","$maintxt{'cat'}"); }  
       if (!$cat{$currentcat}) { &fatal_error("cannot_open","$currentcat"); }  
   
       #  and need cataccess check!  
       $cataccess = &CatAccess($catperms);  
       if (!$cataccess) { &fatal_error("no_access"); }  
   }  
} }
   
sub is_admin { if (!$iamadmin) { &fatal_error("no_access"); } }  if ( $currentboard ne q{} ) { 
     if ( $currentboard !~ /\A[\s0-9A-Za-z#%+,-\.:=?@^_]+\Z/xsm ) {
         fatal_error( 'invalid_character', "$maintxt{'board'}" );
     }
     if ( !-e "$boardsdir/$currentboard.txt" ) {
         fatal_error( 'cannot_open', "$boardsdir/$currentboard.txt" );
     }
     ( $boardname, $boardperms, $boardview ) =
       split /\|/xsm, $board{$currentboard};
     my $access = AccessCheck( $currentboard, q{}, $boardperms );
     if ( !$iamadmin && $access ne 'granted' && $boardview != 1 ) {
         fatal_error('no_access');
     }
   
     # Determine what category we are in.
     $catid = ${ $uid . $currentboard }{'cat'};
     ( $cat, $catperms ) = split /\|/xsm, $catinfo{$catid};
     $cataccess = CatAccess($catperms);
     if ( $annboard eq q{} || $currentboard ne $annboard ) {
         if ( !$cataccess ) { fatal_error('no_access'); }
     }
   
     $bdescrip = ${ $uid . $currentboard }{'description'};
   
  # Create Hash %moderators and %moderatorgroups with all Moderators of the current board
     foreach ( split /, ?/sm, ${ $uid . $currentboard }{'mods'} ) {
         LoadUser($_);
         $moderators{$_} = ${ $uid . $_ }{'realname'};
     }
     foreach ( split /, /sm, ${ $uid . $currentboard }{'modgroups'} ) {
         $moderatorgroups{$_} = $_;
     }
   
     if ($staff) {
         $iammod = is_moderator( $username, $currentboard );
         if ( !$iammod && !$iamadmin && !$iamgmod && !$iamfmod ) { $staff = 0; }
     }
   
     if ( !$iamadmin ) {
         my $accesstype = q{};
         if ( $action eq 'post' ) {
             if ( $INFO{'title'} eq 'CreatePoll' || $INFO{'title'} eq 'AddPoll' )
             {
                 $accesstype = 3;    # Post Poll
             }
             elsif ( $INFO{'num'} ) {
                 $accesstype = 2;    # Post Reply
             }
             else {
                 $accesstype = 1;    # Post Thread
             }
         }
         $access = AccessCheck( $currentboard, $accesstype );
         if ( $access ne 'granted' ) { fatal_error('no_access'); }
     }
   
     fopen( BOARDFILE, "$boardsdir/$currentboard.txt" )
       or fatal_error( 'no_board_found', $currentboard, 1 );
     while ( $yyThreadLine = <BOARDFILE> ) {
         if ( $yyThreadLine =~ m{\A$curnum\|}oxsm ) { last; }
     }
     fclose(BOARDFILE);
     chomp $yyThreadLine;
   
  }
  else {
     ### BIG category check
     $currentcat = $INFO{'cat'} || $INFO{'catselect'};
     if ( $currentcat ne q{} ) {
         if ( $currentcat =~ m{/}xsm )  { fatal_error('no_cat_slash'); }
         if ( $currentcat =~ m{\\}xsm ) { fatal_error('no_cat_backslash'); }
         if (   $currentcat ne q{}
             && $currentcat !~ /\A[\s0-9A-Za-z#%+,-\.:=?@^_]+\Z/xsm )
         {
             fatal_error( 'invalid_character', "$maintxt{'cat'}" );
         }
         if ( !$cat{$currentcat} ) {
             fatal_error( 'cannot_open', "$currentcat" );
         }
   
         #  and need cataccess check!
         $cataccess = CatAccess($catperms);
         if ( !$cataccess ) { fatal_error('no_access'); }
     }
  }
   
  sub is_admin {
     if ( !$iamadmin ) { fatal_error('no_access'); }
     return;
  }
   
sub is_admin_or_gmod { sub is_admin_or_gmod {
   if (!$iamadmin && !$iamgmod) { &fatal_error("no_access"); }    if ( !$iamadmin && !$iamgmod ) { fatal_error('no_access'); }
   
     if ( $iamgmod && $action ne q{} ) {
         require "$vardir/gmodsettings.txt";
         if (   $gmod_access{"$action"} ne 'on' 
             && $gmod_access2{"$action"} ne 'on' )
         {
             fatal_error('no_access');
         }
     }
     return;
  }
   
  sub is_admin_or_gmod_or_fmod {
     if ( !$iamadmin && !$iamgmod && !$iamfmod ) { fatal_error('no_access'); }
   
   if ($iamgmod && $action ne "") {    if ( $iamgmod && $action ne q{} ) {
       require "$vardir/gmodsettings.txt";        require "$vardir/gmodsettings.txt";
       if ($gmod_access{"$action"} ne "on" && $gmod_access2{"$action"} ne "on") {         if (   $gmod_access{"$action"} ne 'on' 
           &fatal_error("no_access");             && $gmod_access2{"$action"} ne 'on' ) 
       }         { 
   }             fatal_error('no_access'); 
         }
     }
     return;
} }
   
sub banning { sub banning {
   my $ban_user   = $_[0] || $username;     my @x          = @_; 
   my $ban_email  = $_[1] || ${$uid.$username}{'email'};     my $ban_user   = $x[0] || $username; 
   my $admincheck = $_[2];     my $ban_email  = $x[1] || ${ $uid . $username }{'email'}; 
     my $admincheck = $x[2];
   if (!$admincheck && $username eq "admin" && $iamadmin) { return; }  
     if ( !$admincheck && ( $username eq 'admin' || $iamadmin ) ) { return; }
   foreach (split(/,/, $ip_banlist)) { # IP BANNING  
       &write_banlog("$user_ip") if $user_ip =~ /^$_/;     *write_banlog = sub { 
   }         my ($bantry) = @_; 
   if (!$iamguest || $action eq 'register2') {        if ($admincheck) {
       foreach (split(/,/, $email_banlist)) { # EMAIL BANNING             fatal_error( 'banned', 
           &write_banlog("$_ ($user_ip)") if $ban_email =~ /$_/i;                 "$register_txt{'678'}$register_txt{'430'}!" ); 
       }        }
       foreach (split(/,/, $user_banlist)) { # USERNAME BANNING         fopen( LOG, ">>$vardir/ban_log.txt" ); 
           &write_banlog("$_ ($user_ip)") if $ban_user =~ m/^$_$/;         print {LOG} "$date|$bantry\n" or croak "$croak{'print'} LOG"; 
       }         fclose(LOG); 
   }         UpdateCookie( 'delete', $ban_user ); 
         $username = 'Guest';
   sub write_banlog {         $iamguest = 1; 
       &admin_fatal_error("banned","$register_txt{'678'}$register_txt{'430'}!") if $admincheck;         fatal_error( 'banned', "$security_txt{'678'}$security_txt{'430'}!" ); 
       fopen(LOG, ">>$vardir/ban_log.txt");     }; 
       print LOG "$date|$_[0]\n";     my $tmb     = 0; 
       fclose(LOG);     $time    = time; 
       &UpdateCookie("delete", $ban_user);     *time_ban = sub { 
       $username = "Guest";         for my $i ( 0 .. 3 ) { 
       $iamguest = 1;             if ( $banned[4] eq $timeban[$i] ) { 
       &fatal_error("banned","$security_txt{'678'}$security_txt{'430'}!");                 $tmb = $banned[2] + ( $bandays[$i] * 84_600 ); 
   }            }
         }
         return $tmb;
     };
     fopen( BAN, "<$vardir/banlist.txt" )
       or fatal_error( 'cannot_open', "$vardir/banlist.txt", 1 );
     @banlist = <BAN>;
     for my $i (@banlist) {
         chomp $i;
         @banned = split /\|/xsm, $i;
         $tmp = time_ban();
   
         # IP BANNING
         if ( $user_ip =~ /^$banned[1]/xsm ) { write_banlog("$user_ip"); }
         if ( !$iamguest || $action eq 'register2' ) {
   
             # EMAIL BANNING
             if ( $ban_email =~ m/^$banned[1]/ixsm
                 && ( $tmb > $time || $banned[4] eq 'p' ) )
             {
                 write_banlog("$banned[1]($user_ip)");
             }
   
             # USERNAME BANNING
             if ( $ban_user =~ m/^$banned[1]$/sm
                 && ( $tmb > $time || $banned[4] eq 'p' ) )
             {
                 write_banlog("$banned[1]($user_ip)");
             }
         }
     }
     fclose(BAN);
   
     return;
} }
   
sub check_banlist { sub check_banlist {
   # &check_banlist("email","IP","username"); - will return true if banned by any means  
   # This sub can be passed email address, IP, unencoded username or any combination thereof  
   
   # Returns E if banned by email address  # &check_banlist("email","IP","username"); - will return true if banned by any means 
   # Returns I if banned by IP address  # This sub can be passed email address, IP, unencoded username or any combination thereof 
   # Returns U if banned by username  
   # Returns all banning methods, unseperated (eg "EIU" if banned by all methods)  
   
   my ($e_ban, $ip_ban, $u_ban) = @_;  
   my $ban_rtn;  
   
   if ($e_ban && $email_banlist) {  
       foreach (split(/,/, $email_banlist)) { if ($_ eq $e_ban)  { $ban_rtn .= 'E'; last; } }  
   }  
   if ($ip_ban && $ip_banlist) {  
       foreach (split(/,/, $ip_banlist))    { if ($_ eq $ip_ban) { $ban_rtn .= 'I'; last; } }  
   }  
   if ($u_ban && $user_banlist) {  
       foreach (split(/,/, $user_banlist))  { if ($_ eq $u_ban)  { $ban_rtn .= 'U'; last; } }  
   }  
   
   $ban_rtn;   # Returns E if banned by email address 
   # Returns I if banned by IP address
   # Returns U if banned by username
   # Returns all banning methods, unseparated (eg "EIU" if banned by all methods)
   
     my ( $e_ban, $ip_ban, $u_ban ) = @_;
     my $ban_rtn;
     if ( !-e "$vardir/banlist.txt" ) {
   
         if ( $e_ban && $email_banlist ) {
             foreach ( split /,/xsm, $email_banlist ) {
                 if ( $_ eq $e_ban ) { $ban_rtn .= 'E'; last; }
             }
         }
         if ( $ip_ban && $ip_banlist ) {
             foreach ( split /,/xsm, $ip_banlist ) {
                 if ( $_ eq $ip_ban ) { $ban_rtn .= 'I'; last; }
             }
         }
         if ( $u_ban && $user_banlist ) {
             foreach ( split /,/xsm, $user_banlist ) {
                 if ( $_ eq $u_ban ) { $ban_rtn .= 'U'; last; }
             }
         }
     }
     else {
         fopen( BAN, "$vardir/banlist.txt" )
           or fatal_error( 'cannot_open', "$vardir/banlist.txt", 1 );
         @banlist = <BAN>;
         fclose(BAN);
         chomp @banlist;
         my $tmb     = 0;
         $today    = time;
         *time_ban = sub {
             for my $i ( 0 .. 3 ) {
                 if ( $banned[4] eq $timeban[$i] ) {
                     $tmb = $banned[2] + ( $bandays[$i] * 84600 );
                 }
             }
             return $tmb;
         };
         for my $i (@banlist) {
             @banned = split /\|/xsm, $i;
             $tmb = time_ban();
             if ( $banned[0] eq 'E' ) {
                 $banned[1] =~ s/\\@/@/xsm;
                 if (
                     (
                            $e_ban eq $banned[1]
                         && $banned[4] ne 'p' 
                         && $tmb > $today
                     )
                     || ( $e_ban eq $banned[1] && $banned[4] eq 'p' )
                   )
                 {
                     $ban_rtn .= $banned[0];
                     last;
                 }
             }
         }
         for my $i (@banlist) {
             @banned = split /\|/xsm, $i;
             $tmb = time_ban();
             if (
                 (
                        $banned[0] eq 'I' 
                     && $ip_ban eq $banned[1]
                     && $banned[4] ne 'p' 
                     && $tmb > $today
                 )
                 || $banned[0] eq 'I' 
                 && $ip_ban    eq $banned[1]
                 && $banned[4] eq 'p' 
               )
             {
                 $ban_rtn .= $banned[0];
                 last;
             }
         }
         for my $i (@banlist) {
             @banned = split /\|/xsm, $i;
             $tmb = time_ban();
             if (   $banned[0] eq 'U' 
                 && $u_ban eq $banned[1]
                 && ( ( $banned[4] ne 'p' && $tmb > $today )
                     || $banned[4] eq 'p' ) )
             {
                 $ban_rtn .= $banned[0];
                 last;
             }
         }
     }
   
     return $ban_rtn;
} }
   
sub CheckIcon { sub CheckIcon {
   # Check the icon so HTML cannot be exploited.  
   # Do it in 3 unless's because 1 is too long.     # Check the icon so HTML cannot be exploited. 
   $icon =~ s~\Ahttp://.*\/(.*?)\..*?\Z~$1~;     $icon =~ s/\Ahttp:\/\/.*\/(.*?)\..*?\Z/$1/xsm; 
   $icon =~ s~[^A-Za-z]~~g;     $icon =~ s/[^A-Za-z]//gxsm; 
   $icon =~ s~\\~~g;     $icon =~ s/\\//gxsm; 
   $icon =~ s~\/~~g;     $icon =~ s/\///gxsm; 
   unless ($icon eq "xx" || $icon eq "thumbup" || $icon eq "thumbdown" || $icon eq "exclamation") {     my @iconlist = qw( xx thumbup thumbdown exclamation question lamp smiley angry cheesy grin sad wink standard confidential urgent alert ); 
       unless ($icon eq "question" || $icon eq "lamp" || $icon eq "smiley" || $icon eq "angry") {     my $isicon = 0; 
           unless ($icon eq "cheesy" || $icon eq "grin" || $icon eq "sad" || $icon eq "wink") {    for my $x (@iconlist) {
               $icon = "xx";  
           }         if ( $icon eq $x ) { 
       }             $isicon = 1; 
   }             last; 
         }
     }
     if   ( $isicon == 0 ) { $icon = 'xx'; }
     else                  { $icon = $icon; }
     return;
  }
   
  sub SearchAccess {
     $advsearchaccess = q{};
     $qcksearchaccess = q{};
     if ( !exists $memberunfo{$username} ) { LoadUser($username); }
     if ($iamguest) {
         if ($enableguestsearch)      { $advsearchaccess = 'granted'; }
         if ($enableguestquicksearch) { $qcksearchaccess = 'granted'; }
         return;
     }
     if ($iamadmin) {
         $advsearchaccess = 'granted';
         $qcksearchaccess = 'granted';
         return;
     }
     @advsearch_groups = split /, /sm, $mgadvsearch;
     if ( !$mgadvsearch ) { $advsearchaccess = 'granted'; }
     @qcksearch_groups = split /, /sm, $mgqcksearch;
     if ( !$mgqcksearch ) { $qcksearchaccess = 'granted'; }
     $memberinform = $memberunfo{$username};
     foreach my $advelement (@advsearch_groups) {
         chomp $advelement;
         if ( $advelement eq $memberinform ) { $advsearchaccess = 'granted'; }
         foreach ( split /,/xsm, $memberaddgroup{$username} ) {
             if ( $advelement eq $_ ) { $advsearchaccess = 'granted'; last; }
         }
         if ( $advsearchaccess eq 'granted' ) { last; }
     }
     foreach my $qckelement (@qcksearch_groups) {
         chomp $qckelement;
         if ( $qckelement eq $memberinform ) { $qcksearchaccess = 'granted'; }
         foreach ( split /,/xsm, $memberaddgroup{$username} ) {
             if ( $qckelement eq $_ ) { $qcksearchaccess = 'granted'; last; }
         }
         if ( $qcksearchaccess eq 'granted' ) { last; }
     }
     return;
} }
   
sub AccessCheck { sub AccessCheck {
   my ($curboard, $checktype, $boardperms) = @_;    my ( $curboard, $checktype, $boardperms ) = @_;
   
   # Put whether it's a zero post count board in global variable    # Put whether it's a zero post count board in global variable
   # to save need to reopen file many times.    # to save need to reopen file many times.
   unless (exists $memberunfo{$username}) { &LoadUser($username); }    if ( !exists $memberunfo{$username} ) { LoadUser($username); }
   my $boardmod = 0;    my $boardmod = 0;
   foreach $curuser (split(/, ?/, ${$uid.$curboard}{'mods'})) {    foreach my $curuser ( split /, ?/sm, ${ $uid . $curboard }{'mods'} ) {
       if ($username eq $curuser) { $boardmod = 1; }        if ( $username eq $curuser ) { $boardmod = 1; }
   }    }
   @board_modgrps = split(/, /, ${$uid.$curboard}{'modgroups'});     @board_modgrps = split /, /sm, ${ $uid . $curboard }{'modgroups'}; 
   @user_addgrps  = split(/,/, ${$uid.$username}{'addgroups'});     @user_addgrps  = split /,/xsm, ${ $uid . $username }{'addgroups'}; 
   foreach $curgroup (@board_modgrps) {    foreach my $curgroup (@board_modgrps) {
       if (${$uid.$username}{'position'} eq $curgroup) { $boardmod = 1; }        if ( ${ $uid . $username }{'position'} eq $curgroup ) { $boardmod = 1; }
       foreach $curaddgroup (@user_addgrps) {        foreach my $curaddgroup (@user_addgrps) {
           if ($curaddgroup eq $curgroup) { $boardmod = 1; }            if ( $curaddgroup eq $curgroup ) { $boardmod = 1; }
       }        }
   }    }
   $INFO{'zeropost'} = ${$uid.$curboard}{'zero'};     $INFO{'zeropost'} = ${ $uid . $curboard }{'zero'}; 
   if ($iamadmin) { $access = "granted"; return $access; }    if ($iamadmin) { $access = 'granted'; return $access; }
   my ($viewperms, $topicperms, $replyperms, $pollperms, $attachperms);     my ( $viewperms, $topicperms, $replyperms, $pollperms, $attachperms ); 
   if ($username ne "Guest") {    if ( $username ne 'Guest' ) {
       ($viewperms, $topicperms, $replyperms, $pollperms, $attachperms) = split(/\|/, ${$uid.$username}{'perms'});         ( $viewperms, $topicperms, $replyperms, $pollperms, $attachperms ) = 
   }           split /\|/xsm, ${ $uid . $username }{'perms'}; 
   if ($username eq "Guest" && !$enable_guestposting) {     } 
       $viewperms   = 0;     if ( $username eq 'Guest' && !$enable_guestposting ) { 
       $topicperms  = 1;         $viewperms   = 0; 
       $replyperms  = 1;        $topicperms  = 1;
       $pollperms   = 1;        $replyperms  = 1;
       $attachperms = 1;        $pollperms   = 1;
   }         $attachperms = 1; 
   my $access = "denied";     } 
   if ($checktype == 1) {    # Post access check     my $access = 'denied'; 
       @allowed_groups = split(/, /, ${$uid.$curboard}{'topicperms'});  
       if (${$uid.$curboard}{'topicperms'} eq "") { $access = "granted"; }     if ( $checktype == 1 ) {    # Post access check 
       if ($topicperms == 1) { $access = "notgranted"; }         @allowed_groups = split /, /sm, ${ $uid . $curboard }{'topicperms'}; 
   } elsif ($checktype == 2) {    # Reply access check         if ( ${ $uid . $curboard }{'topicperms'} eq q{} ) { 
       if ($iamgmod || $boardmod) { $access = "granted"; }             $access = 'granted'; 
       else {         } 
           @allowed_groups = split(/, /, ${$uid.$curboard}{'replyperms'});         if ( $topicperms == 1 ) { $access = 'notgranted'; } 
           if (${$uid.$curboard}{'replyperms'} eq "") { $access = "granted"; }    }
           if ($replyperms == 1 && !$topicstart{$username}) { $access = "notgranted"; }     elsif ( $checktype == 2 ) {    # Reply access check 
       }        if ( $iamgmod || $iamfmod || $boardmod ) { $access = 'granted'; }
   } elsif ($checktype == 3) {    # Poll access check         else { 
       @allowed_groups = split(/, /, ${$uid.$curboard}{'pollperms'});             @allowed_groups = 
       if (${$uid.$curboard}{'pollperms'} eq "") { $access = "granted"; }               split /, /sm, ${ $uid . $curboard }{'replyperms'}; 
       if ($pollperms == 1) { $access = "notgranted"; }             if ( ${ $uid . $curboard }{'replyperms'} eq q{} ) { 
   } elsif ($checktype == 4) {    # Attachment access check                 $access = 'granted'; 
       if (${$uid.$curboard}{'attperms'} == 1) { $access = "granted"; }            }
       if ($attachperms == 1) { $access = "notgranted"; }             if ( $replyperms == 1 && !$topicstart{$username} ) { 
   } else {                       # Board access check                 $access = 'notgranted'; 
       @allowed_groups = split(/, /, $boardperms);             } 
       if ($boardperms eq "") { $access = "granted"; }        }
       if ($viewperms == 1) { $access = "notgranted"; }    }
   }     elsif ( $checktype == 3 ) {    # Poll access check 
         @allowed_groups = split /, /sm, ${ $uid . $curboard }{'pollperms'};
   # age and gender check         if ( ${ $uid . $curboard }{'pollperms'} eq q{} ) { 
   unless ($iamadmin || $iamgmod || $boardmod) {             $access = 'granted'; 
       if ((${$uid.$curboard}{'minageperms'} || ${$uid.$curboard}{'maxageperms'}) && (!$age || $age == 0)) {         } 
           $access = "notgranted";         if ( $pollperms == 1 ) { $access = 'notgranted'; } 
       } elsif (${$uid.$curboard}{'minageperms'} && $age < ${$uid.$curboard}{'minageperms'}) {     } 
           $access = "notgranted";     elsif ( $checktype == 4 ) {    # Attachment access check 
       } elsif (${$uid.$curboard}{'maxageperms'} && $age > ${$uid.$curboard}{'maxageperms'}) {         if ( ${ $uid . $curboard }{'attperms'} == 1 ) { $access = 'granted'; } 
           $access = "notgranted";         if ( $attachperms == 1 ) { $access = 'notgranted'; } 
       }    }
       if (${$uid.$curboard}{'genderperms'} && !${$uid.$username}{'gender'}) {     else {                         # Board access check 
           $access = "notgranted";         @allowed_groups = split /, /sm, $boardperms; 
       } elsif (${$uid.$curboard}{'genderperms'} eq "M" && ${$uid.$username}{'gender'} eq "Female") {         if ( $boardperms eq q{} ) { $access = 'granted'; } 
           $access = "notgranted";         if ( $viewperms == 1 ) { $access = 'notgranted'; } 
       } elsif (${$uid.$curboard}{'genderperms'} eq "F" && ${$uid.$username}{'gender'} eq "Male") {     } 
           $access = "notgranted";  
       }     # age and gender check 
   }     if ( !$iamadmin && !$iamgmod && !$iamfmod && !$boardmod ) { 
   unless ($access eq "granted" || $access eq "notgranted") {         if ( 
       $memberinform = $memberunfo{$username};             ( 
       foreach $element (@allowed_groups) {                    ${ $uid . $curboard }{'minageperms'} 
           chomp $element;                 || ${ $uid . $curboard }{'maxageperms'} 
           if ($element eq $memberinform) { $access = "granted"; }             ) 
           foreach (split(/,/, $memberaddgroup{$username})) {             && ( !$age || $age == 0 ) 
               if ($element eq $_) { $access = "granted"; last; }           ) 
           }         { 
           if ($element eq $topicstart{$username}) { $access = "granted"; }             $access = 'notgranted'; 
           if ($element eq "Global Moderator" && ($iamadmin || $iamgmod)) { $access = "granted"; }        }
           if ($element eq "Moderator" && ($iamadmin || $iamgmod || $boardmod)) { $access = "granted"; }         elsif ( ${ $uid . $curboard }{'minageperms'} 
           if ($access eq "granted") { last; }             && $age < ${ $uid . $curboard }{'minageperms'} ) 
       }         { 
   }             $access = 'notgranted'; 
         }
         elsif ( ${ $uid . $curboard }{'maxageperms'}
             && $age > ${ $uid . $curboard }{'maxageperms'} )
         {
             $access = 'notgranted';
         }
         if ( ${ $uid . $curboard }{'genderperms'}
             && !${ $uid . $username }{'gender'} )
         {
             $access = 'notgranted';
         }
         elsif (${ $uid . $curboard }{'genderperms'} eq 'M' 
             && ${ $uid . $username }{'gender'} eq 'Female' )
         {
             $access = 'notgranted';
         }
         elsif (${ $uid . $curboard }{'genderperms'} eq 'F' 
             && ${ $uid . $username }{'gender'} eq 'Male' )
         {
             $access = 'notgranted';
         }
     }
     if ( $access ne 'granted' && $access ne 'notgranted' ) {
         $memberinform = $memberunfo{$username};
         foreach my $element (@allowed_groups) {
             chomp $element;
             if ( $element eq $memberinform ) { $access = 'granted'; }
             foreach ( split /,/xsm, $memberaddgroup{$username} ) {
                 if ( $element eq $_ ) { $access = 'granted'; last; }
             }
             if ( $element eq $topicstart{$username} ) { $access = 'granted'; }
             if ( $element eq 'Global Moderator' && ( $iamadmin || $iamgmod ) ) {
                 $access = 'granted';
             }
             if ( $element eq 'Mid Moderator' 
                 && ( $iamadmin || $iamgmod || $iamfmod ) )
             {
                 $access = 'granted';
             }
             if ( $element eq 'Moderator' 
                 && ( $iamadmin || $iamgmod || $iamfmod || $boardmod ) )
             {
                 $access = 'granted';
             }
             if ( $access eq 'granted' ) { last; }
         }
     }
   
   $access;    return $access;
} }
   
sub CatAccess { sub CatAccess {
   my ($cataccess) = @_;    my ($cataccess) = @_;
   if ($iamadmin || $cataccess eq "") { return 1; }    if ( $iamadmin || $cataccess eq q{} ) { return 1; }
   
   my $access = 0;    my $access = 0;
   @allow_groups = split(/, /, $cataccess);     @allow_groups = split /, /sm, $cataccess; 
   unless (exists $memberunfo{$username}) { &LoadUser($username); }    if ( !exists $memberunfo{$username} ) { LoadUser($username); }
   $memberinform = $memberunfo{$username};    $memberinform = $memberunfo{$username};
   foreach $element (@allow_groups) {    foreach my $element (@allow_groups) {
       chomp $element;        chomp $element;
       if ($element eq $memberinform) { $access = 1; }        if ( $element eq $memberinform ) { $access = 1; }
       foreach (split(/,/, $memberaddgroup{$username})) {        foreach ( split /,/xsm, $memberaddgroup{$username} ) {
           if ($element eq $_) { $access = 1; last; }            if ( $element eq $_ ) { $access = 1; last; }
       }        }
       if ($element eq "Moderator" && ($iamgmod || exists $moderators{$username})) { $access = 1; }         if ( $element eq 'Moderator' 
       if ($element eq "Global Moderator" && $iamgmod) { $access = 1; }             && ( $iamgmod || $iamfmod || exists $moderators{$username} ) ) 
       if ($access == 1) { last; }         { 
   }             $access = 1; 
   $access;         } 
         if ( $element eq 'Global Moderator' && $iamgmod ) { $access = 1; }
         if ( $element eq 'Mid Moderator'    && $iamfmod ) { $access = 1; }
         if ( $access == 1 ) { last; }
     }
     return $access;
} }
   
sub email_domain_check { sub email_domain_check {
   ### Based upon Distilled Email Domains mod by AstroPilot ###    ### Based upon Distilled Email Domains mod by AstroPilot ###
   my $checkdomain = $_[0];     my ($checkdomain) = @_; 
   if ($checkdomain) {    if ($checkdomain) {
       if (-e "$vardir/email_domain_filter.txt" ) { require "$vardir/email_domain_filter.txt"; }         if ( -e "$vardir/email_domain_filter.txt" ) { 
       if ($bdomains) {             require "$vardir/email_domain_filter.txt"; 
           foreach (split (/,/, $bdomains)) {         } 
               if ($_ !~ /\@/) {$_ = "\@$_";}         if ($bdomains) { 
               elsif ($_ !~ /^\./) {$_ = ".$_";}             foreach ( split /,/xsm, $bdomains ) { 
               &fatal_error("domain_not_allowed","$_") if $checkdomain =~ m/$_/i;                 $my_x = $_; 
           }                if    ( $_ !~ /\@/xsm )  { $_ = "\@$_"; }
       }                elsif ( $_ !~ /^\./xsm ) { $_ = ".$_"; }
   }                 @my_ch   = split /\./xsm, $my_x; 
   ### Distilled Email Domains mod end ###                 @my_ch_e = split /\./xsm, $checkdomain; 
                 if ( $checkdomain =~ m/$_/ism
                     || ( $my_ch[0] eq q{} && $my_ch[-1] eq $my_ch_e[-1] ) )
                 {
                     fatal_error( 'domain_not_allowed', "$_" );
                 }
             }
         }
     }
     ### Distilled Email Domains mod end ###
     return;
  }
   
  sub GroupPerms {
     my ( $groupAll, $groupCheck ) = @_;
     if ( $groupAll && $groupCheck ) {
         $allowGroups = 0;
         foreach my $selectGroup ( split /,\ /xsm, $groupCheck ) {
             if (   ( $selectGroup eq ${ $uid . $username }{'position'} )
                 || ( $selectGroup eq $memberunfo{$username} ) )
             {
                 $allowGroups = 1;
                 last;
             }
             foreach ( split /,/xsm, ${ $uid . $username }{'addgroups'} ) {
                 if ( $selectGroup eq $_ ) { $allowGroups = 1; last; }
             }
         }
     }
     else {
         $allowGroups = 1;
     }
     return $allowGroups;
  }
   
  sub ipban_update {
   
     # This is for quick updating for banning + unbanning
     if ( $iamadmin || $iamgmod || $iamfmod ) {
         my $ban       = $INFO{'ban'};
         my $lev       = $INFO{'lev'};
         my $ban_email = $INFO{'ban_email'};
         my $ban_mem   = $INFO{'ban_memname'};
         my $unban     = $INFO{'unban'};
         my $user      = $INFO{'username'};
         $ban_mem = $do_scramble_id ? decloak($ban_mem) : $ban_mem;
         $ban_email =~ s/@/\\@/xsm;
   
         my $time = time;
         $ihave = 0;
         $ehave = 0;
         $uhave = 0;
         fopen( BAN, "<$vardir/banlist.txt" )
           or fatal_error( 'cannot_open', "$vardir/banlist.txt", 1 );
         my @myban = <BAN>;
         chomp @myban;
         fclose(BAN);
   
     if ( $unban == 1 ) {
         fopen( BAN2, ">$vardir/banlist.txt" )
           or fatal_error( 'cannot_open', "$vardir/banlist.txt", 1 );
         foreach my $i (@myban) {
             @banned = split /\|/xsm, $i;
             if (   $ban eq $banned[1]
                 || $ban_email eq $banned[1]
                 || $ban_mem   eq $banned[1] )
             {
                 $un_ban = q~~;
                 if ( $banned[4] eq 'p' ) {
                     LoadUser($user);
                     @ubanned =  split /[|]/xsm, ${ $uid . $user }{'banned'};
                     if ( $ban_email ) {
                         $ubanned[0] = 0;
                     }
                     if ( $ban_mem ) {
                         $ubanned[1] = 0;
                     }
                     ${ $uid . $user }{'banned'} = qq~$ubanned[0]|$ubanned[1]~;
                     UserAccount( $user, 'update' );
                 }
             }
             else {
                 $un_ban =
                   qq~$banned[0]|$banned[1]|$banned[2]|$banned[3]|$banned[4]|\n~;
             }
                 print {BAN2} $un_ban or croak "$croak{'print'} BAN2";
         }
         fclose(BAN2);
     }
     else {
         $ihave = 0;
         $tmb = 0;
         if ($ban) {
             $type = 'I';
             $banned = $ban;
         }
         elsif ( $ban_email ) {
             $type = 'E';
             $banned = $ban_email;
         }
         elsif ( $ban_mem ) {
             $type = 'U';
             $banned = $ban_mem;
         }
         for my $i (@myban) {
             @banned = split /\|/xsm, $i;
             for my $j ( 0 .. 3 ) {
                 if ( $banned[4] eq $timeban[$j] ) {
                     $tmb = $banned[2] + ( $bandays[$j] * 86400 );
                 }
             }
             if ( $banned eq $banned[1] && ( $banned[4] eq 'p' || $tmb > $time ) ) {
                 $ihave = 1;
             }
         }
   
         if ( $banned && $ihave != 1 && $banned ne '127.0.0.1' ) {
             $add_ban =
               qq~$type|$banned|$time|${$uid.$username}{'realname'} ($username)|$lev|\n~;
         }
         fopen( BAN2, ">>$vardir/banlist.txt" ) or fatal_error( 'cannot_open', "$vardir/banlist.txt", 1 );
         print {BAN2} $add_ban or croak "$croak{'print'} BAN2";
         fclose(BAN2);
     }
   
         $yySetLocation = qq~$scripturl?action=viewprofile;username=$user~;
         redirectexit();
     }
     return;
} }
   
1; 1;