###############################################################################
# RegistrationLog.pm                                                          #
# $Date: 06.01.17 $                                                           #
###############################################################################
# YaBB: Yet another Bulletin Board                                            #
# Open-Source Community Software for Webmasters                               #
# Version:        YaBB 2.7.00                                                 #
# Packaged:       June 1, 2017                                                #
# Distributed by: http://www.yabbforumsoftware.com                                    #
# =========================================================================== #
# Copyright (c) 2000-2017 YaBB (www.yabbforumsoftware.com) - All Rights Reserved.     #
# Software by:  The YaBB Development Team                                     #
#               with assistance from the YaBB community.                      #
###############################################################################
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use English qw(-no_match_vars);
our $VERSION = '2.7.00';

our $registrationlogpmver  = 'YaBB 2.7.00 $Revision: 1975 $';
our @registrationlogpmmods = ();
our $registrationlogpmmods = 0;
if (@registrationlogpmmods) {
    $registrationlogpmmods = 1;
}

our ($action);
$action ||= q{};
if ( $action eq 'detailedversion' ) { return 1; }

##  languages ##
our (
    $admin_reason,         $emailcharset,           $instantapprovedemail,
    $instantrejectedemail, $pwinstantapprovedemail, $pwreviewapprovedemail,
    $reviewapprovedemail,  $reviewrejectedemail,    $send_welcomeim,
    %actkey,               %admin_img,              %admin_txt,
    %croak,                %mailreg_txt,            %prereg_txt,
    %register_txt,
);
## paths ##
our ( $adminurl, $memberdir, $scripturl, $vardir, $yyhtml_root, $langdir );
## settings ##
our (
    $addmemgroup_enabled, $birthday_list_show,   $do_scramble_id,
    $emailpassword,       $extendedprofiles,     $ip_lookup,
    $mbname,              $nomailspammer,        $regtype,
    $sendname,            $show_event_birthdays, $yymycharset,
    %grp_nopost,
);
## other ##
our (
    $date,     $language, $uid,           $user_ip,
    $username, $yymain,   $yysetlocation, $yytitle,
    %FORM,     %INFO,     @memberlist,    $iamadmin,
);

## our Mod Hook ##

load_language('Admin');
load_language('Register');

