# ==================================================================
# Gossamer Forum - Advanced web community
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   Revision : $Id: Authenticate.pm,v 1.71.2.3 2003/02/09 04:09:59 jagerman Exp $
#
# Copyright (c) 2003 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#
# This module lets you integrate Gossamer Forum into another authentication
# system. You can do this by replacing the functions with your own code.
# Note: on any error, be sure to set $Auth_Error to the appropriate error
# message.
#
package GForum::Authenticate;
# ==================================================================
use strict;
use GForum qw/:forum :user $DB $IN $CFG $USER $GUEST $SESSION $SESSION_TYPE %HIDDEN/;
use GT::Session::SQL;
use GT::Plugins;
use GT::AutoLoader;
use vars qw/$VERSION @EXPORT $STH $Auth_Error %AUTH_FORUM_CACHE/; # Rely on %AUTH_FORUM_CACHE being cleared in GForum::init()

q$Revision: 1.71.2.3 $ =~ /(\d+)\.(\d+)(?:\.(\d+)\.(\d+))/;
$VERSION    = sprintf "%d.%03d", $1, $2 + ($3 || 0) + ($4 || 0);

sub auth {
# -------------------------------------------------------------------
# Runs the request auth function through the plugin system.
#
    my ($auth, @args) = @_;
    $Auth_Error = undef;
    my $sub = "auth_$auth";
    no strict 'refs';
    defined &{$sub} or exists $COMPILE{$sub} or die "Invalid authenticate method: $sub called.";
    GT::Plugins->dispatch($CFG->{admin_root_path} . '/Plugins/GForum', $sub, sub { $sub->(@_) }, @args);
}

sub auth_init {
# -------------------------------------------------------------------
# This function is guaranteed to be called before any other authentication
# function, but may be called multiple times during one request. 
#
    return 1;
}

$COMPILE{auth_add_user} = __LINE__ . <<'END_OF_SUB';
sub auth_add_user {
# -------------------------------------------------------------------
# This function is called when a user is requesting to be added to
# the database. It receives a hash reference of the user information
# that is going to be added, and should return either the hash
# reference (with any necessary modifications made), or undef to
# indicate failure.
#
    my $args = shift;
    return $args;
}
END_OF_SUB

$COMPILE{auth_del_user} = __LINE__ . <<'END_OF_SUB';
sub auth_del_user {
# -------------------------------------------------------------------
# This function is called when a user is being deleted. It returns 1
# if the user is allowed to be deleted, 0/undef otherwise.
    my $user_id = shift;
    return 1;
}
END_OF_SUB

$COMPILE{auth_disable_user} = __LINE__ . <<'END_OF_SUB';
sub auth_disable_user {
# -------------------------------------------------------------------
# This function is called whenever the admin is attempting to disable
# a user through the admin.
# A single number is passed in - the user_id field from the User
# table. This subroutine should return 1 to allow the user to be
# disabled, or 0/undef to indicate that the user should not be
# disabled.
#
    my $user_id = shift;
    return 1;
}
END_OF_SUB

$COMPILE{auth_valid_user} = __LINE__ . <<'END_OF_SUB';
sub auth_valid_user {
# -------------------------------------------------------------------
# This function returns 1 if the user/pass combo is valid, 0/undef
# otherwise. If the user is valid, this subroutine will also set the
# global variable $GForum::USER. Note that if the user is disabled or
# the password is incorrect (or not set), this will return false and
# will set $GForum::USER to undef.
# This function checks the password against the user_password field, then
# the user_temp_pass field. If either one matches and the user_temp_pass
# field is set, it is deleted.
    my $username = shift;
    return unless defined $username and length $username;
    return unless defined(my $password = shift);
    if (!$USER or $USER->{user_username} ne $username) {
        # If $USER isn't set, or isn't correct, correct it.
        $USER = $DB->table('User')->select({ user_username => $username })->fetchrow_hashref or return;
    }

    my $return;
    my $password_good = 0;
    if ($CFG->{user_passwords_encrypted}) {
        $password_good = ($USER->{user_password} and check_crypt_pass($USER->{user_password}, $password));
        if ($USER->{user_temp_pass}) {
            if ($password_good or $password_good = check_crypt_pass($USER->{user_temp_pass}, $password)) {
                $DB->table('User')->update({ user_temp_pass => undef }, { user_id => $USER->{user_id} });
            }
        }
    }
    else {
        $password_good = $password eq $USER->{user_password};
        if ($USER->{user_temp_pass}) {
            if ($password_good or $password_good = $password eq $USER->{user_temp_pass}) {
                $DB->table('User')->update({ user_temp_pass => undef }, { user_id => $USER->{user_id} });
            }
        }
    }
    if ($password_good and $USER->{user_enabled} and not $USER->{user_val_code} and $USER->{user_admin_validated} and $USER->{user_status} > ANONYMOUS) {
        $return = 1;
    }
    elsif ($password_good and not $USER->{user_enabled}) {
        $Auth_Error = GForum::language('LOGIN_DISABLED');
        $USER = $return = undef;
    }
    elsif ($password_good and ($USER->{user_val_code} or not $USER->{user_admin_validated})) {
        $Auth_Error = GForum::language('LOGIN_NOT_VALIDATED');
        $USER = $return = undef;
    }
    elsif ($password_good and $USER->{user_status} <= ANONYMOUS) {
        $Auth_Error = GForum::language('LOGIN_INVALID_USERNAME_PASSWORD');
        $USER = $return = undef;
    }
    else {
        $Auth_Error = GForum::language('LOGIN_INVALID_USERNAME_PASSWORD');
        $USER = $return = undef;
    }

    return $return;
}
END_OF_SUB

