#/*
# *  Copyright 2007-2010 hkrn <hikarin@users.sourceforge.jp>
# *
# *  Licensed under the Apache License, Version 2.0 (the "License");
# *  you may not use this file except in compliance with the License.
# *  You may obtain a copy of the License at
# *
# *      http://www.apache.org/licenses/LICENSE-2.0
# *
# *  Unless required by applicable law or agreed to in writing, software
# *  distributed under the License is distributed on an "AS IS" BASIS,
# *  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# *  See the License for the specific language governing permissions and
# *  limitations under the License.
# */
#
# $Id: Virtual.pm 1966 2010-01-23 13:11:27Z hikarin $
#

package Img0ch::Thread::Virtual;

use strict;
use Digest::MD5 qw();
use Img0ch::Util::Trie qw();

BEGIN {
    my $pkg        = __PACKAGE__;
    my %privileges = (
        administrator      => 1,
        can_remove_res     => 2,
        can_remove_file    => 4,
        can_edit_res       => 8,
        can_stop_thread    => 16,
        can_restart_thread => 32,
        can_control_access => 64,
        can_edit_ngword    => 128,
        can_change_setting => 256,
        can_add_user       => 512,
        can_remove_user    => 1024,
        can_inherit_thread => 2048,
    );

    my $all_privileges = 0;
    map { $all_privileges += $_ } values %privileges;
    for my $method_name ( keys %privileges ) {
        no strict 'refs';
        my $privilege_value = $privileges{$method_name};
        *{"${pkg}::${method_name}"} = sub {$privilege_value}
    }

    no strict 'refs';
    *{"${pkg}::all_privileges"} = sub {$all_privileges};
    *{"${pkg}::privilege_methods"} = sub { return [ keys %privileges ] };
}

sub new {
    my ( $iClass, $iBBS, $key ) = @_;
    my $bbs     = $iBBS->get_name();
    my $iKernel = $iBBS->get_kernel();

    my $repos_virtual = '';
    $key
        and $repos_virtual
        = Img0ch::Maple::create_repository_subdirs( $key, 'virtual', $iBBS );

    bless {
        _bbs       => $bbs,
        _count     => 0,
        __hosts    => [],
        _kernel    => $iKernel,
        _key       => ( $key || 0 ),
        __i0_bbs   => $iBBS,
        __ngwords  => [],
        __prefix   => "I:T:V.${bbs}.${key}",
        _repos     => $iKernel->get_repos($repos_virtual),
        __settings => {},
        __users    => {},
    }, $iClass;
}

sub load {
    my ($iTVirtual) = @_;
    $iTVirtual->{_repos}->load();
    return 1;
}

sub save {
    my ($iTVirtual) = @_;
    my $iRepos      = $iTVirtual->{_repos};
    my $prefix      = $iTVirtual->{__prefix};

    my $host_count = $iRepos->get_int("${prefix}.deny._");
    my $hosts      = $iTVirtual->{__hosts};
    for ( my $i = 0; $i < $host_count; $i++ ) {
        my $re = $iRepos->remove("${prefix}.deny.${i}") || next;
        push @$hosts, $re;
    }
    my $trie      = Img0ch::Util::Trie->new();
    my $recounted = scalar @$hosts;
    for ( my $i = 0; $i < scalar @$hosts; $i++ ) {
        my $re = $hosts->[$i] || next;
        $iRepos->set( "${prefix}.deny.${i}", $re );
        $trie->add($re);
    }
    if ($recounted) {
        $iRepos->set( "${prefix}.deny._", $recounted );
        $iRepos->set_binary( "${prefix}.deny", $trie->regexp() );
    }
    else {
        $iRepos->set( "${prefix}.deny._", 0 );
        $iRepos->remove("${prefix}.deny");
    }

    my $new_ngwords = $iTVirtual->{__ngwords};
    my @old_ngwords = grep { $_ ne '' }
        split( ',', ( $iRepos->get_binary("${prefix}.ngword") || ',' ) );
    $iRepos->set_binary( "${prefix}.ngword",
        join( ',', @old_ngwords, @$new_ngwords ) );

    my $settings = $iTVirtual->{__settings};
    while ( my ( $key, $value ) = each %$settings ) {
        $iRepos->set( "${prefix}.SETTING.${key}", $value );
    }

    my $users = $iTVirtual->{__users};
    while ( my ( $name, $info ) = each %$users ) {
        my ( $pass, $privilege ) = @$info;
        my $id = Digest::MD5::md5_hex($name);
        $pass = Digest::MD5::md5_hex($pass);
        $iRepos->set( "${prefix}.user.${id}.name",      $name );
        $iRepos->set( "${prefix}.user.${id}.pass",      $pass );
        $iRepos->set( "${prefix}.user.${id}.privilege", $privilege );
    }

    $iRepos->save();
    @{ $iTVirtual->{__hosts} }    = ();
    @{ $iTVirtual->{__ngwords} }  = ();
    %{ $iTVirtual->{__users} }    = ();
    %{ $iTVirtual->{__settings} } = ();
    return 1;
}