sub view_reglog {
    is_admin_or_gmod();

    $yytitle = $prereg_txt{'15a'};

    my ( @reglist,    @logentries );
    my ( $servertime, $pageindex );
    if ( -e "$vardir/registration.log" ) {
        our ($LOGFILE);
        fopen( 'LOGFILE', '<', "$vardir/registration.log" )
          or croak "$croak{'open'} LOGFILE";
        @logentries = <$LOGFILE>;
        fclose('LOGFILE') or croak "$croak{'close'} LOGFILE";
        @logentries = reverse @logentries;

        our ($FILE);
        fopen( 'FILE', '<', "$vardir/Memberlist.pm" )
          or croak "$croak{'open'} FILE";
        @memberlist = <$FILE>;
        fclose('FILE') or croak "$croak{'close'} FILE";

        # If a pre-registration list exists load it
        if ( -e "$vardir/meminactive.db" ) {
            our ($INACT);
            fopen( 'INACT', '<', "$vardir/meminactive.db" )
              or croak "$croak{'open'} INACT";
            @reglist = <$INACT>;
            fclose('INACT') or croak "$croak{'close'} INACT";
        }

        # grab pre regged user activationkey for admin activation
        foreach my $i (@reglist) {
            my ( undef, $actcode, $regmember, undef ) = split /[|]/xsm, $i, 4;
            $actkey{$regmember} = $actcode;
        }
    }
    else {
        $servertime = $date;
        push @logentries, "$servertime|LD|$username|$username|$user_ip";
    }
    @memberlist = reverse @memberlist;
    if ( @logentries > 0 ) {
        my $logcount = @logentries;
        my $newstart = $INFO{'newstart'} || 0;
        my ( $endpage, );
        my $startpage      = 0;
        my $postdisplaynum = 8;
        my $max            = $logcount;
        $newstart = ( int( $newstart / 25 ) ) * 25;
        my $tmpa = 1;

        if ( $newstart >= ( ( $postdisplaynum - 1 ) * 25 ) ) {
            $startpage = $newstart - ( ( $postdisplaynum - 1 ) * 25 );
            $tmpa = int( $startpage / 25 ) + 1;
        }
        if ( $max >= $newstart + ( $postdisplaynum * 25 ) ) {
            $endpage = $newstart + ( $postdisplaynum * 25 );
        }
        else { $endpage = $max; }
        if ( $startpage && $startpage > 0 ) {
            $pageindex =
qq~<a href="$adminurl?action=$action;newstart=0" class="norm">1</a>&nbsp;...&nbsp;~;
        }
        if ( $startpage && $startpage == 25 ) {
            $pageindex =
qq~<a href="$adminurl?action=$action;newstart=0" class="norm">1</a>&nbsp;~;
        }
        foreach my $counter ( $startpage .. ( $endpage - 1 ) ) {
            if ( $counter % 25 == 0 ) {
                $pageindex .=
                  $newstart == $counter
                  ? qq~<b>$tmpa</b>&nbsp;~
                  : qq~<a href="$adminurl?action=$action;newstart=$counter" class="norm">$tmpa</a>&nbsp;~;
                $tmpa++;
            }
        }
        my $pageindexadd = q{};
        my $lastpn       = int( $logcount / 25 ) + 1;
        my $lastptn      = ( $lastpn - 1 ) * 25;
        if ( $endpage < $max - (25) ) { $pageindexadd = q~...&nbsp;~; }
        if ( $endpage != $max ) {
            $pageindexadd .=
qq~<a href="$adminurl?action=$action;newstart=$lastptn">$lastpn</a>~;
        }
        $pageindex .= $pageindexadd;

        $pageindex = qq~<tr>
                <td class="windowbg" colspan="4"><span class="small" style="float: left;">$admin_txt{'139'}: $pageindex</span></td>
            </tr>~;

        my $numbegin = ( $newstart + 1 );
        my $numend   = ( $newstart + 25 );
        my $numshow  = q{};
        if   ( $numend > $logcount ) { $numend  = $logcount; }
        if   ( $logcount == 0 )      { $numshow = q{}; }
        else                         { $numshow = qq~($numbegin - $numend)~; }

        @logentries = splice @logentries, $newstart, 25;
    }
    my $loglist = q{};
    foreach my $logentry (@logentries) {
        chomp $logentry;
        my ( $logtime, $status, $userid, $actid, $ipadd ) =
          split /[|]/xsm, $logentry;
        my $cryptactid  = $actid;
        my $cryptuserid = $userid;
        if ($do_scramble_id) {
            $cryptactid  = cloak($actid);
            $cryptuserid = cloak($userid);
        }
        else {
            $cryptactid  = $actid;
            $cryptuserid = $userid;
        }
        my $actadminlink = q{};
        if ( $actid && $userid ne $actid ) {
            load_user($actid);
            {
                no strict qw(refs);
                $actadminlink =
qq~ $prereg_txt{'by'} <a href="$scripturl?action=viewprofile;username=$cryptactid">${$uid.$actid}{'realname'}</a>~;
            }
        }
        else {
            $actadminlink = q{};
        }
        my $linkuserid = $userid;
        if ( $status eq 'AA' && load_user($userid) ) {
            load_user($userid);
            {
                no strict qw(refs);
                $linkuserid =
qq~$userid (<a href="$scripturl?action=viewprofile;username=$cryptuserid">${$uid.$userid}{'realname'}</a>)~;
            }
        }
        else {
            $linkuserid = $userid;
        }
        my $is_member = check_member($userid);
        my $cryptid   = $userid;
        if   ($do_scramble_id) { $cryptid = cloak($userid); }
        else                   { $cryptid = $userid; }
        my $reclogtime = timeformat($logtime);
        my $delrecord  = q{};
        if ( $status eq 'N' && $is_member == 0 && -e "$memberdir/$userid.pre" )
        {
            $delrecord =
qq~<a href="$adminurl?action=del_regentry;username=$cryptid">$prereg_txt{'del'}</a>~;
            $delrecord .=
qq~<br /><a href="$adminurl?action=view_regentry;username=$cryptid~
              . (
                $actkey{$userid}
                ? ";activationkey=$actkey{$userid};type=validate"
                : q{}
              ) . qq~">$prereg_txt{'view'}</a>~;
            $delrecord .=
qq~<br /><a href="$scripturl?action=activate;username=$cryptid;activationkey=$actkey{$userid}">$prereg_txt{'act'}</a>~;
        }
        elsif ($status eq 'W'
            && $is_member == 0
            && -e "$memberdir/$userid.wait" )
        {
            $delrecord =
qq~<a href="$adminurl?action=rej_regentry;username=$userid">$prereg_txt{'reject'}</a>~;
            $delrecord .=
qq~<br /><a href="$adminurl?action=view_regentry;username=$cryptid;type=approve">$prereg_txt{'view'}</a>~;
            $delrecord .=
qq~<br /><a href="$adminurl?action=apr_regentry;username=$userid">$prereg_txt{'apr'}</a>~;
        }
        else {
            $delrecord = '---';
        }
        my $lookup_ip = q{};
        if ($ipadd) {
            $lookup_ip = q~<br />IP: ~;
            $lookup_ip .=
              ($ip_lookup)
              ? qq~<a href="$scripturl?action=iplookup;ip=$ipadd">$ipadd</a>~
              : qq~$ipadd~;
            $lookup_ip .=
qq~- <a href="$adminurl?action=ipban_err;ban=$ipadd;lev=p;return=view_reglog">$admin_txt{'725f'}</a>~;
        }
        $loglist .= qq~<tr>
            <td class="windowbg center">$reclogtime</td>
            <td class="windowbg2 center">$prereg_txt{$status}$actadminlink$lookup_ip</td>
            <td class="windowbg center">$linkuserid</td>
            <td class="windowbg2 center">$delrecord</td>
        </tr>~;
    }

    $pageindex ||= q{};
    $yymain .= qq~
    <script src="$yyhtml_root/ubbc.js" type="text/javascript"></script>
    <form name="reglog_form" action="$adminurl?action=clean_reglog" method="post" onsubmit="return submitproc();">
    <div class="bordercolor rightboxdiv">
        <table class="border-space pad-cell" style="margin-bottom: .5em;">
            <colgroup>
                <col style="width: 20%" />
                <col style="width: 35%" />
                <col style="width: 25%" />
                <col style="width: 20%" />
            </colgroup>
            <tr>
                <td class="titlebg" colspan="4">$admin_img{'xx'} <b>$yytitle</b></td>
            </tr><tr>
                <td class="windowbg2" colspan="4">
                    <div class="pad-more">$prereg_txt{'20'}</div>
                </td>
            </tr>
            $pageindex
            <tr>
                <td class="catbg center"><b>$prereg_txt{'17'}</b></td>
                <td class="catbg center"><b>$prereg_txt{'18'}</b></td>
                <td class="catbg center"><b>$prereg_txt{'19'}</b></td>
                <td class="catbg center"><b>$prereg_txt{'action'}</b></td>
            </tr>
            $loglist
            </table>
        </div>
        <div class="bordercolor rightboxdiv">
            <table class="border-space pad-cell">
                <tr>
                    <th class="titlebg">$admin_img{'prefimg'} $admin_txt{'725e'}</th>
                </tr><tr>
                    <td class="catbg center">
                        <input type="submit" value="$prereg_txt{'9'}" onclick="return confirm('$prereg_txt{'9'}');" class="button" />
                    </td>
                </tr>
            </table>
            </div>
            </form>
~;
    our $action_area = 'view_reglog';
    admintemplate();
    return;
}