# Takes two arguments - an encrypted password (13 character crypt(), or 35-character MD5 crypt)
# and a plain text password. Returns true if the password verifies successfully.
$COMPILE{check_crypt_pass} = __LINE__ . <<'END_OF_SUB';
sub check_crypt_pass {
    my ($encrypted, $plaintext) = @_;
    my $password_good;
    if (length($encrypted) == 13) { # use crypt()
        $password_good = ($encrypted eq crypt($plaintext, $encrypted));
    }
    elsif (length($encrypted) == 35) { # use gt_md5_crypt()
        require GT::MD5::Crypt;
        $password_good = ($encrypted eq GT::MD5::Crypt::gt_md5_crypt($plaintext, $encrypted));
    }
    $password_good;
}
END_OF_SUB

$COMPILE{auth_change_username} = __LINE__ . <<'END_OF_SUB';
sub auth_change_username {
# -------------------------------------------------------------------
# This function takes 1 argument - the new username (The old one is
# taken from $USER). This sets $Auth_Error and returns 0/undef if the
# user is not able to change the username, or returns 1 if the change
# is acceptable.
#
    my $new_username = shift;
    return unless auth('valid_username', $new_username);
    $CFG->{username_allow_change} or $Auth_Error = GForum::language('USERNAME_CANT_CHANGE'), return;
    return 1;
}
END_OF_SUB

$COMPILE{auth_valid_username} = __LINE__ . <<'END_OF_SUB';
sub auth_valid_username {
# -------------------------------------------------------------------
# This function returns 1 if the username format is valid, 0/undef
# otherwise. This function also checks that the username has not been
# reserved and that it isn't already taken.
#
    return unless defined(my $username = shift);
    length $username or $Auth_Error = GForum::language('USERNAME_NOT_ENTERED'), return;
    my $max_length = ($CFG->{username_max_length} and $CFG->{username_max_length} <= 50 and $CFG->{username_max_length} >= 1)
        ? $CFG->{username_max_length}
        : 50;
    my $min_length = !$CFG->{username_min_length}
        ? 1
        : $CFG->{username_min_length} > $max_length
            ? $max_length
            : $CFG->{username_min_length} >= 1
                ? $CFG->{username_min_length}
                : 1;
    length $username > $max_length and $Auth_Error = GForum::language('USERNAME_TOO_LONG', $max_length), return;
    length $username < $min_length and $Auth_Error = GForum::language('USERNAME_TOO_SHORT', $min_length), return;

    # Now check to see if the username is reserved or banned
    for (@{$CFG->{reserved_usernames}}) {
        lc eq lc $username and $Auth_Error = GForum::language('USERNAME_RESERVED'), return;
    }

    my $invalid = $CFG->{username_invalid_chars}
        ? '\x00-\x1f' . _cc_escape($CFG->{username_invalid_chars})
        : '\x00-\x1f';
    $username =~ /[$invalid]/ and $Auth_Error = GForum::language('USERNAME_INVALID_CHARS'),   return;
    $username =~ /^\s/        and $Auth_Error = GForum::language('USERNAME_LEADING_SPACES'),  return;
    $username =~ /\s$/        and $Auth_Error = GForum::language('USERNAME_TRAILING_SPACES'), return;
    $DB->table('User')->count({ user_username => $username })
                              and $Auth_Error = GForum::language('USERNAME_EXISTS', $username), return;
    return 1;
}
END_OF_SUB