sub inherit_from {
    my ( $iTVirtual, $key ) = @_;
    my $iBBS          = $iTVirtual->{__i0_bbs};
    my $iTVirtualFrom = Img0ch::Thread::Virtual->new( $iBBS, $key );
    my $users         = $iTVirtual->get_users();
    my $is_admin
        = $iTVirtual->administrator() | $iTVirtual->can_inherit_thread();
    my @user_array = grep { $_->{privilege} & $is_admin } values %$users;
    my $user_info  = shift @user_array;
    my $user_id    = $user_info->{id};
    my $user_pass  = $user_info->{pass};

    if ( $iTVirtualFrom->is_valid_raw( $user_id, $user_pass ) ) {
        my $privilege  = $iTVirtualFrom->get_privilege($user_id);
        my $iRepos     = $iTVirtual->{_repos};
        my $iReposFrom = $iTVirtualFrom->{_repos};
        my $bbs        = $iBBS->get_name();
        my $nkey       = $iTVirtual->get_key();
        my $keytable   = {};
        $iReposFrom->iterate(
            sub {
                my ( $key, $value, $keytable, $bbs, $nkey, $okey, ) = @_;
                if ( $key =~ /\AI:T:V\.$bbs\.$okey\./ ) {
                    $key
                        =~ s/\AI:T:V\.$bbs\.$okey\./I:T:V.${bbs}.${nkey}./xms;
                    $keytable->{$key} = $$value;
                }
                return 0;
            },
            $keytable,
            $bbs,
            $nkey,
            $key
        );
        while ( my ( $key, $value ) = each %$keytable ) {
            $iRepos->set( $key, $value );
        }
        $iRepos->save();
        return 1;
    }

    return 0;
}

sub set_user {
    my ( $iTVirtual, $user, $pass, $privilege ) = @_;
    $iTVirtual->{__users}->{$user} = [ $pass, ( $privilege || 0 ) ];
    return;
}