sub check_member {
    my ($inp) = @_;
    my $is_member = 0;
    foreach my $lstmember (@memberlist) {
        chomp $lstmember;
        my ( $listmember, undef ) = split /\t/xsm, $lstmember, 2;
        if ( $inp eq $listmember ) {
            $is_member = 1;
            last;
        }
    }
    return $is_member;
}

sub clean_reglog {
    is_admin_or_gmod();
    my (@outlist);
    our ($REG);
    fopen( 'REG', '<', "$vardir/registration.log", 1 )
      or croak "$croak{'open'} REG";
    my @reglist = <$REG>;
    fclose('REG') or croak "$croak{'close'} REG";
    ## depending on registration type only leave uncompleted entries in the log for completion and remove the failed or completed ones ##
    foreach my $i (@reglist) {
        my ( undef, $regstatus, $reguser, undef ) = split /[|]/xsm, $i;
        if (   ( $regtype == 1 || $regtype == 2 )
            && $regstatus eq 'N'
            && -e "$memberdir/$reguser.pre" )
        {
            push @outlist, $i;
        }
        if (   $regtype == 1
            && $regstatus eq 'W'
            && -e "$memberdir/$reguser.wait" )
        {
            push @outlist, $i;
        }
    }
    fopen( 'REG', '>', "$vardir/registration.log", 1 )
      or croak "$croak{'open'} REG";
    print {$REG} @outlist or croak "$croak{'print'} REG";
    fclose('REG') or croak "$croak{'close'} REG";

    $yysetlocation = qq~$adminurl?action=view_reglog~;
    redirectexit();
    return;
}