$COMPILE{auth_change_pass} = __LINE__ . <<'END_OF_SUB';
sub auth_change_pass {
# -------------------------------------------------------------------
# This function is called when changing the password. $USER must be
# set prior to calling this function (to access the user information).
# The function should return 1 to allow the password to be changed,
# 0/undef to not allow it. $Auth_Error should be set with the reason
# if it is not allowed!
#
    my $new_pass = shift;
    return 1;
}
END_OF_SUB

$COMPILE{auth_change_temp_pass} = __LINE__ . <<'END_OF_SUB';
sub auth_change_temp_pass {
# -------------------------------------------------------------------
# Just like auth_change_pass, except it is for the user_temp_pass
# column.
#
    my $new_temp_pass = shift;
    return 1;
}
END_OF_SUB

sub auth_run_command {
# -------------------------------------------------------------------
# This is passed the action requested and the associated hash ref in
# $CFG->{functions}.
# This returns 1 if the user is allowed to run the function, -1 if the
# user is banned from the function (a forum ban), 0/undef otherwise.
# The minimum forum permission returns 1 if it is reasonable to assume
# that an error will be caused if the function goes through - such as
# when a post does not exist.
#
    my ($do, $function) = @_;
    return 1 unless $function->{min_user_status}
        or (ref $function->{user_groups} and
            keys %{$function->{user_groups}})
        or $function->{min_forum_permission}
        or $function->{disabled};
    return undef if $function->{disabled};
    if ($function->{min_user_status} and (not $USER or $USER->{user_status} < $function->{min_user_status})) {
        return undef;
    }
    if ($function->{min_forum_permission}) {
        if (substr($do, 0, 5) eq 'forum') {
            my $forum_id = $IN->param('forum')
                or return;
            my $forum_perm = auth('forum_permission', $forum_id);
            if ($forum_perm == FORUM_PERM_BANNED) {
                return -1;
            }
            elsif ($forum_perm < $function->{min_forum_permission}) {
                return;
            }
        }
        elsif ($do ne 'post_view') { # post_view will always call post_view_somethingelse
            my ($param, $type);
            if ($function->{_auth_redo}) {
                my @redos  = split /\|/, $function->{_auth_redo};
                my @params = split /\|/, $function->{_auth_param};
                my @types  = split /\|/, $function->{_auth_type};
                for (0 .. $#redos) {
                    if ($redos[$_] eq $IN->param('redo')) {
                        $type = $types[$_];
                        $param = $params[$_];
                    }
                }
                return unless $type and $param;
            }
            $type  ||= $function->{_auth_type};
            $param ||= $function->{_auth_param};

            my ($forum_id, $post_id); # The following is here to get one of these, and ultimately, $forum_id
            if ($type and $param) {
                if ($type eq 'post') {
                    $post_id = $IN->param($param);
                }
                elsif ($type eq 'postatt') {
                    my $postatt_id = $IN->param($param);
                    my $postatt = $DB->table('PostAttachment')->get($postatt_id, 'ARRAY', ['post_id_fk'])
                        or return 1; # This is OKAY - the attachment does not exist, so they'll get some kind of error
                    $post_id = $postatt->[0];
                }
                elsif ($type eq 'forum') {
                    $forum_id = $IN->param($param);
                }
                elsif ($type eq 'forum&post') {
                    ($forum_id, $post_id) = map $IN->param($_), split '&', $param;
                }
            }
            else {
                $post_id = $IN->param('post');
                $forum_id = $IN->param('forum');
                if ($post_id and $forum_id) {
                    return; # Someone is probably trying to break this, but it won't work!
                }
                elsif (!$post_id and !$forum_id) {
                    return; # Minimum forum permission is set, but there doesn't seem to be any
                            # way to get it, so what choice do we have but to refuse access?
                }
            }
            if ($type eq 'forum&post') { # this special case needs to get permission for both a forum and a post, which will have a different forum_id
                # Something that uses this: thread moving and detaching
                my $post = $DB->table('Post')->get($post_id, 'ARRAY', ['forum_id_fk'])
                    or return;
                my $forum = $DB->table('Forum')->get($forum_id, 'ARRAY', ['forum_id'])
                    or return;
                my $forum_id_2 = $post->[0] or return;
                $forum_id = $forum->[0] or return;

                my ($min_f, $min_p) = split /&/, $function->{min_forum_permission};
                return unless _forum_perm($forum_id, $min_f);
                return unless _forum_perm($forum_id_2, $min_p);
            }
            else {
                if ($post_id and not $forum_id) {
                    my $post = $DB->table('Post')->get($post_id, 'ARRAY', ['forum_id_fk'])
                        or return 1; # The post doesn't exist, so they'll hopefully get some kind of error
                    $forum_id = $post->[0];
                }
                return unless $forum_id;
                return unless _forum_perm($forum_id, $function->{min_forum_permission});
            }
        }
    }
    if (ref $function->{user_groups} and keys %{$function->{user_groups}} and (!$USER or $USER->{user_status} != ADMINISTRATOR)) {
        return if !$USER; # There isn't a user, but this is restricted to certain user groups
        my $ug_table = $DB->table('UserGroup');
        my $found;
        for (keys %{$function->{user_groups}}) {
            next unless $function->{user_groups}->{$_};
            $found++, last if $ug_table->count({ user_id_fk => $USER->{user_id}, group_id_fk => $_ });
        }
        return unless $found;
    }
    # Wow! We got through all that!
    return 1; # Here's the prize!
}

