#/*
# *  Copyright 2007 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 850 2007-06-23 11:39:18Z hikarin $
#

package Img0ch::Thread::Virtual;

use strict;
use Digest::MD5 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,
    );

    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 = '';
    if ($key) {
        my ( undef, undef, undef, $day, $month, $year ) = localtime($key);
        $year  += 1900;
        $month += 1;
        $repos_virtual
            = $iBBS->get_repos_path( $year, $month, $day, $key, 'virtual' );
        my $repos_virtual_dir = $repos_virtual;
        $repos_virtual_dir =~ s{/virtual.\w+\z}{}xms;
        if ( !-d $repos_virtual_dir ) {
            require File::Path;
            File::Path::mkpath($repos_virtual_dir)
                or $iKernel->throw_io_exception($repos_virtual_dir);
        }
    }

    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 $trie       = Img0ch::Thread::Virtual::Regexp::Trie->new();
    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;
        $trie->add($re);
        push @$hosts, $re;
    }
    my $recounted = scalar @$hosts;
    for ( my $i = 0; $i < scalar @$hosts; $i++ ) {
        my $re = $hosts->[$i] || next;
        $iRepos->set( "${prefix}.deny.${i}", $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 ( $user, $info ) = each %$users ) {
        my ( $pass, $privilege ) = @$info;
        $user = Digest::MD5::md5_base64($user);
        $pass = Digest::MD5::md5_base64($pass);
        $iRepos->set( "${prefix}.user.${user}.pass",      $pass );
        $iRepos->set( "${prefix}.user.${user}.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->{__users};
    my @user_array    = keys %$users;
    my $user          = shift @user_array;
    my $user_info     = $users->{$user};

    if ( $iTVirtualFrom->is_valid( $user, $user_info->[0] ) ) {
        my $privilege = $iTVirtualFrom->get_privilege($user);
        if ( $privilege & $iTVirtual->administrator() ) {
            my $iRepos     = $iTVirtual->{_repos};
            my $iReposFrom = $iTVirtualFrom->{_repos};
            my $bbs        = $iBBS->get_name();
            my $nkey       = $iTVirtual->get_key();
            $iReposFrom->iterate(
                sub {
                    my ( $key, $value, $iRepos, $bbs, $nkey, $okey, ) = @_;
                    $key
                        =~ s/\AI:T:V\.$bbs\.$okey\./I:T:V.${bbs}.${nkey}./xms;
                    $iRepos->set( $key, $$value );
                    return 0;
                },
                $iRepos,
                $bbs,
                $nkey,
                $key
            );
            $iRepos->save();
            return 1;
        }
    }
    return 0;
}

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

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

    $iRepos->iterate(
        sub {
            my ( $key, $value, $stack ) = @_;
            $key =~ /\AI:T:V\.[^\.]+\.[^\.]+\.([^\.]+)\.pass/xms;
            push @$stack, $1;
            return 0;
        }
    );
    for my $user (@$stack) {
        my $prefix2 = "${prefix}.user.${user}";
        $ret->{$user} = {
            name      => $user,
            pass      => $iRepos->get("${prefix2}.pass"),
            privilege => $iRepos->get("${prefix2}.privilege"),
        };
    }
    return $ret;
}

sub is_valid {
    my ( $iTVirtual, $user, $pass ) = @_;
    ( !$user or !$pass ) and return 0;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    $user = Digest::MD5::md5_base64($user);
    $pass = Digest::MD5::md5_base64($pass);
    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};
    $user = Digest::MD5::md5_base64($user);
    return $iRepos->get_int("${prefix}.user.${user}.privilege");
}

sub remove_user {
    my ( $iTVirtual, $user ) = @_;
    my $iRepos = $iTVirtual->{_repos};
    my $prefix = $iTVirtual->{__prefix};
    $user = Digest::MD5::md5_base64($user);
    $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 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
        = index( $ngword_or_ngwords, ',' ) >= 0
        ? split( ',', $ngword_or_ngwords )
        : ($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 ) = @_;
    my $ngwords = $iTVirtual->get_ngwords();
    for my $ngword (@$ngwords) {
        index( $text, $ngword ) >= 0 and return 1;
    }
    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 $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} }

package Img0ch::Thread::Virtual::Regexp::Trie;

# import from Regexp::Trie by dan kogai
# for backward compatiblity

use strict;

sub new { bless {}, __PACKAGE__ }

sub add {
    my ( $this, $str ) = @_;
    my $ref = $this;
    for my $char ( split //, $str ) {
        $ref->{$char} ||= {};
        $ref = $ref->{$char};
    }
    $ref->{''} = 1;    # { '' => 1 } as terminator
    $this;
}

sub _regexp {
    my ($this) = @_;
    $this->{''} and scalar keys %$this == 1 and return;    # terminator

    my ( @alt, @cc );
    my $q = 0;
    for my $char ( sort keys %$this ) {
        my $qchar = quotemeta $char;
        if ( ref $this->{$char} ) {
            if ( defined( my $recurse = _regexp( $this->{$char} ) ) ) {
                push @alt, $qchar . $recurse;
            }
            else {
                push @cc, $qchar;
            }
        }
        else {
            $q = 1;
        }
    }

    my $cconly = !@alt;
    @cc and push @alt, @cc == 1 ? $cc[0] : '[' . join( '', @cc ) . ']';
    my $result = @alt == 1 ? $alt[0] : '(?:' . join( '|', @alt ) . ')';
    $q and $result = $cconly ? "$result?" : "(?:$result)?";

    return $result;
}

sub regexp { my $str = shift->_regexp(); return qr/$str/ }

1;
__END__