sub kill_registration {
    my ($inp) = @_;
    is_admin_or_gmod();
    my $changed;
    my $deluser = $inp || $INFO{'username'};
    if ($do_scramble_id) { $deluser = decloak($deluser); }

    our ($INFILE);
    fopen( 'INFILE', '<', "$vardir/meminactive.db" )
      or croak "$croak{'open'} INFILE";
    my @actlist = <$INFILE>;
    fclose('INFILE') or croak "$croak{'close'} INFILE";

    # check if user is in pre-registration and check activation key
    my (@outlist);
    foreach my $i (@actlist) {
        my ( $regtime, undef, $regmember, undef ) = split /[|]/xsm, $i, 4;
        if ( $deluser eq $regmember ) {
            $changed = 1;
            unlink "$memberdir/$regmember.pre";

            # add entry to registration log
            our ($REG);
            fopen( 'REG', '>>', "$vardir/registration.log", 1 )
              or croak "$croak{'open'} REG";
            print {$REG} "$date|D|$regmember|$username|$user_ip\n"
              or croak "$croak{'print'} REG";
            fclose('REG') or croak "$croak{'close'} REG";
        }
        else {

            # update non activate user list
            # write valid registration to the list again
            push @outlist, $i;
        }
    }
    if ($changed) {

        # re-open inactive list for update if changed
        our ($OUTFILE);
        fopen( 'OUTFILE', '>', "$vardir/meminactive.db", 1 )
          or croak "$croak{'open'} OUTFILE";
        print {$OUTFILE} @outlist or croak "$croak{'print'} OUTFILE";
        fclose('OUTFILE') or croak "$croak{'close'} OUTFILE";
    }
    $yysetlocation = qq~$adminurl?action=view_reglog~;
    redirectexit();
    return;
}