sub auth_valid_session {
# -------------------------------------------------------------------
# This function checks to see if there is a valid session. It checks
# the CGI parameter 'session' for a session ID first, then the cookie
# parameter 'session'. If the session found is valid, this function
# sets the global $GForum::USER with a hash ref of the users details
# and returns 1. undef is returned for invalid (possibly expired)
# sessions. This function will also check that the user_id actually
# exists.
#
# Note: $SESSION_TYPE, if set, must be one of: param, cookie, or remember
    my $param_session = $IN->param('session');
    my $cookie_session = $IN->cookie($CFG->{cookie_prefix} . 'session');
    my $remember_me = $IN->cookie($CFG->{cookie_prefix} . 'remember');
    return unless $param_session or $cookie_session or $remember_me;
# Clean old sessions only once / session_timeout. The cleanup isn't time critical -
# GT::Session::SQL makes sure that a session's date is valid before returning it to us.
    if ($CFG->{session_timeout} and $CFG->{last_session_cleanup} + 60 * $CFG->{session_timeout} < time) {
        $CFG->{last_session_cleanup} = time;
        $CFG->save();
        GT::Session::SQL->new({ tb => $DB->table('Session') })->cleanup(60 * $CFG->{session_timeout});
    }
    my ($session_id, $session_type);
    if ($param_session) {
        $session_type = 'param';
        $session_id = $param_session;
    }
    elsif ($cookie_session) {
        $session_type = 'cookie';
        $session_id = $cookie_session;
    }
    if ($session_id and my $session = GT::Session::SQL->new($session_id, $DB->table('Session'))) {
        # a valid existing session
        if ($DB->table('User')->count({ user_id => $session->{info}->{session_user_id}, user_enabled => 1 })) {
            my $user_id = $session->{info}->{session_user_id};
            $USER = $DB->table('User')->get($user_id);
            $HIDDEN{session} = $session->{info}->{session_id} unless $session_type eq 'cookie';
            $SESSION_TYPE = $remember_me ? 'remember' : $session_type;
            $SESSION = $session;
            return $USER ? 1 : undef;
        }
        else {
            # there is a session set for an invalid user (doesn't exist or is disabled); delete the session.
            $DB->table('Session')->delete({ session_id => $session->{info}->{session_id} });
            $USER = undef;
            $SESSION = $SESSION_TYPE = undef;
            return;
        }
    }
    elsif ($remember_me) {
        # They have the "Remember Me" enabled, but no session cookie set, so we need to set one!
        if (my $remember = GT::Session::SQL->new({ session_id => $remember_me, expires => 0, tb => $DB->table('Remember') })) {
            if ($DB->table('User')->count({ user_id => $remember->{info}->{session_user_id}, user_enabled => 1, user_val_code => '', user_admin_validated => 1 })) {
                my $user_id = $remember->{info}->{session_user_id};
                $USER = $DB->table('User')->get($user_id);

                my ($usernew, $userlast);
                my $sth = $DB->table('UserNew')->select('forum_id_fk', 'usernew_last' => { user_id_fk => $USER->{user_id} });
                while (my $row = $sth->fetchrow_arrayref) {
                    $usernew->{$row->[0]} = $row->[1];
                    $userlast->{$row->[0]} = $row->[1];
                }

                my $session_data = { usernew => $usernew, userlast => $userlast, login_time => time, prior_last_seen => $USER->{user_last_seen} };

                # Now read the read posts from the PostNew table
                $sth = $DB->table('PostNew')->select('forum_id_fk', 'post_id_fk', 'root_id_fk', { user_id_fk => $USER->{user_id} });

                while (my ($fid, $pid, $rid) = $sth->fetchrow) {
                    $session_data->{posts}->{$fid}->{$pid} = time; # Consider the session creation time to be the time the posts were viewed
                    $session_data->{roots}->{$fid}->{$rid} = time; # Have to keep track of the root as well
                }

                $SESSION = GT::Session::SQL->new({
                    tb => $DB->table('Session'),
                    session_user_id => $USER->{user_id},
                    session_date    => time,
                    session_data    => $session_data
                });
                $SESSION->save();

                # Print out the cookie header. The content-type header will be printed later.
                print $IN->cookie(-name => $CFG->{cookie_prefix} . 'session', -value => $SESSION->{info}->{session_id}, -path => $CFG->{cookie_path} )->cookie_header, "\n";
                if ($CFG->{cookie_domain}) {
                    print $IN->cookie(-name => $CFG->{cookie_prefix} . 'session', -value => $SESSION->{info}->{session_id}, -path => $CFG->{cookie_path}, -domain => $CFG->{cookie_domain} )->cookie_header, "\n";
                }

                $SESSION_TYPE = 'remember';
                $DB->table('User')->update({ user_last_logon => time }, { user_id => $user_id });

                return 1;
            }
            else {
                # The user has been deleted or disabled
                $DB->table('Remember')->delete({ session_id => $remember->{info}->{session_id} });
                print $IN->cookie(-name => $CFG->{cookie_prefix} . 'remember', -value => $remember->{info}->{session_id}, -path => $CFG->{cookie_path}, -expires => "-1y")->cookie_header, "\n";
                if ($CFG->{cookie_domain}) {
                    print $IN->cookie(-name => $CFG->{cookie_prefix} . 'remember', -value => $remember->{info}->{session_id}, -path => $CFG->{cookie_path}, -expires => "-1y", -domain => $CFG->{cookie_domain})->cookie_header, "\n";
                }
                return;
            }
        }
    }
    return;
}

