package XXV::MODULES::USER;

use strict;

use Tools;
use Event::File;
use Locale::gettext;
use File::Path;
use Net::IP::Match::Regexp qw( create_iprange_regexp match_ip );


# This module method must exist for XXV
# ------------------
sub module {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $args = {
        Name => 'USER',
        Description =>
gettext("This module managed a Useradministration Interface.
for use you can set a Level to the hole Modul with
a parameter 'Level' in the main root or you can set
the same parameter in a function."),
        Version => '0.45',
        Date => '04.09.2005',
        Author => 'xpix',
        Preferences => {
            active => {
                description => gettext('Switch the Userauthentification on or off'),
                default     => 'y',
                type        => 'confirm',
            },
            withAuth => {
                description => gettext('IP addresses with user authentification'),
                default     => '',
                type        => 'string',
                check       => sub{
                    my $value = shift || return;
                    my @ips = split(/\s*,\s*/, $value);
                    for (@ips) {
                        return undef, sprintf(gettext('Your IP number (%s) is wrong! You need a IP with range (xxx.xxx.xxx.xxx/xx)'), $_)
                            unless ($_ =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\/\d+/);
                    }
                    return $value;
                },
            },
            noAuth => {
                description => gettext('IP addresses without user authentification'),
                default     => '',
                type        => 'string',
                check       => sub{
                    my $value = shift || return;
                    my @ips = split(/\s*,\s*/, $value);
                    for (@ips) {
                        return undef, sprintf(gettext('Your IP number (%s) is wrong! You need a IP with range (xxx.xxx.xxx.xxx/xx)'), $_)
                            unless ($_ =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\/\d+/);
                    }
                    return $value;
                },
            },
            tempimages => {
                description => gettext('common directory for temporary images'),
                default     => '/var/cache/xxv/temp',
                type        => 'dir',
                required    => gettext('This is required!'),
            },
        },
        Commands => {
            unew => {
                description => gettext('Create a new account for user'),
                short       => 'un',
                callback    => sub{ $obj->create(@_) },
                Level       => 'admin',
            },
            udelete => {
                description => gettext("Delete a account of user 'uid'"),
                short       => 'ud',
                callback    => sub{ $obj->delete(@_) },
                Level       => 'admin',
            },
            uedit => {
                description => gettext("Edit a account of user 'uid'"),
                short       => 'ue',
                callback    => sub{ $obj->edit(@_) },
                Level       => 'admin',
            },
            uprefs => {
                description => gettext("Change the own preferences"),
                short       => 'up',
                callback    => sub{ $obj->userprefs(@_) },
                Level       => 'user',
            },
            ulist => {
                description => gettext("List the accounts of user 'uid'"),
                short       => 'ul',
                callback    => sub{ $obj->list(@_) },
                Level       => 'admin',
            },
        },
    };
    return $args;
}

# ------------------
sub new {
# ------------------
	my($class, %attr) = @_;
	my $self = {};
	bless($self, $class);

    # paths
    $self->{paths} = delete $attr{'-paths'};

	# who am I
    $self->{MOD} = $self->module;

    # all configvalues to $self without parents (important for ConfigModule)
    map {
        $self->{$_} = $attr{'-config'}->{$self->{MOD}->{Name}}->{$_} || $self->{MOD}->{Preferences}->{$_}->{default}
    } keys %{$self->{MOD}->{Preferences}};

    # read the DB Handle
    $self->{dbh} = delete $attr{'-dbh'};

    # The Initprocess
    my $erg = $self->init or return error('Problem to initialze Module');

	return $self;
}

# ------------------
sub init {
# ------------------
    my $obj = shift || return error ('No Object!' );

    # Old Version
    if(tableExists($obj->{dbh}, 'USER')) {
        # Nicht loeschen da das Userdata sind
		my $fields = fields($obj->{dbh}, 'select * from USER');
        warn "Upps, you have a incompatible Database. Please use the script contrib/upgrade-xxv.sh to convert the database!"
            unless(scalar @$fields == 9);
    }

    # Look for table or create this table
    my $version = main::getVersion;
    my $erg = $obj->{dbh}->do(qq|
      CREATE TABLE IF NOT EXISTS USER (
          Id int(16) unsigned auto_increment NOT NULL,
          Name varchar(100) NOT NULL default '',
          Password varchar(100) NOT NULL,
          Level set('admin', 'user', 'guest' ) NOT NULL,
          Prefs varchar(100) default '',
          UserPrefs varchar(100) default '',
          Deny set('tlist', 'alist', 'rlist', 'mlist', 'tedit', 'aedit', 'redit', 'remote', 'cedit'),
          MaxLifeTime int(2) default '0',
          MaxPriority int(2) default '0',
          PRIMARY KEY  (Id)
        ) COMMENT = '$version'
    |);

    # The Table is empty? Make a default User ...
    unless($obj->{dbh}->selectall_arrayref('select count(*) from USER')->[0][0]) {
        $obj->insert({
            Name => 'xxv',
            Password => 'xxv',
            Level => 'admin',
        });
    }
}


# ------------------
sub create {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $watcher = shift || return error ('No Watcher!');
    my $console = shift || return error ('No Console');
    my $id      = shift || 0;
    my $data    = shift || 0;

    $obj->edit($watcher, $console, $id, $data);

}

# ------------------
sub userprefs {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $watcher = shift || return error ('No Watcher!');
    my $console = shift || return error ('No Console');
    my $id      = shift || $obj->{USER}->{Id};
    my $data    = shift || 0;

    my $user;
    if($id and not ref $data) {
        $user = $obj->{dbh}->selectrow_hashref("select * from USER where Id = '$id'")
            or return $console->message(sprintf(gettext("Account for user with ID '%s' is not exist in Database!"),$id));

            # question erwartet ein Array
            my @levels = split(/\s*,\s*/, $user->{Levels});
            $user->{Levels} = \@levels;
    }

    my $questions = [
        'Id' => {
            typ     => 'hidden',
            def     => $user->{Id} || 0,
        },
        'Password' => {
            typ   => 'password',
            msg   => gettext("Password for this account"),
            req   => gettext('This is required!'),
            def   => '',
            check   => sub{
                my $value = shift || return;
                # If no password given the
                # take the old password as default
                if($console->typ eq 'HTML') {
                    if($value->[0] and $value->[0] ne $value->[1]) {
                        return undef, gettext("Field with 1st and 2nd password must be equal to confirm!");
                    } else {
                        return $value->[0];
                    }
                }
                else {
                    return $value;
                }
            },
        },
        'UserPrefs' => {
            def     => $user->{UserPrefs} || '',
            msg     => gettext("Personality preferences for this User: ModName::Param=value, "),
            typ     => 'string',
            check   => sub{
                my $value = shift || return;
                foreach my $pref (split(',', $value)) {
                    my ($modname, $parameter, $value) = $pref =~ /(\S+)::(\S+)\=(.+)/sg;
                    if(my $mod = main::getModule($modname)) {
                        unless(exists $mod->{$parameter}) {
                            return undef, sprintf(gettext("The Parameter '%s' in Module '%s' is doesn't exists!"),$parameter, $mod);
                        }
                    }
                }
                return $value;
            },
        },
    ];

    # Ask Questions
    $data = $console->question(sprintf(gettext('Edit preferences of user: %s'), $obj->{USER}->{Name}), $questions, $data);

    if(ref $data eq 'HASH') {
        $obj->insert($data);

        $obj->refreshUserSettings($data->{UserPrefs}, $user->{UserPrefs});

        $console->message(gettext('Account for user saved!'));
        if($console->typ eq 'HTML') {
            $console->redirect({url => '?', parent => 'top', wait => 2});
            $console->message(gettext('Please wait ... refresh the interface!'));
        }
    }
    return 1;
}


# ------------------
sub edit {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $watcher = shift || return error ('No Watcher!');
    my $console = shift || return error ('No Console');
    my $id      = shift || 0;
    my $data    = shift || 0;

    my $user;
    if($id and not ref $data) {
        $user = $obj->{dbh}->selectrow_hashref("select * from USER where Id = '$id'")
            or return $console->message(sprintf(gettext("Account for user with ID '%s' is not exist in Database!"),$id));

            # question erwartet ein Array
            my @levels = split(/\s*,\s*/, $user->{Levels});
            $user->{Levels} = \@levels;

            my @deny = split(/\s*,\s*/, $user->{Deny});
            $user->{Deny} = \@deny;
    }

    my $questions = [
        'Id' => {
            typ     => 'hidden',
            def     => $user->{Id} || 0,
        },
        'Name' => {
            msg   => gettext("Name from this account"),
            req   => gettext('This is required!'),
            def   => $user->{Name} || '',
        },
        'Password' => {
            typ   => 'password',
            msg   => gettext("Password for this account"),
            req   => gettext('This is required!'),
            def   => '',
            check   => sub{
                my $value = shift || return;
                # If no password given the
                # take the old password as default
                if($console->typ eq 'HTML') {
                    if($value->[0] and $value->[0] ne $value->[1]) {
                        return undef, gettext("Field with 1st and 2nd password must be equal to confirm!");
                    } else {
                        return $value->[0];
                    }
                }
                else {
                    return $value;
                }
            },
        },
        'Level' => {
            def     => $user->{Level} || 'guest',
            msg     => gettext("Level for this account"),
            typ     => 'radio',
            req     => gettext('This is required!'),
            choices => ['admin', 'user', 'guest']
        },
        'Deny' => {
            msg   => gettext('Deny class of commands'),
            typ   => 'checkbox',
            choices   => ['tlist', 'alist', 'rlist', 'mlist', 'tedit', 'aedit', 'redit', 'remote'],
            def   => $user->{Deny} || '',
            check   => sub{
                my $value = shift || '';
                my $data = shift || return error('No Data in CB');
                my @vals = (ref $value eq 'ARRAY') ? @$value : split(/\s*,\s*/, $value);

                foreach my $v (@vals) {
                    unless(grep($_ eq $v, @{$data->{choices}})) {
                        my $ch = join(' ', @{$data->{choices}});
                        return undef, sprintf(gettext("You can choose: %s!"),$ch);
                    }
                }
                return join(',', @vals);
            },
        },
        'Prefs' => {
            def     => $user->{Prefs} || '',
            msg     => gettext("Preferences for this User: ModName::Param=value, "),
            typ     => 'string',
            check   => sub{
                my $value = shift || return;
                foreach my $pref (split(',', $value)) {
                    my ($modname, $parameter, $value) = $pref =~ /(\S+)::(\S+)\=(.+)/sg;
                    if(my $mod = main::getModule($modname)) {
                        unless(exists $mod->{$parameter}) {
                            return undef, sprintf(gettext("The Parameter '%s' in Module '%s' is doesn't exists!"),$parameter, $mod);
                        }
                    }
                }
                return $value;
            },
        },
        'MaxLifeTime' => {
            msg   => gettext("Maximally permitted value for lifetime on timers"),
            def   => $user->{MaxLifeTime} || '0',
            type  => 'integer',
            check   => sub{
                my $value = shift || return 0;
                unless(int($value) and int($value) > 0 and int($value) < 100) {
                    return undef, gettext("This value is not a integer or not between 0 and 100");
                }
                return $value;
            },
        },
        'MaxPriority' => {
            msg   => gettext("Maximally permitted value for priority on timers"),
            def   => $user->{MaxPriority} || '0',
            type  => 'integer',
            check   => sub{
                my $value = shift || return 0;
                unless(int($value) and int($value) > 0 and int($value) < 100) {
                    return undef, gettext("This value is not a integer or not between 0 and 100");
                }
                return $value;
            },
        },
    ];

    # Ask Questions
    $data = $console->question(($id ? gettext('Edit account of user')
				    : gettext('Create a new account for user')), $questions, $data);

    if(ref $data eq 'HASH') {
        $obj->insert($data);

        lg sprintf('%s account with name "%s" is saved from User: %s',
            ($id ? 'New' : 'Changed'),
            $data->{Name},
            $console->{USER}->{Name}
            );

        $console->message(gettext('Account for user saved!'));
        $console->redirect({url => $console->{browser}->{Referer}, wait => 2})
            if($console->typ eq 'HTML');
    }
    return 1;
}

# ------------------
sub delete {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $watcher = shift || return error ('No Watcher!');
    my $console = shift || return error ('No Console');
    my $id = shift || return $console->message(gettext("No ID for Account of user to delete! Please use udelete 'uid'"));

    my $erg = $obj->{dbh}->do("delete from USER where Id in ($id)")
        or return $console->message(sprintf gettext("Account for user with ID '%s' is not exist in Database!"), $id);
    $console->message(sprintf gettext("Account of user %s is deleted."), $id);

    lg sprintf('Delete user account "%s" from User: %s',
        $id,
        $console->{USER}->{Name}
        );

    $console->redirect({url => $console->{browser}->{Referer}, wait => 2})
        if($console->typ eq 'HTML');

}


# ------------------
sub list {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $watcher = shift || return error ('No Watcher!');
    my $console = shift || return error ('No Console');
    my $id      = shift || '';

    my $sql = "select Id, Name, Level, Prefs, UserPrefs from USER";
    my $fields = fields($obj->{dbh}, $sql);

    my $erg = $obj->{dbh}->selectall_arrayref($sql);
    unshift(@$erg, $fields);

    $console->table($erg);
}

# ------------------
sub logout {
# ------------------
    my $obj = shift || return error ('No Object!' );

    lg sprintf('User %s call logout',
        $obj->{USER}->{Name}
        );

    # get the default user settings
    $obj->setUserSettings($obj->{USER}->{UserPrefs}, 'rollback')
        if($obj->{USER}->{UserPrefs});

    # get the default settings
    $obj->setUserSettings($obj->{USER}->{Prefs}, 'rollback')
        if($obj->{USER}->{Prefs});

    main::toCleanUp($obj->{USER}->{Name});
    delete $obj->{USER};
    return 1;
}

# ------------------
sub checkIp {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $handle = shift || return;

    my $ip = getip($handle);

    lg sprintf('CheckIp from %s',
            $ip
        );

    if($obj->{withAuth}) {
        my $regexp = create_iprange_regexp(split(/\s*,\s*/, $obj->{withAuth}));
        if (match_ip($ip, $regexp)) {
           return 0;
        }
    }

    if($obj->{noAuth}) {
        my $regexp = create_iprange_regexp(split(/\s*,\s*/, $obj->{noAuth}));
        if (match_ip($ip, $regexp)) {
           return 1;
        }
    }
    return 0;
}

# ------------------
sub check {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $handle = shift || return;

    if($obj->checkIp($handle)) {
        $obj->{USER}->{Name} = 'NoLogin';
        $obj->{USER}->{Level} = 'admin';
    } else {

        my $name = shift || return;
        my $password = shift || return;

        lg sprintf('User %s try to login!',
            $name
            );

        my $oldprefs = $obj->{USER}->{UserPrefs};

        my $newUser = 0;
        if($name ne $obj->{USER}->{Name}) {
            $newUser = $name;
            $obj->logout();
        }

        # check User
        my $sql = sprintf "select * from USER where Name = '%s' and Password = md5('%s')", $name, $password;
        $obj->{USER} = $obj->{dbh}->selectrow_hashref($sql);

        # Set the user settings from user
        $obj->refreshUserSettings($obj->{USER}->{UserPrefs}, $oldprefs);

        # Set the user settings from admin
        $obj->setUserSettings($obj->{USER}->{Prefs}, 'set')
            if($obj->{USER}->{Prefs} and $newUser);
    }

    if(my $level = $obj->getLevel($obj->{USER}->{Level})) {
        $obj->{USER}->{value} = $level if($level);
    }

    return $obj->{USER};
}

# ------------------
sub refreshUserSettings {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $newprefs = shift || '';
    my $oldprefs = shift || '';

    return 1 if($newprefs eq $oldprefs);

    $obj->setUserSettings($oldprefs, 'rollback')
        if($oldprefs);

    $obj->setUserSettings($newprefs, 'set')
        if($newprefs);

    my $mod = main::getModule('CONFIG');
    $mod->reconfigure();

}


# ------------------
sub setUserSettings {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $prefs = shift || return error ('No Settings??');
    my $mode = shift || 'set';

    foreach my $pref (split(',', $prefs)) {
        my ($modname, $parameter, $value) = $pref =~ /(\S+)::(\S+)\=(.*)/sg;
        if(my $mod = main::getModule($modname) and my $cfg = main::getModule('CONFIG')->{config}) {
            if(exists $mod->{$parameter}) {
                if($mode eq 'set') {
                    $cfg->{$modname}->{$parameter} = $value;
                } else {
                    $cfg->{$modname}->{$parameter} = $mod->{$parameter};
                }
            } else {
                error("The Parameter '$parameter' in Module '$mod' is doesn't exists!");
            }
        }
    }
}


# ------------------
sub allowCommand {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $modCfg = shift || return error('No Moduleinformation');
    my $cmdName = shift || return error('No Command name');
    my $user = shift || return error('No User');
    my $DontdumpViolation = shift || '';

    if(
        (exists $modCfg->{Level} and $user->{value} < $obj->getLevel($modCfg->{Level}))
        or
        (exists $modCfg->{Commands}->{$cmdName}->{Level} and $user->{value} < $obj->getLevel($modCfg->{Commands}->{$cmdName}->{Level}))
        or
        (exists $user->{Deny} and exists $modCfg->{Commands}->{$cmdName}->{DenyClass} and $user->{Deny} =~ /$modCfg->{Commands}->{$cmdName}->{DenyClass}/)
    ) {
        warn(sprintf('User %s with Level %s has try to call command %s without permissions!',
            $user->{Name}, $user->{Level}, $cmdName))
		if($DontdumpViolation eq '');
        return 0;
    }
    return 1;
}

# A routine to check the commands
# this will return:
# my ($cmdobj, $cmdname, $shorterr, $error) = $obj->checkCommand($console, $command);
# $shorterr can have 'noperm', 'noactive', 'noexists'
# $err = full translated error message
# ------------------
sub checkCommand {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $console = shift || return error ('No Console' );
    my $ucmd = shift || return error ('No Command' );
    my $DontdumpViolation = shift || '';

    my $mods = main::getModules();
    my $err = 0;
    my $shorterr = 0;
    my $cmdobj = 0;
    my $cmdname = 0;
    my $cfg = main::getModule('CONFIG')->{config};
    my $ok = 0;

    # Checks the Commands Syntax (double shortcmds?)
    $obj->checkCmdSyntax()
        unless(defined $obj->{Check});

    foreach my $modName (keys %{$mods}) {
        my $modCfg = $mods->{$modName}->{MOD};
        foreach my $cmdName (sort keys %{$modCfg->{Commands}}) {
            if(lc($ucmd) eq $cmdName or lc($ucmd) eq $modCfg->{Commands}->{$cmdName}->{short}) {
                $ok++;
                $cmdobj = $modCfg->{Commands}->{$cmdName};
                $cmdname = $cmdName;
                # Check on active Modul
                if(exists $mods->{$modName}->{active} and $cfg->{$modCfg->{Name}}->{active} eq 'n') {
                    $err = sprintf(gettext("Sorry but the module %s is inactive! Switch this active in %s:Preferences:active = y"),
                        $modCfg->{Name}, $modCfg->{Name});
                    $shorterr = 'noactive';
                }

                if($obj->{active} eq 'y') {
                    # Check Userlevel and Permissions
                    unless($obj->allowCommand($modCfg, $cmdName, $console->{USER},$DontdumpViolation)) {
                        $err = gettext('You have no permissions on this command!');
                        $shorterr = 'noperm';
                    }
                }
            }
        }
    }
    unless($ok) {
        $err = sprintf(gettext("I don't understand the command '%s' \n"), $ucmd);
        $shorterr = 'noexists';
    }

    if($shorterr) {
        return (undef, 'nothing', $shorterr, $err)
    } else {
        return ($cmdobj, $cmdname, undef, undef)
    }
}

# ------------------
sub checkCmdSyntax {
# ------------------
    my $obj     = shift || return error ('No Object!' );
    my $mods    = main::getModules();

    my $shorts = {};
    foreach my $modName (keys %{$mods}) {
        my $modCfg = $mods->{$modName}->{MOD};
        foreach my $cmdName (sort keys %{$modCfg->{Commands}}) {
            my $short = $modCfg->{Commands}->{$cmdName}->{short};
            if(defined $shorts->{$short} ) {
                warn sprintf("[ERROR] In %s::%s double short name %s, also in %s!",
                    $modName, $cmdName, $short, $shorts->{$short});
            } else {
                $shorts->{$short} = $modName.'::'.$cmdName;
            }
        }
    }
    $obj->{Check} = 1;
}

# ------------------
sub getLevel {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $name = shift || return;

    # Level Table
    $obj->{LEV} = {
        admin   => 10,
        user    => 5,
        guest   => 1,
    } unless(exists $obj->{LEV});

    if($obj->{LEV}->{$name}) {
        return $obj->{LEV}->{$name};
    } else {
        return error("This Levelname '$name' is not exist");
    }

}

# ------------------
sub insert {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $data = shift || return;

    if(ref $data eq 'HASH') {
        my ($names, $vals, $kenn);
        map {

            if($_ eq 'Password') {
                if($data->{Password}) {
                    push(@$names, $_);
                    push(@$vals, $data->{$_});
                    push(@$kenn, 'MD5(?)');
                }
            } else {
                push(@$names, $_);
                push(@$vals, $data->{$_});
                push(@$kenn, '?');
            }

        } sort keys %$data;

        my $sql;
        if($data->{Id}) {
            my $temp = [];
            my $c = 0;
            foreach (@$names) {
                push(@$temp, sprintf("%s=%s", $names->[$c], $kenn->[$c]));
                $c++;
            }
            $sql = sprintf("UPDATE USER SET %s WHERE Id = %lu",
                    join(', ', @$temp),
                    $data->{Id},
            );
        } else {
            $sql = sprintf("REPLACE INTO USER (%s) VALUES (%s)",
                    join(', ', @$names),
                    join(', ', @$kenn),
            );
        }
        my $sth = $obj->{dbh}->prepare( $sql );
        $sth->execute( @$vals );
    } else {
        my $sth = $obj->{dbh}->prepare('REPLACE INTO USER VALUES (?,?,?,?)');
        $sth->execute( @$data );
    }
}

# ------------------
sub userTmp {
# ------------------
    my $obj = shift  || return error ('No Object!' );
    my $user = shift  || return error ('No User!' );

    # /var/cache/xxv/temp/xpix
    my $dir = sprintf('%s/%s', $obj->{tempimages} , $user);

    unless(-d $dir) {
        mkpath($dir) or warn "Can't mkpath $dir : $!";
    }

    # Nach Logout oder beenden von xxv das temp löschen
    main::toCleanUp($user, sub{ deleteDir($dir) }, 'logout')
        unless(main::toCleanUp($user, undef, 'exists')); # ein CB registrieren

    return $dir;
}

1;