sub view_registration {
    is_admin_or_gmod();
    my $viewuser = $INFO{'username'} || $FORM{'username'};
    my $readuser = $viewuser;
    my $viewtype = $INFO{'type'};
    my $actkey   = $INFO{'activationkey'} || q{};
    if ($do_scramble_id) { $readuser = decloak($viewuser); }
    load_user($readuser);
    {
        no strict qw(refs);
        $yymain .= qq~
<form action="$adminurl?action=admin_descision;activationkey=$actkey" method="post" name="creator">
<div class="bordercolor rightboxdiv">
<table class="border-space pad-cell" style="margin-bottom: .5em;">
    <colgroup>
        <col style="width:320px" />
        <col style="width:auto" />
    </colgroup>
    <tr>
        <td colspan="2" class="titlebg">$admin_img{'profile'} <b>$prereg_txt{'view'}</b>
            <input type="hidden" name="username" value="$viewuser" />
            <input type="hidden" name="type" value="$viewtype" />
            <input type="hidden" name="activationkey" value="$actkey" />
        </td>
    </tr><tr class="windowbg">
        <td><b>$prereg_txt{'apr_id'}: </b></td>
        <td>$readuser</td>
    </tr><tr class="windowbg">
       <td><b>$prereg_txt{'apr_name'}: </b></td>
       <td>${$uid.$readuser}{'realname'}</td>
    </tr>~;
    }
    {
        no strict qw(refs);
        if ( $viewtype eq 'validate' ) {
            $yymain .= qq~<tr class="windowbg">
        <td><b>$prereg_txt{'apr_email_invalid'}: </b></td>
        <td>${$uid.$readuser}{'email'}</td>
    </tr>~;
        }
        elsif ( $viewtype eq 'approve' ) {
            $yymain .= qq~<tr class="windowbg">
   <td><b>$prereg_txt{'apr_email_valid'}: </b></td>
   <td>${$uid.$readuser}{'email'}</td>
 </tr>~;
        }
    }

    if ( $addmemgroup_enabled == 2 || $addmemgroup_enabled == 3 ) {
        my (@usergroup);
        {
            no strict qw(refs);
            for ( split /,/xsm, ${ $uid . $readuser }{'addgroups'} || q{} ) {
                push
                  @usergroup,
                  ${ $grp_nopost{ ${ $uid . $readuser }{'addgroups'} } }[0];
            }
        }
        my $usrgrp = $register_txt{'765b'};
        if ( scalar @usergroup > 0 ) {
            $usrgrp = join q{, }, @usergroup;
        }
        $yymain .= qq~<tr class="windowbg">
   <td><b>$register_txt{'765a'}:</b></td>
   <td>$usrgrp</td>
 </tr>~;
    }

    my ($lookup_ip);
    {
        no strict qw(refs);
        $lookup_ip =
          ($ip_lookup)
          ? qq~<a href="$scripturl?action=iplookup;ip=${$uid.$readuser}{'lastips'}">${$uid.$readuser}{'lastips'}</a>~
          : qq~${$uid.$readuser}{'lastips'}~;
    }
    {
        no strict qw(refs);
        $yymain .= qq~<tr class="windowbg">
   <td><b>$prereg_txt{'apr_language'}: </b></td>
   <td>${$uid.$readuser}{'language'}</td>
 </tr><tr class="windowbg">
   <td><b>$prereg_txt{'apr_ip'}: </b></td>
   <td>$lookup_ip (<a href="$adminurl?action=ipban_err;ban=${$uid.$readuser}{'lastips'};lev=p;return=view_reglog">$admin_txt{'725f'}</a>)</td>
 </tr>~;
    }

    if ( $regtype == 1 ) {
        {
            no strict qw(refs);
            $yymain .= qq~<tr class="windowbg">
   <td><b>$prereg_txt{'apr_reason'}: </b></td>
   <td>${$uid.$readuser}{'regreason'}</td>
 </tr>~;
        }
    }
    if ($extendedprofiles) {
        require Admin::Settings_ExtendedProfiles;
        $yymain .= ext_viewprofile_r($readuser);
    }

    if ( $viewtype eq 'approve' ) {
        $admin_reason ||= q{};
        $yymain .= qq~<tr>
   <td colspan="2" class="titlebg">$admin_img{'profile'} <b>$prereg_txt{'apr_admin_reason_title'}</b></td>
 </tr>
 <tr class="windowbg">
   <td><b>$prereg_txt{'apr_admin_reason'}: </b></td>
   <td><textarea rows="4" cols="50" id="admin_reason" name="admin_reason">$admin_reason</textarea></td>
 </tr>
</table>
</div>
<div class="bordercolor rightboxdiv">
<table class="border-space pad-cell">
    <tr>
        <th class="titlebg">$admin_img{'prefimg'} $admin_txt{'actions'}</th>
    </tr><tr>
        <td class="catbg center">
            <input type="submit" name="moda" value="$prereg_txt{'apr_admin_reject'}" onclick="return confirm('$prereg_txt{'apr_admin_reject'} ?')" class="button" />
            <input type="submit" name="moda" value="$prereg_txt{'apr_admin_approve'}" onclick="return confirm('$prereg_txt{'apr_admin_approve'} ?')" class="button" />
        </td>
    </tr>
</table>
</div>~;

    }
    elsif ( $viewtype eq 'validate' ) {
        $yymain .= qq~
</table>
</div>
<div class="bordercolor rightboxdiv">
<table class="border-space pad-cell">
    <tr>
        <th class="titlebg">$admin_img{'prefimg'} $admin_txt{'actions'}</th>
    </tr><tr>
        <td class="catbg center">
            <input type="submit" name="moda" value="$prereg_txt{'apr_admin_delete'}" onclick="return confirm('$prereg_txt{'apr_admin_delete'} ?')" class="button" />
            <input type="submit" name="moda" value="$prereg_txt{'apr_admin_validate'}" onclick="return confirm('$prereg_txt{'apr_admin_validate'} ?')" class="button" />
        </td>
    </tr>
</table>
</div>~;
    }

    $yymain .= q~
</form>~;

    $yytitle = $prereg_txt{'view'};
    admintemplate();
    return;
}