$COMPILE{auth_create_session} = __LINE__ . <<'END_OF_SUB';
sub auth_create_session {
# -------------------------------------------------------------------
# This function creates a session for the current $GForum::USER.
# If a redirect header is going to be printed, it is printed and 1
# is returned. Otherwise, 0 or undef is returned. This function
# always prints a header - by default it uses text/html, however you
# can modify it by using the CGI paramater "content-type"
#
    return unless $USER and $USER->{user_id}; # Don't do anything if there isn't someone to do something with

# Create a new session and save the information.
# A session is a hashref like this:
#    {
#        usernew => { forum_id => $current_session_last_time, ... }
#        userlast => { forum_id => $previous_session_last_time, ... }
#        login_time => $time,
#        prior_last_seen => $USER->{user_last_seen}
#        roots => {
#            $forum_id => {
#                $root_id => $time_thread_viewed,
#                ...
#            },
#            ...
#        },
#        posts => {
#            $forum_id => {
#                $post_id => $time_post_viewed,
#                ...
#            },
#            ...
#        }
#    }

    my $auth_type = 'Session';
    my $use_cookies = 1; # By default, always use cookies.
    if ($IN->param('remember_me')) {
        $auth_type = 'Remember';
    }
    elsif ($IN->param('dont_use_cookies')) {
        $use_cookies = 0;
    }

    my ($usernew, $userlast);
    my $sth = $DB->table('UserNew')->select(forum_id_fk => usernew_last => { user_id_fk => $USER->{user_id} });
    while (my $row = $sth->fetchrow_arrayref) {
        $usernew->{$row->[0]} = $row->[1];
        $userlast->{$row->[0]} = $row->[1];
    }

    my $session_data = { usernew => $usernew, userlast => $userlast, login_time => time, prior_last_seen => $USER->{user_last_seen} };

# Now read the read posts from the PostNew table
    $sth = $DB->table('PostNew')->select('forum_id_fk', 'post_id_fk', 'root_id_fk', { user_id_fk => $USER->{user_id} });

    while (my ($fid, $pid, $rid) = $sth->fetchrow) {
        $session_data->{posts}->{$fid}->{$pid} = time; # Consider the session creation time to be the time the posts were viewed
        $session_data->{roots}->{$fid}->{$rid} = time; # Have to keep track of the root as well
    }

# Now actually create the session
    $SESSION = GT::Session::SQL->new({
        tb => $DB->table('Session'),
        session_user_id => $USER->{user_id},
        session_date    => time,
        session_data    => $session_data
    });
    $SESSION->save();

# Now redirect to another URL and set cookies, or set URL string.
    my $url = $IN->param('url');
    my $redirect = 0;
    if ($auth_type eq 'Remember') {
        my $remember = GT::Session::SQL->new({
            tb => $DB->table('Remember'),
            session_user_id => $USER->{user_id},
            session_date    => 0x7FFF_FFFF
        });
        print $IN->cookie(-name => $CFG->{cookie_prefix} . 'remember', -value => $remember->{info}->{session_id}, -path => $CFG->{cookie_path}, -expires => "+10y")->cookie_header, "\n";
        if ($CFG->{cookie_domain}) {
            print $IN->cookie(-name => $CFG->{cookie_prefix} . 'remember', -value => $remember->{info}->{session_id}, -path => $CFG->{cookie_path}, -expires => "+10y", -domain => $CFG->{cookie_domain})->cookie_header, "\n";
        }
    }
    if ($use_cookies) {
        my @cookies;
        push @cookies, $IN->cookie(-name => $CFG->{cookie_prefix} . 'session', -value => $SESSION->{info}->{session_id}, -path => $CFG->{cookie_path} );
        if ($CFG->{cookie_domain}) {
            push @cookies, $IN->cookie(-name => $CFG->{cookie_prefix} . 'session', -value => $SESSION->{info}->{session_id}, -path => $CFG->{cookie_path}, -domain => $CFG->{cookie_domain} );
        }
        if ($url) {
            $url = "$CFG->{cgi_root_url}/$url" if $url !~ m|^https?://|;
            $url .= "&first_login=1" if $USER and $USER->{user_first_logon};
            print $IN->redirect(-cookie => \@cookies, -url => $url);
            $redirect = 1;
        }
        else {
            print $IN->header(-force => 1, -cookie => \@cookies);
        }
    }
    else {
        my $sid = $SESSION->{info}->{session_id};
        if ($url) {
            $url = "$CFG->{cgi_root_url}/$url" if $url !~ m|^https?://|;
            $url =~ s/([&;\?]session=)[^;&]*/$1$sid/ or
                $url .= (index($url, '?') >= 0 ? "&session=$sid" : "?session=$sid");
            $url .= "&first_login=1" if $USER and $USER->{user_first_logon};

            print $IN->redirect($url);
            $redirect = 1;
        }
        else {
            $HIDDEN{session} = $sid;
            $IN->param('session' => $sid);
            print $IN->header();
        }
    }
    return $redirect;
}
END_OF_SUB