sub exists_user {
    my ( $iTVirtual, $user ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $id     = Digest::MD5::md5_hex($user);
    my $prefix = $iTVirtual->{__prefix};
    if ( !$iRepos->get("${prefix}.user.${id}.pass") ) {
        $id = Digest::MD5::md5_base64($user);
        return $iRepos->get("${prefix}.user.${id}.pass") ? 1 : 0;
    }
    return 1;
}

sub get_user {
    my ( $iTVirtual, $id ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = join '.', $iTVirtual->{__prefix}, 'user', $id;

    if ( my $privilege = $iRepos->get_int("${prefix}.privilege") ) {
        return {
            id        => $id,
            name      => ( $iRepos->get("${prefix}.name") || $id ),
            pass      => $iRepos->get("${prefix}.pass"),
            privilege => $privilege,
        };
    }
    else {
        return {
            id        => undef,
            name      => '',
            pass      => '',
            privilege => 0,
        };
    }
}

sub get_users {
    my ($iTVirtual) = @_;
    my $iRepos      = $iTVirtual->{_repos};
    my $ret         = {};
    my $stack       = [];

    $iRepos->iterate(
        sub {
            my ( $key, $value, $stack ) = @_;
            $key =~ /\AI:T:V\.[^\.]+\.[^\.]+\.user\.([^\.]+)\.pass/xms
                and push @$stack, $1;
            return 0;
        },
        $stack,
    );
    map { $ret->{$_} = $iTVirtual->get_user($_) } @$stack;

    return $ret;
}

sub is_valid {
    my ( $iTVirtual, $user, $pass ) = @_;
    ( !$user or !$pass ) and return 0;
    my $iRepos   = $iTVirtual->{_repos};
    my $prefix   = $iTVirtual->{__prefix};
    my $user_md5 = Digest::MD5::md5_hex($user);
    my $pass_md5 = Digest::MD5::md5_hex($pass);
    if ( $iRepos->get("${prefix}.user.${user_md5}.pass") ne $pass_md5 ) {
        $user_md5 = Digest::MD5::md5_base64($user);
        $pass_md5 = Digest::MD5::md5_base64($pass);
        return $iRepos->get("${prefix}.user.${user_md5}.pass") eq $pass_md5
            ? 1
            : 0;
    }
    return 1;
}

sub is_valid_raw {
    my ( $iTVirtual, $user, $pass ) = @_;
    ( !$user or !$pass ) and return 0;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    return $iRepos->get("${prefix}.user.${user}.pass") eq $pass ? 1 : 0;
}

sub get_privilege {
    my ( $iTVirtual, $user ) = @_;
    !$user and return 0;
    my $iRepos    = $iTVirtual->{_repos};
    my $prefix    = $iTVirtual->{__prefix};
    my $user_md5  = Digest::MD5::md5_hex($user);
    my $privilege = $iRepos->get_int("${prefix}.user.${user_md5}.privilege");
    if ( !$privilege ) {
        $user_md5 = Digest::MD5::md5_base64($user);
        return $iRepos->get_int("${prefix}.user.${user_md5}.privilege");
    }
    return $privilege;
}

sub remove_user {
    my ( $iTVirtual, $user ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    my $id_b64 = Digest::MD5::md5_base64($user);
    my $id_hex = Digest::MD5::md5_hex($user);
    $iRepos->remove("${prefix}.user.${id_b64}.name");
    $iRepos->remove("${prefix}.user.${id_b64}.pass");
    $iRepos->remove("${prefix}.user.${id_b64}.privilege");
    $iRepos->remove("${prefix}.user.${id_hex}.name");
    $iRepos->remove("${prefix}.user.${id_hex}.pass");
    $iRepos->remove("${prefix}.user.${id_hex}.privilege");
    $iRepos->remove("${prefix}.user.${user}.pass");
    $iRepos->remove("${prefix}.user.${user}.privilege");
    return;
}

sub set_setting {
    my ( $iTVirtual, $key, $value ) = @_;
    $iTVirtual->{__settings}->{$key} = $value;
    return;
}

sub set_settings {
    my ( $iTVirtual, $settings ) = @_;
    my $setting_internal = $iTVirtual->{__settings};
    while ( my ( $key, $value ) = each %$settings ) {
        $setting_internal->{$key} = $value;
    }
    return;
}

sub get_setting {
    my ( $iTVirtual, $key ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    return $iRepos->get("${prefix}.SETTING.${key}");
}

sub get_setting_int {
    Img0ch::Kernel::intval( $_[0]->get_setting( $_[1] ) );
}

sub remove_setting {
    my ( $iTVirtual, $key ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    return $iRepos->remove("${prefix}.SETTING.${key}");
}

sub get_setting_integer_keys {
    return qw(
        BBS_COLUMN_NUMBER
        BBS_DATMAX
        BBS_LINE_NUMBER
        BBS_MAIL_COUNT
        BBS_MESSAGE_COUNT
        BBS_NAME_COUNT
        BBS_RES_MAX
    );
}

sub get_setting_string_keys {
    return qw(
        BBS_NONAME_NAME
        BBS_DELETE_NAME
    );
}

sub get_setting_hidden_string_keys {
    return qw(
        THREAD_POSITION
    );
}

sub get_setting_boolean_keys {
    return qw(
        BBS_READONLY
    );
}

sub get_setting_string_max_length {
    my ($iTVirtual) = @_;
    my $iConfig = $iTVirtual->{_kernel}->get_config();
    return $iConfig->get_int('vta.setting_string_length_limit') || 64;
}

sub set_ngword {
    my ( $iTVirtual, $ngword ) = @_;
    index( $ngword, ',' ) >= 0 and return 0;
    push @{ $iTVirtual->{__ngwords} }, $ngword;
    return 1;
}

sub set_ngwords {
    my ( $iTVirtual, $ngword_or_ngwords ) = @_;
    my @ngwords = split ',', ( $ngword_or_ngwords || '' );
    push @{ $iTVirtual->{__ngwords} }, @ngwords;
    return;
}

sub get_ngwords {
    my ( $iTVirtual, $ngword ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    return [ split ',', $iRepos->get_binary("${prefix}.ngword") ];
}

sub remove_ngword {
    my ( $iTVirtual, $ngword ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    $iRepos->set_binary(
        "${prefix}.ngword",
        join( ',',
            grep { $_ ne $ngword }
                split ',',
            $iRepos->get_binary("${prefix}.ngword") )
    );
    return;
}

sub scan_text {
    my ( $iTVirtual, $text ) = @_;
    map { index( $text, $_ ) >= 0 and return 1 }
        @{ $iTVirtual->get_ngwords() };
    return 0;
}

sub set_denial_remote_host {
    my ( $iTVirtual, $host_re ) = @_;
    push @{ $iTVirtual->{__hosts} }, $host_re;
    return;
}

sub get_denied_remote_host {
    my ($iTVirtual) = @_;
    my $iRepos      = $iTVirtual->{_repos};
    my $prefix      = $iTVirtual->{__prefix};
    my $count       = $iRepos->get_int("${prefix}.deny._");
    my $ret         = [];
    for ( my $i = 0; $i < $count; $i++ ) {
        push @$ret, $iRepos->get("${prefix}.deny.${i}");
    }
    return $ret;
}

sub is_denied_remote_host {
    my ( $iTVirtual, $remote_host ) = @_;
    my $iRepos  = $iTVirtual->{_repos};
    my $prefix  = $iTVirtual->{__prefix};
    my $host_re = $iRepos->get_binary("${prefix}.deny") || return 0;
    return $remote_host =~ /$host_re/xms ? 1 : 0;
}

sub remove_denial_remote_host {
    my ( $iTVirtual, $host_re ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    my $count  = $iRepos->get_int("${prefix}.deny._");
    for ( my $i = 0; $i < $count; $i++ ) {
        my $re = $iRepos->get("${prefix}.deny.${i}");
        $re eq $host_re and $iRepos->remove("${prefix}.deny.${i}");
    }
    return;
}

sub get_key { $_[0]->{_key} }

1;
__END__