sub process_registration_review {
    is_admin_or_gmod();
    my $descuser  = $FORM{'username'};
    my $desctype  = $FORM{'type'};
    my $descision = $FORM{'moda'};
    my $actkey    = $FORM{'activationkey'};
    $admin_reason = $FORM{'admin_reason'};
    if ( $desctype eq 'validate' ) {
        if ( $descision eq $prereg_txt{'apr_admin_validate'} ) {
            require Sources::Register;
            user_activation( $descuser, $actkey );
        }
        elsif ( $descision eq $prereg_txt{'apr_admin_delete'} ) {
            kill_registration($descuser);
        }
    }
    elsif ( $desctype eq 'approve' ) {
        if ( $descision eq $prereg_txt{'apr_admin_approve'} ) {
            approve_registration($descuser);
        }
        elsif ( $descision eq $prereg_txt{'apr_admin_reject'} ) {
            reject_registration($descuser);
        }
    }
    return;
}

sub reject_registration {
    my ($inp) = @_;
    is_admin_or_gmod();
    my $deluser = $inp || $INFO{'username'};
    if ( !$admin_reason ) { $admin_reason = $FORM{'admin_reason'}; }

    if ($do_scramble_id) { $deluser = decloak($deluser); }
    my (@aprlist);
    if ( -e "$vardir/memapprove.db" && $regtype == 1 ) {
        our ($APR);
        fopen( 'APR', '<', "$vardir/memapprove.db" )
          or croak "$croak{'open'} APR";
        @aprlist = <$APR>;
        fclose('APR') or croak "$croak{'close'} APR";
    }

    # check if waiting user exists
    if ( -e "$memberdir/$deluser.wait" ) {
        load_user($deluser);
        ## send a rejection email ##
        my $templanguage = $language;
        {
            no strict qw(refs);
            $language = ${ $uid . $deluser }{'language'};
        }
        load_language('Email');
        require Sources::Mailer;
        my ($message);
        if ($admin_reason) {
            {
                no strict qw(refs);
                $message = template_email(
                    $reviewrejectedemail,
                    {
                        'displayname' => ${ $uid . $deluser }{'realname'},
                        'username'    => $deluser,
                        'reviewer'    => ${ $uid . $username }{'realname'},
                        'reason'      => $admin_reason
                    }
                );
                sendmail(
                    ${ $uid . $deluser }{'email'},
                    "$mailreg_txt{'apr_result_reject'} $mbname",
                    $message, q{}, $emailcharset
                );
            }
        }
        elsif ( $nomailspammer == 1 ) {
            {
                no strict qw(refs);
                $message = template_email(
                    $instantrejectedemail,
                    {
                        'displayname' => ${ $uid . $deluser }{'realname'},
                        'username'    => $deluser,
                        'reviewer'    => ${ $uid . $username }{'realname'}
                    }
                );

                sendmail(
                    ${ $uid . $deluser }{'email'},
                    "$mailreg_txt{'apr_result_reject'} $mbname",
                    $message, q{}, $emailcharset
                );
            }
        }
        $language = $templanguage;

        ## remove the registration data for the rejected user ##
        unlink "$memberdir/$deluser.wait";
        my (@aprchnglist);
        foreach my $i (@aprlist) {
            my ( undef, undef, $regmember, undef ) = split /[|]/xsm, $i, 4;
            if ( $regmember ne $deluser ) {
                push @aprchnglist, $i;
            }
        }

        # update approval user list
        our ($APR);
        fopen( 'APR', '>', "$vardir/memapprove.db" )
          or croak "$croak{'open'} APR";
        print {$APR} @aprchnglist or croak "$croak{'print'} APR";
        fclose('APR') or croak "$croak{'close'} APR";

        ## add entry to registration log ##
        our ($REG);
        fopen( 'REG', '>>', "$vardir/registration.log", 1 )
          or croak "$croak{'open'} REG";
        print {$REG} "$date|AR|$deluser|$username|$user_ip\n"
          or croak "$croak{'print'} REG";
        fclose('REG') or croak "$croak{'close'} REG";
    }
    $yysetlocation = qq~$adminurl?action=view_reglog~;
    redirectexit();
    return;
}