# Sets %AUTH_FORUM_CACHE to something like this:
# %AUTH_FORUM_CACHE = (
#     banned     => { $forum_id => 1,     $forum_id => 1,     ... },
#     forum_perm => { $forum_id => $perm, $forum_id => $perm, ... }
# );
sub _load_forum_perm_cache {
    # The cache isn't set, so set it will all bans and forum permissions
    %AUTH_FORUM_CACHE = (
        banned     => { }, # { $forum_id => 1,     $forum_id => 1,     ... }
        permission => { }  # { $forum_id => $perm, $forum_id => $perm, ... }
    );

    my $ForumBan = $DB->table('ForumBan');
    my %groups = ($CFG->{id_group_guest} => 1);

    if ($ENV{REMOTE_ADDR}) {
        my $sth = $ForumBan->select(qw/ban_id forum_id_fk ban_expiry/ => { ban_ip => $ENV{REMOTE_ADDR} });
        while (my ($bid, $fid, $expiry) = $sth->fetchrow) { # IP bans
            if ($expiry and $expiry > 0 and $expiry < time) {
                $ForumBan->delete($bid);
                next;
            }
            $AUTH_FORUM_CACHE{banned}{$fid} = 1;
        }
    }

    if ($USER) {
        my $sth = $ForumBan->select(qw/ban_id forum_id_fk ban_expiry/ => { user_id_fk => $USER->{user_id} });
        while (my ($bid, $fid, $expiry) = $sth->fetchrow) { # User bans
            if ($expiry and $expiry > 0 and $expiry < time) {
                $ForumBan->delete($bid);
                next;
            }
            $AUTH_FORUM_CACHE{banned}{$fid} = 1;
        }

        # Make a list of the groups.
        $sth = $DB->table('UserGroup')->select(group_id_fk => { user_id_fk => $USER->{user_id} });
        while (my $id = $sth->fetchrow_array) {
            $groups{$id}++;
        }

        # Grab any moderator permissions
        $sth = $DB->table('ForumModerator')->select(forum_id_fk => { user_id_fk => $USER->{user_id} });
        while (my $fid = $sth->fetchrow) {
            $AUTH_FORUM_CACHE{permission}{$fid} = FORUM_PERM_MODERATOR;
        }
    }

    my $sth = $DB->table('ForumGroup')->select('forum_id_fk', 'forum_perms' => { group_id_fk => [keys %groups] });
    while (my ($fid, $perm) = $sth->fetchrow) {
        next if $AUTH_FORUM_CACHE{permission}{$fid} and $AUTH_FORUM_CACHE{permission}{$fid} > $perm;
        $AUTH_FORUM_CACHE{permission}{$fid} = $perm;
    }
}