sub approve_registration {
    my ($inp) = @_;
    is_admin_or_gmod();
    my $apruser = $inp || $INFO{'username'};
    if ( !$admin_reason ) { $admin_reason = $FORM{'admin_reason'}; }

    if ($do_scramble_id) { $apruser = decloak($apruser); }

    ## load the list with waiting approvals ##
    my @aprlist;
    our ($APR);
    if ( -e "$vardir/memapprove.db" ) {
        fopen( 'APR', '<', "$vardir/memapprove.db" )
          or croak "$croak{'open'} APR";
        @aprlist = <$APR>;
        fclose('APR') or croak "$croak{'close'} APR";
    }

    my (@aprchnglist);
    my ( $foundmember, $foundpassword );
    foreach my $i (@aprlist) {
        my ( undef, undef, $regmember, $regpassword ) = split /[|]/xsm, $i;
        if ( $regmember ne $apruser ) {
            push @aprchnglist, $i;
        }
        else {
            $foundmember   = $regmember;
            $foundpassword = $regpassword;
        }
    }

    ## check if waiting user exists and was indeed in the waiting list ##
    if ( -e "$memberdir/$apruser.wait" && $foundmember ) {
        load_user($apruser);

        # ckeck if email is already in active use
        {
            no strict qw(refs);
            if (
                lc ${ $uid . $apruser }{'email'} eq
                lc member_index( 'check_exist', ${ $uid . $apruser }{'email'} )
              )
            {
                $yymain .=
qq~<span class="important"><b>$prereg_txt{'email_taken'} <i>${$uid.$apruser}{'email'}</i> ($prereg_txt{'35'}: $apruser)</b></span>~;
                view_reglog();
            }
        }

        ## user is approved, so let him/her in ##
        rename "$memberdir/$apruser.wait", "$memberdir/$apruser.vars";
        member_index( 'add', $apruser );
        {
            no strict qw(refs);
            if ( ${ $uid . $apruser }{'bday'}
                && ( $show_event_birthdays || $birthday_list_show ) )
            {
                eventcalbday( $apruser, ${ $uid . $apruser }{'bday'}, 1 );
            }
        }

        # update approval user list
        fopen( 'APR', '>', "$vardir/memapprove.db" )
          or croak "$croak{'open'} APR";
        print {$APR} @aprchnglist or croak "$croak{'print'} APR";
        fclose('APR') or croak "$croak{'close'} APR";

        ## add entry to registration log ##
        our ($REG);
        fopen( 'REG', '>>', "$vardir/registration.log", 1 )
          or croak "$croak{'open'} REG";
        print {$REG} "$date|AA|$apruser|$username|$user_ip\n"
          or croak "$croak{'print'} REG";
        fclose('REG') or croak "$croak{'close'} REG";

        ## send a approval email ##
        my $templanguage = $language;
        {
            no strict qw(refs);
            $language = ${ $uid . $apruser }{'language'};
        }
        load_language('Email');
        require Sources::Mailer;
        my ($message);
        if ($emailpassword) {
            if ($admin_reason) {
                {
                    no strict qw(refs);
                    $message = template_email(
                        $pwreviewapprovedemail,
                        {
                            'displayname' => ${ $uid . $apruser }{'realname'},
                            'username'    => $apruser,
                            'reviewer'    => ${ $uid . $username }{'realname'},
                            'reason'      => $admin_reason,
                            'password'    => $foundpassword
                        }
                    );
                }
            }
            else {
                {
                    no strict qw(refs);
                    $message = template_email(
                        $pwinstantapprovedemail,
                        {
                            'displayname' => ${ $uid . $apruser }{'realname'},
                            'username'    => $apruser,
                            'reviewer'    => ${ $uid . $username }{'realname'},
                            'password'    => $foundpassword
                        }
                    );
                }
            }
        }
        else {
            if ($admin_reason) {
                {
                    no strict qw(refs);
                    $message = template_email(
                        $reviewapprovedemail,
                        {
                            'displayname' => ${ $uid . $apruser }{'realname'},
                            'username'    => $apruser,
                            'reviewer'    => ${ $uid . $username }{'realname'},
                            'reason'      => $admin_reason
                        }
                    );
                }
            }
            else {
                {
                    no strict qw(refs);
                    $message = template_email(
                        $instantapprovedemail,
                        {
                            'displayname' => ${ $uid . $apruser }{'realname'},
                            'username'    => $apruser,
                            'reviewer'    => ${ $uid . $username }{'realname'}
                        }
                    );
                }
            }
        }
        {
            no strict qw(refs);
            sendmail(
                ${ $uid . $apruser }{'email'},
                "$mailreg_txt{'apr_result_approved'} $mbname",
                $message, q{}, $emailcharset
            );
        }
        $language = $templanguage;

        if ($send_welcomeim) {
            my $messageid = $BASETIME . $PROCESS_ID;
            my $imsubject = $register_txt{'imsubject'};
            my $imtext    = $register_txt{'imtext'};
            if ( -e "$langdir/$language/welcome.txt" ) {
                our ($WELL);
                fopen( 'WELL', '<', "$langdir/$language/welcome.txt" );
                my $txt = <$WELL>;
                fclose('WELL');
                ( $imsubject, $imtext ) = split /[|]/xsm, $txt;
                chomp $imtext;
            }
            my $newpost =
"$messageid|$sendname|$apruser|||$imsubject|$date|$imtext|$messageid|0|$ENV{'REMOTE_ADDR'}|s|u||\n";
            our ($INBOX);
            fopen( 'INBOX', '>', "$memberdir/$apruser.msg" )
              or croak "$croak{'open'} INBOX";
            print {$INBOX} $newpost or croak "$croak{'print'} INBOX";
            fclose('INBOX') or croak "$croak{'close'} INBOX";
        }
    }
    $yysetlocation = qq~$adminurl?action=view_reglog~;
    redirectexit();
    return;
}

1;