# This function sets the 'user_forum_permission' key in $USER. It should be set
# to one of the FORUM_PERM_* contants in GForum.pm. It takes one argument - the
# forum ID of the forum the user is accessing. The forum permission is returned.
# 'user_forum_permission' is only set if $USER is set. This returns the
# permission the currently logged in user has to the forum. If no user is logged
# in, the guest permissions are returned. (Note that the return is the same as
# what is set as $USER->{user_forum_permission}). NOTE: If $USER is NOT set,
# this will not set user_forum_permission in $USER, but will instead set
# and return $GUEST->{guest_forum_permission}.
# Regardless of whether $USER or $GUEST is set,
# $GForum::Template::VARS{user_forum_permission} is set so that it will be
# available in any templates parsed.
sub auth_forum_permission {
    my $forum_id = shift;

    return $GForum::Template::VARS{user_forum_permission} = $USER->{user_forum_permission} = FORUM_PERM_MODERATOR
        if $USER and $USER->{user_status} == ADMINISTRATOR;

    my $return;

    _load_forum_perm_cache if not keys %AUTH_FORUM_CACHE;

    my $permission = $AUTH_FORUM_CACHE{permission}{$forum_id};
    my $banned     = $AUTH_FORUM_CACHE{banned}{$forum_id};
    if ($permission and $permission >= FORUM_PERM_MODERATOR) { # Check moderators before bans: a moderator cannot be banned from his forum
        $return = FORUM_PERM_MODERATOR;
    }
    elsif ($banned) {
        $return = FORUM_PERM_BANNED;
    }
    else {
        $return = $permission || FORUM_PERM_NONE;
    }

    if ($USER) {
        $USER->{user_forum_permission} = $return;
    }
    else {
        $GUEST->{guest_forum_permission} = $return;
    }
    $GForum::Template::VARS{user_forum_permission} = $return;

    return $return;
}

# Escapes a character class, but leaves ranges (a-z) and doesn't escape the \
# for hex escapes (\x20) or octal escapes (\040).
$COMPILE{_cc_escape} = __LINE__ . <<'END_OF_SUB';
sub _cc_escape {
    my $val = shift;
    $val =~ s/(\\(?!x[0-9A-Fa-f]{2}|[0-3][0-7]{2})|\[|\])/\\$1/g;
    $val;
}
END_OF_SUB

# Returns true or false - true if the permission of the user is found to be greater
# than or equal to the level passed in - see the FORUM_PERM_* constants in GForum.pm
# This always returns true if the user is an administrator.
sub _forum_perm {
    my ($forum_id, $level) = @_;
    my $perm = auth('forum_permission', $forum_id);
    return $perm >= $level;
}

1;