-+
(Previous one)
+-
@@ -9883,1776 +9885,3 @@ diff -aurN smeserver-manager-0.1.0.old/r
-
-app->start;
-
-diff -aurN smeserver-manager-0.1.0.old/root/usr/share/perl5/vendor_perl/smeserver/Panel/useraccountsNew.pm smeserver-manager-0.1.0/root/usr/share/perl5/vendor_perl/smeserver/Panel/useraccountsNew.pm
---- smeserver-manager-0.1.0.old/root/usr/share/perl5/vendor_perl/smeserver/Panel/useraccountsNew.pm 2020-04-08 23:43:08.000000000 +0400
-+++ smeserver-manager-0.1.0/root/usr/share/perl5/vendor_perl/smeserver/Panel/useraccountsNew.pm 1970-01-01 04:00:00.000000000 +0400
-@@ -1,1310 +0,0 @@
--#!/usr/bin/perl -w
--
--#----------------------------------------------------------------------
--# $Id: smeserver-manager-add-basic-files.patch,v 1.1 2019/12/15 22:14:17 jcrisp Exp $
--#----------------------------------------------------------------------
--# copyright (C) 1999-2006 Mitel Networks Corporation
--#
--# This program is free software; you can redistribute it and/or modify
--# it under the terms of the GNU General Public License as published by
--# the Free Software Foundation; either version 2 of the License, or
--# (at your option) any later version.
--#
--# This program is distributed in the hope that it will be useful,
--# but WITHOUT ANY WARRANTY; without even the implied warranty of
--# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
--# GNU General Public License for more details.
--#
--# You should have received a copy of the GNU General Public License
--# along with this program; if not, write to the Free Software
--# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--#----------------------------------------------------------------------
--package smeserver::Panel::useraccountsNew;
--
--use strict;
--
--# Get shot of FormMagick and cgi
--
--
--use esmith::AccountsDB;
--use esmith::ConfigDB;
--#use esmith::FormMagick;
--#use esmith::cgi;
--use esmith::util;
--use File::Basename;
--use Exporter;
--use Carp qw(verbose);
--
--# This will have to go - where do we need it ?
--our @ISA = qw( Exporter);
--
--# Anything with print is a non starter and should be renamed
--our @EXPORT = qw(
-- get_user_accounts
-- print_user_table
-- print_acctName_field
-- print_groupMemberships_field
-- print_page_description
-- get_ldap_value
-- username_clash
-- pseudonym_clash
-- handle_user_accounts
-- modify_admin
-- emailforward
-- verifyPasswords
-- lock_account
-- remove_account
-- reset_password
-- check_password
-- print_save_or_add_button
-- get_pptp_value
-- print_ipsec_client_section
-- get_prop
--
-- system_password_compare
-- system_valid_password
-- system_change_password
-- system_check_password
-- system_authenticate_password
--);
--
--our $VERSION = sprintf '%d.%03d', q$Revision: 1.1 $ =~ /: (\d+).(\d+)/;
--
--our $accountdb = esmith::AccountsDB->open();
--our $configdb = esmith::ConfigDB->open();
--
--=pod
--
--=head1 NAME
--
--esmith::FormMagick::Panels::useraccounts - useful panel functions
--
--=head1 SYNOPSIS
--
--use esmith::FormMagick::Panels::useraccount;
--
--my $panel = esmith::FormMagick::Panel::useraccount->new();
--$panel->display();
--
--=head1 DESCRIPTION
--
--
--=head2 new();
--
--Exactly as for esmith::FormMagick
--
--=begin testing
--
--$ENV{ESMITH_ACCOUNT_DB} = "10e-smith-base/accounts.conf";
--$ENV{ESMITH_CONFIG_DB} = "10e-smith-base/configuration.conf";
--
--open DATA, "echo '
'|";
--use_ok('esmith::FormMagick::Panel::useraccounts');
--use vars qw($panel);
--ok($panel = esmith::FormMagick::Panel::useraccounts->new(),
--"Create panel object");
--close DATA;
--isa_ok($panel, 'esmith::FormMagick::Panel::useraccounts');
--$panel->{cgi} = CGI->new();
--$panel->parse_xml();
--
--{ package esmith::FormMagick::Panel::useraccounts;
--our $accountdb;
--::isa_ok($accountdb, 'esmith::AccountsDB');
--}
--
--=end testing
--
--=cut
--
--# Errrr ? No FormMagick now.
--sub new {
-- shift;
-- my $self = esmith::FormMagick->new();
-- $self->{calling_package} = (caller)[0];
-- bless $self;
-- return $self;
--}
--
--=head1 HTML GENERATION ROUTINES
--
--Routines for generating chunks of HTML needed by the panel.
--
--=head2 print_user_table
--
--Prints out the user table on the front page.
--
--=for testing
--$panel->print_user_table;
--like($_STDOUT_, qr/bart/, "Found usernames in user table output");
--like($_STDOUT_, qr/ff0000/, "Found red 'reset password' output");
--
--=cut
--
--# The whole print_user_table routine can go - we just need get_users here
--
--sub get_user_accounts {
-- #my $self = shift;
-- #my $q = $self->{cgi};
-- #my $account = $self->localise('ACCOUNT');
-- #my $acctName = $self->localise('USER_NAME');
-- #
-- #my $modify = $self->localise('MODIFY');
-- #my $resetpw = $self->localise('PASSWORD_RESET');
-- #my $lock = $self->localise('LOCK_ACCOUNT');
-- #my $account_locked = $self->localise('ACCOUNT_LOCKED');
-- #my $remove = $self->localise('REMOVE');
--
-- my @users = $accountdb->get('admin');
-- push @users, $accountdb->users();
--
-- unless ( scalar @users )
-- {
-- return "No user accounts available";
-- }
-- return @users;
--}
--
--# Not required
--
--sub print_user_table {
-- my $self = shift;
-- my $q = $self->{cgi};
-- my $account = $self->localise('ACCOUNT');
-- my $acctName = $self->localise('USER_NAME');
--
-- my $modify = $self->localise('MODIFY');
-- my $resetpw = $self->localise('PASSWORD_RESET');
-- my $lock = $self->localise('LOCK_ACCOUNT');
-- my $account_locked = $self->localise('ACCOUNT_LOCKED');
-- my $remove = $self->localise('REMOVE');
--
-- my @users = $accountdb->get('admin');
-- push @users, $accountdb->users();
--
-- unless ( scalar @users )
-- {
-- print $q->Tr($q->td($self->localise('NO_USER_ACCOUNTS')));
-- return "";
-- }
-- print "
\n \n ";
-- print $q->start_table ({-CLASS => "sme-border"}),"\n ";
-- print $q->Tr(
-- esmith::cgi::genSmallCell($q, $self->localise($account),"header"),
-- esmith::cgi::genSmallCell($q, $self->localise($acctName),"header"),
-- esmith::cgi::genSmallCell($q, $self->localise('VPN_CLIENT_ACCESS'), "header"),
-- esmith::cgi::genSmallCell($q, $self->localise('FORWARDING_ADDRESS'), "header"),
-- esmith::cgi::genSmallCell($q, $self->localise('ACTION'),"header",4));
--
-- my $scriptname = basename($0);
-- my $index=0;
--
-- foreach my $u (@users) {
-- my $username = $u->key();
-- my $first = $u->prop('FirstName');
-- my $last = $u->prop('LastName');
-- my $lockable = $u->prop('Lockable') || 'yes';
-- my $removable = $u->prop('Removable') || 'yes';
-- my $fwd = (($u->prop('EmailForward') || 'local') =~ m/^forward|both$/) ?
-- $u->prop('ForwardAddress') : '';
-- my $vpnaccess = $u->prop('VPNClientAccess') || 'no';
-- $vpnaccess = $vpnaccess eq 'yes' ? $self->localise('YES') :
-- $self->localise('NO');
--
-- my $params = $self->build_user_cgi_params($username, $u->props());
--
-- my $password_set = $u->prop('PasswordSet');
--
-- my $pagenum = ($username eq "admin") ? $self->get_page_by_name('SystemPasswordDummy')
-- : $self->get_page_by_name('ResetPasswordDummy');
--
-- # make normal links
-- my $lock_url = ($password_set eq 'yes') ?
-- qq($lock ) :
-- qq($account_locked);
--
-- $lock_url = "" unless ($lockable eq "yes");
--
-- my $where_next = ($username eq "admin") ? "ModifyAdmin" : "CreateModify";
-- my $action1 = "$modify ";
--
-- my $action2 = "$resetpw ";
--
-- unless ($password_set eq 'yes')
-- {
-- $action2 = "" . $action2 . " ";
-- }
--
-- my $action3 = ($removable eq "yes") ? "$remove " : '';
--
-- print $q->Tr(esmith::cgi::genSmallCell($q, $username,"normal")," ",
-- esmith::cgi::genSmallCell($q, "$first $last","normal")," ",
-- esmith::cgi::genSmallCell($q, $vpnaccess),
-- esmith::cgi::genSmallCell($q, $fwd),
-- esmith::cgi::genSmallCell($q, "$action1","normal")," ",
-- esmith::cgi::genSmallCell($q, "$action2","normal")," ",
-- esmith::cgi::genSmallCell($q, "$lock_url","normal")," ",
-- esmith::cgi::genSmallCell($q, "$action3","normal"));
--
-- $index++;
-- }
--
-- print qq( \n);
--
-- return "";
--}
--
--=head2 print_acctName_field
--
--This subroutine is used to generate the Account name field on the form in
--the case of "create user", or to make it a plain uneditable string in the case
--of "modify user".
--
--=begin testing
--
--my $self = esmith::FormMagick::Panel::useraccounts->new();
--$self->{cgi} = CGI->new("");
--print_acctName_field($self);
--like($_STDOUT_, qr/text.*acctName/, "print text field if acctName not set");
--like($_STDOUT_, qr/create/, "action=create if acctName not set");
--$self->{cgi}->param(-name => 'acctName', -value => 'foo');
--$self->{cgi}->param(-name => 'action', -value => 'modify');
--print_acctName_field($self);
--like($_STDOUT_, qr/hidden.*acctName/, "print hidden field if acctName is set");
--like($_STDOUT_, qr/modify/, "action=modify if acctName already set");
--
--=end testing
--
--=cut
--
--sub print_acctName_field {
-- my $self = shift;
-- my $cgi = $self->{cgi};
-- my $an = $cgi->param('acctName') || '';
-- print qq(
) . $self->localise('ACCOUNT_NAME') . qq( \n);
-- my $action = $cgi->param('action') || '';
-- if ( $action eq 'modify') {
-- print qq(
-- $an
--
-- );
-- # if there's no CGI data, fill in the fields with the account db
-- # data for this user
-- my $rec = $accountdb->get($an);
-- my $fn = $cgi->param('FirstName') ?
-- $cgi->param('FirstName') :
-- ($rec ? ($rec->prop('FirstName')) : '');
-- my $ln = $cgi->param('LastName') ?
-- $cgi->param('LastName') :
-- ($rec ? ($rec->prop('LastName')) : '');
-- my $dept = $cgi->param('Dept') ?
-- $cgi->param('Dept') :
-- ($rec ? ($rec->prop('Dept')) : '');
-- my $company = $cgi->param('Company') ?
-- $cgi->param('Company') :
-- ($rec ? ($rec->prop('Company')) : '');
-- my $street = $cgi->param('Street') ?
-- $cgi->param('Street') :
-- ($rec ? ($rec->prop('Street')) : '');
-- my $city = $cgi->param('City') ?
-- $cgi->param('City') :
-- ($rec ? ($rec->prop('City')) : '');
-- my $phone = $cgi->param('Phone') ?
-- $cgi->param('Phone') :
-- ($rec ? ($rec->prop('Phone')) : '');
-- my $emf = $cgi->param('EmailForward') ?
-- $cgi->param('EmailForward') :
-- ($rec ? ($rec->prop('EmailForward')) : 'local');
-- my $fwd = $cgi->param('ForwardAddress') ?
-- $cgi->param('ForwardAddress') :
-- ($rec ? ($rec->prop('ForwardAddress')) : '');
-- my $pptp = $cgi->param('VPNClientAccess') ?
-- $cgi->param('VPNClientAccess') :
-- ($rec ? ($rec->prop('VPNClientAccess')) : 'no');
-- # now that we're down with the 411, let's set the values
-- $cgi->param(-name=>'FirstName', -value=>$fn);
-- $cgi->param(-name=>'LastName', -value=>$ln);
-- $cgi->param(-name=>'Dept', -value=>$dept);
-- $cgi->param(-name=>'Company', -value=>$company);
-- $cgi->param(-name=>'Street', -value=>$street);
-- $cgi->param(-name=>'City', -value=>$city);
-- $cgi->param(-name=>'Phone', -value=>$phone);
-- $cgi->param(-name=>'EmailForward', -value=>$emf);
-- $cgi->param(-name=>'ForwardAddress', -value=>$fwd);
-- $cgi->param(-name=>'VPNClientAccess', -value=>$pptp);
-- } else {
-- print qq(
-- \n);
-- return undef;
--
--}
--
--=head2 print_groupMemberships_field()
--
--Builds a list of groups for the create/modify user screen.
--
--=begin testing
--
--my $self = esmith::FormMagick::Panel::useraccounts->new();
--$self->{cgi} = CGI->new("");
--$self->print_groupMemberships_field();
--like($_STDOUT_, qr/simpsons/, "Found simpsons in group list");
--like($_STDOUT_, qr/flanders/, "Found flanders in group list");
--$self->{cgi}->param(-name => 'acctName', -value => 'rod');
--$self->print_groupMemberships_field();
--like($_STDOUT_, qr/checked value="flanders"/, "Checked flanders group for user rod");
--
--=end testing
--
--=cut
--
--sub print_groupMemberships_field {
-- my ($self) = @_;
-- my $q = $self->{cgi};
-- my $user = $q->param('acctName');
--
-- if (my @groups = $accountdb->groups()) {
--
-- print "
",
-- $self->localise('GROUP_MEMBERSHIPS'),
-- " \n";
--
-- print $q->start_table({-class => "sme-border"}),"\n";
-- print $q->Tr(
-- esmith::cgi::genSmallCell($q, $self->localise('MEMBER'),"header"),
-- esmith::cgi::genSmallCell($q, $self->localise('GROUP'),"header"),
-- esmith::cgi::genSmallCell($q, $self->localise('DESCRIPTION'),"header")
-- );
--
-- foreach my $g (@groups) {
-- my $groupname = $g->key();
-- my $checked;
-- if ($user and $accountdb->is_user_in_group($user, $groupname)) {
-- $checked = 'checked';
-- } else {
-- $checked = '';
-- }
--
-- print $q->Tr(
-- $q->td(
-- " \n";
--
-- }
--
-- return undef;
--
--}
--
--=head2 print_page_description($self, "reset|lock|remove")
--
--Generates the page description for the the somewhat similar Reset
--Password, Lock Account and Remove Account pages.
--
--=begin testing
--
--my $self = esmith::FormMagick::Panel::useraccounts->new();
--$self->{cgi} = CGI->new({ acctName => 'bart' });
--print_page_description($self, "reset");
--like($_STDOUT_, qr/bart/, "print_page_description prints username");
--like($_STDOUT_, qr/Bart Simpson/, "print_page_description prints name");
--like($_STDOUT_, qr/RESET_DESC/, "print_page_description prints description");
--
--=end testing
--
--=cut
--
--sub print_page_description {
-- my ($self, $pagename) = @_;
-- unless (grep /^$pagename$/, qw(reset lock remove)) {
-- warn "Can't generate page description for invalid pagename $pagename\n";
-- return;
-- }
--
-- $pagename = uc($pagename);
--
-- my $desc = $self->localise("${pagename}_DESC");
-- my $desc2 = $self->localise("${pagename}_DESC2");
--
-- my $acctName = $self->{cgi}->param('acctName');
-- my $name = $accountdb->get($acctName)->prop('FirstName') . " "
-- . $accountdb->get($acctName)->prop('LastName');
--
-- print qq{
--
-- $desc "$acctName" ($name)
-- $desc2
--
-- };
--
-- return;
--}
--
--=head1 ROUTINES FOR FILLING IN FIELD DEFAULT VALUES
--
--=head2 get_ldap_value($field)
--
--This subroutine generates the default field value on the form using the
--parameter specified.
--
--In this case, the default field values come from LDAP/directory
--settings.
--
--If a CGI parameter has been passed that contains an account name, we
--assume that a value has already been set, as we're modifying a user, and
--use that value instead of a default.
--
--=for testing
--my $self = esmith::FormMagick::Panel::useraccounts->new();
--$self->{cgi} = CGI->new("");
--is(get_ldap_value($self, "Dept"), "Main", "Pick up default value from LDAP");
--$self->{cgi} = CGI->new({ acctName => 'bart' });
--is(get_ldap_value($self, "Dept"), undef, "Don't pick up LDAP data if username provided");
--
--=cut
--
--sub get_ldap_value {
-- my ($self, $field) = @_;
--
-- # don't do the lookup if this is a modification of an existing user
-- if ($self->{cgi}->param('acctName')) {
-- return $self->{cgi}->param($field);
-- }
--
-- my %CGIParam2DBfield = (
-- Dept => 'defaultDepartment',
-- Company => 'defaultCompany',
-- Street => 'defaultStreet',
-- City => 'defaultCity',
-- Phone => 'defaultPhoneNumber'
-- );
--
-- return $configdb->get('ldap')->prop($CGIParam2DBfield{$field});
--}
--
--sub get_pptp_value
--{
-- return $configdb->get('pptpd')->prop('AccessDefault') || 'no';
--}
--
--=head1 VALIDATION ROUTINES
--
--=head2 pseudonym_clash
--
--Validation routine to check whether a the first/last names clash with
--existing pseudonyms.
--
--Note that it won't be considered a "clash" if there is an existing
--pseudonym which belongs to the same user -- it's only a clash if the
--generated pseudonyms are the same but the usernames aren't.
--
--=begin testing
--
--my $self = esmith::FormMagick::Panel::useraccounts->new();
--
--$self->{cgi} = CGI->new({
-- acctName => 'skud',
-- FirstName => 'Kirrily',
-- LastName => 'Robert'
--});
--
--is (pseudonym_clash($self, 'Kirrily'), "OK", "New name doesn't clash pseudonyms");
--
--$self->{cgi} = CGI->new({
-- acctName => 'bart2',
-- FirstName => 'Bart',
-- LastName => 'Simpson'
--});
--
--isnt(pseudonym_clash($self, 'Bart'), "OK", "Existing pseudonym with non-matching username causes clash");
--
--$self->{cgi} = CGI->new({
-- acctName => 'bart',
-- FirstName => 'Bart',
-- LastName => 'Simpson'
--});
--
--is(pseudonym_clash($self, 'Bart'), "OK", "Existing pseudonym with matching username shouldn't clash");
--
--=end testing
--
--=cut
--
--sub pseudonym_clash {
-- my ($self, $first) = @_;
-- $first ||= "";
-- my $last = $self->{cgi}->param('LastName') || "";
-- my $acctName = $self->{cgi}->param('acctName') || "";
--
-- my $up = "$first $last";
--
-- $up =~ s/^\s+//;
-- $up =~ s/\s+$//;
-- $up =~ s/\s+/ /g;
-- $up =~ s/\s/_/g;
--
-- my $dp = $up;
-- $dp =~ s/_/./g;
--
-- $dp = $accountdb->get($dp);
-- $up = $accountdb->get($up);
--
-- my $da = $dp->prop('Account') if $dp;
-- my $ua = $up->prop('Account') if $up;
-- if ($dp and $da and $da ne $acctName)
-- {
-- return $self->localise('PSEUDONYM_CLASH',
-- {
-- acctName => $acctName,
-- clashName => $da,
-- pseudonym => $dp->key
-- });
-- }
-- elsif ($up and $ua and $ua ne $acctName)
-- {
-- return $self->localise('PSEUDONYM_CLASH',
-- {
-- acctName => $acctName,
-- clashName => $ua,
-- pseudonym => $up->key
-- });
-- }
-- else
-- {
-- return "OK";
-- }
--}
--
--=head2 emailforward()
--
--Validation routine for email forwarding
--
--=cut
--
--sub emailforward {
-- my ($self, $data) = @_;
-- my $response = $self->email_simple($data);
-- if ($response eq "OK")
-- {
-- return "OK";
-- }
-- elsif ($data eq "")
-- {
-- # Blank is ok, only if we're not forwarding, which means that the
-- # EmailForward param must be set to 'local'.
-- my $email_forward = $self->{cgi}->param('EmailForward') || '';
-- $email_forward =~ s/^\s+|\s+$//g;
-- return 'OK' if $email_forward eq 'local';
-- return $self->localise('CANNOT_CONTAIN_WHITESPACE');
-- }
-- else
-- {
-- return $self->localise('CANNOT_CONTAIN_WHITESPACE')
-- if ( $data =~ /\s+/ );
-- # Permit a local address.
-- return "OK" if $data =~ /^[a-zA-Z][a-zA-Z0-9\._\-]*$/;
-- return $self->localise('UNACCEPTABLE_CHARS');
-- }
--}
--
--=head2 verifyPasswords()
--
--Returns an error message if the two new passwords input don't match.
--
--=cut
--
--sub verifyPasswords {
-- my $self = shift;
-- my $pass2 = shift;
--
-- my $pass1 = $self->{cgi}->param('password1');
-- unless ($pass1 eq $pass2) {
-- $self->{cgi}->param( -name => 'wherenext', -value => 'Password' );
-- return "PASSWORD_VERIFY_ERROR";
-- }
-- return "OK";
--}
--
--=head1 CREATING AND MODIFYING USERS
--
--=head2 handle_user_accounts()
--
--This is the routine called by the "Save" button on the create/modify page.
--It checks the "action" param and calls either create_user() or modify_user()
--as appropriate.
--
--=cut
--
--sub handle_user_accounts {
-- my ($self) = @_;
--
-- my $cgi = $self->{cgi};
--
-- if ($cgi->param("action") eq "create") {
-- my $msg = create_user($self);
-- if ($msg eq 'USER_CREATED')
-- {
-- $self->success($msg);
-- }
-- else
-- {
-- $self->error($msg);
-- }
-- }
-- else {
-- modify_user($self);
-- $self->success('USER_MODIFIED');
-- }
--}
--
--=head2 print_save_or_add_button()
--
--=cut
--
--sub print_save_or_add_button {
--
-- my ($self) = @_;
--
-- my $cgi = $self->{cgi};
--
-- if (($cgi->param("action") || '') eq "modify") {
-- $self->print_button("SAVE");
-- } else {
-- $self->print_button("ADD");
-- }
--
--}
--
--=head2 modify_admin($self)
--
--=cut
--
--sub modify_admin
--{
-- my ($self) = @_;
--
-- my $acct = $accountdb->get('admin');
--
-- my %newProperties = (
-- 'FirstName' => $self->{cgi}->param('FirstName'),
-- 'LastName' => $self->{cgi}->param('LastName'),
-- 'EmailForward' => $self->{cgi}->param('EmailForward'),
-- 'ForwardAddress' => $self->{cgi}->param('ForwardAddress'),
-- 'VPNClientAccess'=> $self->{cgi}->param('VPNClientAccess'),
-- );
--
-- $acct->merge_props(%newProperties);
--
-- undef $accountdb;
--
-- my $status =
-- system ("/sbin/e-smith/signal-event", "user-modify-admin", 'admin');
--
-- $accountdb = esmith::AccountsDB->open();
--
-- if ($status == 0)
-- {
-- $self->success('USER_MODIFIED', 'First');
-- }
-- else
-- {
-- $self->error('CANNOT_MODIFY_USER', 'First');
-- }
-- return;
--}
--
--=head2 modify_user($self)
--
--=cut
--
--sub modify_user {
-- my ($self) = @_;
-- my $acctName = $self->{cgi}->param('acctName');
--
-- unless (($acctName) = ($acctName =~ /^(\w[\-\w_\.]*)$/)) {
-- return $self->error($self->localise('TAINTED_USER',
-- { acctName => $acctName }));
-- }
-- # Untaint the username before use in system()
-- $acctName = $1;
--
-- my $acct = $accountdb->get($acctName);
-- my $acctType = $acct->prop('type');
--
-- if ($acctType eq "user")
-- {
-- $accountdb->remove_user_auto_pseudonyms($acctName);
-- my %newProperties = (
-- 'FirstName' => $self->{cgi}->param('FirstName'),
-- 'LastName' => $self->{cgi}->param('LastName'),
-- 'Phone' => $self->{cgi}->param('Phone'),
-- 'Company' => $self->{cgi}->param('Company'),
-- 'Dept' => $self->{cgi}->param('Dept'),
-- 'City' => $self->{cgi}->param('City'),
-- 'Street' => $self->{cgi}->param('Street'),
-- 'EmailForward' => $self->{cgi}->param('EmailForward'),
-- 'ForwardAddress' => $self->{cgi}->param('ForwardAddress'),
-- 'VPNClientAccess'=> $self->{cgi}->param('VPNClientAccess'),
-- );
--
-- $acct->merge_props(%newProperties);
--
-- $accountdb->create_user_auto_pseudonyms($acctName);
--
-- my @old_groups = $accountdb->user_group_list($acctName);
-- my @new_groups = $self->{cgi}->param("groupMemberships");
-- $accountdb->remove_user_from_groups($acctName, @old_groups);
-- $accountdb->add_user_to_groups($acctName, @new_groups);
--
-- undef $accountdb;
--
-- unless (system ("/sbin/e-smith/signal-event", "user-modify",
-- $acctName) == 0) {
-- $accountdb = esmith::AccountsDB->open();
-- return $self->error('CANNOT_MODIFY_USER');
-- }
-- $accountdb = esmith::AccountsDB->open();
-- }
-- $self->success('USER_MODIFIED');
--}
--
--=head2 create_user
--
--Adds a user to the accounts db.
--
--=cut
--
--sub create_user {
-- my $self = shift;
-- my $q = $self->{cgi};
--
-- my $acctName = $q->param('acctName');
--
-- my $msg = $self->validate_acctName($acctName);
-- unless ($msg eq "OK")
-- {
-- return $msg;
-- }
--
-- $msg = $self->validate_acctName_length($acctName);
-- unless ($msg eq "OK")
-- {
-- return $msg;
-- }
--
-- $msg = $self->validate_acctName_conflict($acctName);
-- unless ($msg eq "OK")
-- {
-- return $msg;
-- }
--
-- my %userprops;
-- foreach my $field ( qw( FirstName LastName Phone Company Dept
-- City Street EmailForward ForwardAddress VPNClientAccess) )
-- {
-- $userprops{$field} = $q->param($field);
-- }
-- $userprops{'PasswordSet'} = "no";
-- $userprops{'type'} = 'user';
--
-- my $acct = $accountdb->new_record($acctName)
-- or warn "Can't create new account for $acctName (does it already exist?)\n";
-- $acct->reset_props(%userprops);
-- $accountdb->create_user_auto_pseudonyms($acctName);
-- my @groups = $self->{cgi}->param("groupMemberships");
-- $accountdb->add_user_to_groups($acctName, @groups);
--
-- undef $accountdb;
--
-- # Untaint the username before use in system()
-- $acctName =~ /^(\w[\-\w_\.]*)$/;
-- $acctName = $1;
--
-- if (system ("/sbin/e-smith/signal-event", "user-create", $acctName))
-- {
-- $accountdb = esmith::AccountsDB->open();
-- return $self->localise("ERR_OCCURRED_CREATING");
-- }
--
-- $accountdb = esmith::AccountsDB->open();
--
-- $self->set_groups();
-- return 'USER_CREATED';
--}
--
--=head2 set_groups
--
--Sets a user's groups in the accounts db. This is called as part of the
--create_user() routine.
--
--=cut
--
--sub set_groups
--{
-- my $self = shift;
-- my $q = $self->{cgi};
-- my $acctName = $q->param('acctName');
--
-- my @groups = $q->param('groupMemberships');
-- $accountdb->set_user_groups($acctName, @groups);
--
--}
--
--=head1 REMOVING ACCOUNTS
--
--=head2 remove_account()
--
--=cut
--
--sub remove_account {
-- my ($self) = @_;
-- my $acctName = $self->{cgi}->param('acctName');
--
-- my $acct = $accountdb->get($acctName);
-- if ($acct->prop('type') eq "user") {
-- $acct->set_prop('type', "user-deleted");
--
-- undef $accountdb;
--
-- # Untaint the username before use in system()
-- $acctName =~ /^(\w[\-\w_\.]*)$/;
-- $acctName = $1;
-- if (system ("/sbin/e-smith/signal-event", "user-delete", $acctName))
-- {
-- $accountdb = esmith::AccountsDB->open();
-- return $self->error("ERR_OCCURRED_DELETING");
-- }
--
-- $accountdb = esmith::AccountsDB->open();
-- $accountdb->get($acctName)->delete;
--
-- } else {
-- # FIXME - this should be handled by input validation
-- # XXX error message here
-- }
-- $self->{cgi}->param(-name => 'wherenext', -value => 'First');
--}
--
--=head1 RESETTING THE PASSWORD
--
--=head2 reset_password()
--
--=cut
--
--sub reset_password {
-- my ($self) = @_;
-- my $acctName = $self->{cgi}->param('acctName');
--
-- unless (($acctName) = ($acctName =~ /^(\w[\-\w_\.]*)$/)) {
-- return $self->error('TAINTED_USER');
-- }
-- $acctName = $1;
--
-- my $acct = $accountdb->get($acctName);
--
-- if ( $acct->prop('type') eq "user")
-- {
-- esmith::util::setUserPassword ($acctName,
-- $self->{cgi}->param('password1'));
--
-- $acct->set_prop("PasswordSet", "yes");
-- undef $accountdb;
--
-- if (system("/sbin/e-smith/signal-event", "password-modify", $acctName))
-- {
-- $accountdb = esmith::AccountsDB->open();
-- $self->error("ERR_OCCURRED_MODIFYING_PASSWORD");
-- }
-- $accountdb = esmith::AccountsDB->open();
--
-- $self->success($self->localise('PASSWORD_CHANGE_SUCCEEDED',
-- { acctName => $acctName}));
-- }
-- else
-- {
-- $self->error($self->localise('NO_SUCH_USER',
-- { acctName => $acctName}));
-- }
--}
--
--=head1 LOCKING AN ACCOUNT
--
--=head2 lock_account()
--
--=cut
--
--sub lock_account {
-- my ($self) = @_;
-- my $acctName = $self->{cgi}->param('acctName');
-- my $acct = $accountdb->get($acctName);
-- if ($acct->prop('type') eq "user")
-- {
-- undef $accountdb;
--
-- # Untaint the username before use in system()
-- $acctName =~ /^(\w[\-\w_\.]*)$/;
-- $acctName = $1;
-- if (system("/sbin/e-smith/signal-event", "user-lock", $acctName))
-- {
-- $accountdb = esmith::AccountsDB->open();
-- return $self->error("ERR_OCCURRED_LOCKING");
-- }
--
-- $accountdb = esmith::AccountsDB->open();
--
-- $self->success($self->localise('LOCKED_ACCOUNT',
-- { acctName => $acctName}));
-- }
-- else
-- {
-- $self->error($self->localise('NO_SUCH_USER',
-- { acctName => $acctName}));
-- }
--}
--
--
--=head1 MISCELLANEOUS ROUTINES
--
--=head2 build_user_cgi_params()
--
--Builds a CGI query string based on user data, using various sensible
--defaults and esmith::FormMagick's props_to_query_string() method.
--
--=cut
--
--sub build_user_cgi_params {
-- my ($self, $acctName, %oldprops) = @_;
--
-- my %props = (
-- page => 0,
-- page_stack => "",
-- ".id" => $self->{cgi}->param('.id') || "",
-- acctName => $acctName,
-- #%oldprops
-- );
--
-- return $self->props_to_query_string(\%props);
--}
--
--=pod
--
--=head2 validate_acctName
--
--Checks that the name supplied does not contain any unacceptable chars.
--Returns OK on success or a localised error message otherwise.
--
--=for testing
--is($panel->validate_acctName('foo'), 'OK', 'validate_acctName');
--isnt($panel->validate_acctName('3amigos'), 'OK', ' .. cannot start with number');
--isnt($panel->validate_acctName('betty ford'), 'OK', ' .. cannot contain space');
--
--=cut
--
--sub validate_acctName
--{
-- my ($self, $acctName) = @_;
--
-- unless ($accountdb->validate_account_name($acctName))
-- {
-- return $self->localise('ACCT_NAME_HAS_INVALID_CHARS',
-- {acctName => $acctName});
-- }
-- return "OK";
--}
--
--=head2 validate_account_length FM ACCOUNTNAME
--
--returns 'OK' if the account name is shorter than the maximum account name length
--returns 'ACCOUNT_TOO_LONG' otherwise
--
--=begin testing
--
--ok(($panel->validate_acctName_length('foo') eq 'OK'), "a short account name passes");
--ok(($panel->validate_acctName_length('fooooooooooooooooo') eq 'ACCOUNT_TOO_LONG'), "a long account name fails");
--
--=end testing
--
--=cut
--
--sub validate_acctName_length {
-- my $self = shift;
-- my $acctName = shift;
--
--
-- my $maxAcctNameLength = ($configdb->get('maxAcctNameLength')
-- ? $configdb->get('maxAcctNameLength')->prop('type')
-- : "") || 12;
--
-- if ( length $acctName > $maxAcctNameLength ) {
--
-- return $self->localise('ACCOUNT_TOO_LONG',
-- {maxLength => $maxAcctNameLength});
-- }
-- else {
-- return ('OK');
-- }
--}
--
--=head2 validate_acctName_conflict
--
--Returns 'OK' if the account name doesn't yet exist. Returns a localised error
--otherwise.
--
--=cut
--
--sub validate_acctName_conflict
--{
-- my $self = shift;
-- my $acctName = shift;
--
-- my $account = $accountdb->get($acctName);
-- my $type;
--
-- if (defined $account)
-- {
-- $type = $account->prop('type');
-- }
-- elsif (defined getpwnam($acctName) || defined getgrnam($acctName))
-- {
-- $type = "system";
-- }
-- else
-- {
-- return('OK');
-- }
-- return $self->localise('ACCOUNT_CONFLICT',
-- { account => $acctName,
-- type => $type,
--});
--}
--
--=head2 check_password
--
--Validates the password using the desired strength
--
--=cut
--
--sub check_password {
-- my $self = shift;
-- my $pass1 = shift;
--
-- my $check_type;
-- my $rec = $configdb->get('passwordstrength');
-- $check_type = ($rec ? ($rec->prop('Users') || 'none') : 'none');
--
-- return $self->validate_password($check_type,$pass1);
--}
--
--
--=head2 get_prop ITEM PROP
--
--A simple accessor for esmith::ConfigDB::Record::prop
--
--=cut
--
--sub get_prop
--{
-- my ($fm, $item, $prop, $default) = @_;
--
-- return $configdb->get_prop($item, $prop) || $default;
--}
--
--
--=head1 System Password manipulation routines
--
--XXX FIXME - These should be merged with the useraccouts versions
--
--=head2 system_password_compare
--
--=cut
--
--sub system_password_compare
--{
-- my $self = shift;
-- my $pass2 = shift;
--
-- my $pass1 = $self->{cgi}->param('pass');
-- unless ($pass1 eq $pass2) {
-- $self->{cgi}->param( -name => 'wherenext', -value => 'Password' );
-- return "SYSTEM_PASSWORD_VERIFY_ERROR";
-- }
-- return "OK";
--}
--
--=head2 system_valid_password
--
--Throw an error if the password doesn't consist solely of one or more printable characters.
--
--=cut
--
--sub system_valid_password
--{
-- my $self = shift;
-- my $pass1 = shift;
-- # If the password contains one or more printable character
-- if ($pass1 =~ /^([ -~]+)$/) {
-- return('OK');
-- } else {
-- $self->{cgi}->param( -name => 'wherenext', -value => 'Password' );
-- return 'SYSTEM_PASSWORD_UNPRINTABLES_IN_PASS';
-- }
--}
--
--=head2 system_check_password
--
--Validates the password using the desired strength
--
--=cut
--
--sub system_check_password
--{
-- my $self = shift;
-- my $pass1 = shift;
--
-- use esmith::ConfigDB;
-- my $conf = esmith::ConfigDB->open();
-- my $check_type;
-- my $rec;
-- if ($conf)
-- {
-- $rec = $conf->get('passwordstrength');
-- }
-- $check_type = ($rec ? ($rec->prop('Admin') || 'strong') : 'strong');
--
-- return $self->validate_password($check_type,$pass1);
--}
--
--=head2 authenticate_password
--
--Compares the password with the current system password
--
--=cut
--
--sub system_authenticate_password
--{
-- my $self = shift;
-- my $pass = shift;
--
-- if (esmith::util::authenticateUnixPassword( ($configdb->get_value("AdminIsNotRoot") eq 'enabled') ? 'admin' : 'root', $pass))
-- {
-- return "OK";
-- }
-- else
-- {
-- return "SYSTEM_PASSWORD_AUTH_ERROR";
-- }
--}
--
--=head2 system_change_password
--
--If everything has been validated, properly, go ahead and set the new password.
--
--=cut
--
--sub system_change_password
--{
-- my ($self) = @_;
-- my $pass = $self->{cgi}->param('pass');
--
-- ($configdb->get_value("AdminIsNotRoot") eq 'enabled') ? esmith::util::setUnixPassword('admin',$pass) : esmith::util::setUnixSystemPassword($pass);
-- esmith::util::setServerSystemPassword($pass);
--
-- my $result = system("/sbin/e-smith/signal-event password-modify admin");
--
-- if ($result == 0)
-- {
-- $self->success('SYSTEM_PASSWORD_CHANGED', 'First');
-- }
-- else
-- {
-- $self->error("Error occurred while modifying password for admin.", 'First');
-- }
--
-- return;
--}
--
--sub print_ipsec_client_section
--{
-- my $self = shift;
-- my $q = $self->cgi;
--
-- # Don't show ipsecrw setting unless the status property exists
-- return '' unless ($configdb->get('ipsec')
-- && $configdb->get('ipsec')->prop('RoadWarriorStatus'));
-- # Don't show ipsecrw setting unless /sbin/e-smith/roadwarrior exists
-- return '' unless -x '/sbin/e-smith/roadwarrior';
-- my $acct = $q->param('acctName');
-- my $rec = $accountdb->get($acct) if $acct;
-- if ($acct and $rec)
-- {
-- my $pwset = $rec->prop('PasswordSet') || 'no';
-- my $VPNaccess = $rec->prop('VPNClientAccess') || 'no';
-- if ($pwset eq 'yes' and $VPNaccess eq 'yes')
-- {
-- print $q->Tr(
-- $q->td({-class=>'sme-noborders-label'},
-- $self->localise('LABEL_IPSECRW_DOWNLOAD')),
-- $q->td({-class=>'sme-noborders-content'},
-- $q->a({-class=>'button-like',
-- -href=>"?action=getCert&user=$acct"},
-- $self->localise('DOWNLOAD'))));
-- }
-- }
-- return '';
--}
--
--sub get_ipsec_client_cert
--{
-- my $self = shift;
-- my $q = shift;
-- my $user = $q->param('user');
-- ($user) = ($user =~ /^(.*)$/);
--
-- die "Invalid user: $user\n" unless getpwnam($user);
--
-- open (KID, "/sbin/e-smith/roadwarrior get_client_cert $user |")
-- or die "Can't fork: $!";
-- my $certfile =
;
-- close KID;
--
-- require File::Basename;
-- my $certname = File::Basename::basename($certfile);
--
-- print "Expires: 0\n";
-- print "Content-type: application/x-pkcs12\n";
-- print "Content-disposition: inline; filename=$certname\n";
-- print "\n";
--
-- open (CERT, "<$certfile");
-- while ()
-- {
-- print;
-- }
-- close CERT;
--
-- return '';
--}
--
--sub display_email_forwarding
--{
-- return defined $configdb->get('smtpd');
--}
--
--1;
-diff -aurN smeserver-manager-0.1.0.old/root/usr/share/perl5/vendor_perl/smeserver/Panel/wblNew.pm smeserver-manager-0.1.0/root/usr/share/perl5/vendor_perl/smeserver/Panel/wblNew.pm
---- smeserver-manager-0.1.0.old/root/usr/share/perl5/vendor_perl/smeserver/Panel/wblNew.pm 2020-04-08 23:43:08.000000000 +0400
-+++ smeserver-manager-0.1.0/root/usr/share/perl5/vendor_perl/smeserver/Panel/wblNew.pm 1970-01-01 04:00:00.000000000 +0400
-@@ -1,455 +0,0 @@
--#!/usr/bin/perl -w
--
--# package esmith::FormMagick::Panel::wblNew;
--package smeserver::Panel::wblNew;
--
--use strict;
--use warnings;
--#use esmith::FormMagick;
--#use esmith::cgi;
--use esmith::ConfigDB;
--use esmith::util;
--use File::Basename;
--use Exporter;
--use Carp qw(verbose);
--
--our @ISA = qw( Exporter);
--
--our @EXPORT = qw(
--get_dnsbl
--get_rhsbl
--get_uribl
--get_sbllist
--get_rbllist
--get_ubllist
--get_badhelo
--get_badmailfrom
--get_whitelisthosts
--get_whitelisthelo
--get_whitelistsenders
--get_whitelistfrom
--create_modify_black
--create_modify_white
--email_update
--get_blacklistfrom
--create_modify_rbl
--);
--
--our $VERSION = sprintf '%d.%03d', q$Revision: 1.1 $ =~ /: (\d+).(\d+)/;
--
--our $db = esmith::ConfigDB->open() or die "Couldn't open ConfigDB\n";
--our $wdb = esmith::ConfigDB->open('wbl') or die "Couldn't open wbl dbase\n";
--our $sdb = esmith::ConfigDB->open('spamassassin') or die "Couldn't open spamassassin dbase\n";
--
--sub get_dnsbl
--{
-- return ($db->get_prop('qpsmtpd', 'DNSBL') || 'disabled');
--}
--
--sub get_rhsbl
--{
-- return ($db->get_prop('qpsmtpd', 'RHSBL') || 'disabled');
--}
--
--sub get_uribl
--{
-- return ($db->get_prop('qpsmtpd', 'URIBL') || 'disabled');
--}
--
--sub get_sbllist
--{
--my $sbllistform = $db->get_prop('qpsmtpd', 'SBLList') || '';
--$sbllistform =~ s/,/\n/g;
--return $sbllistform;
--}
--
--sub get_rbllist
--{
--my $rbllistform = $db->get_prop('qpsmtpd', 'RBLList') || '';
--$rbllistform =~ s/,/\n/g;
--return $rbllistform;
--}
--
--sub get_ubllist
--{
--my $rbllistform = $db->get_prop('qpsmtpd', 'UBLList') || '';
--$rbllistform =~ s/,/\n/g;
--return $rbllistform;
--}
--
--
--sub get_badhelo
--{
-- my %list = $wdb->get('badhelo')->props;
--
-- my @badhelo = ();
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "Black") {
-- push @badhelo, $parameter;
-- }
-- }
--
-- return "" unless (scalar @badhelo);
--
--# return join "\n", sort(@badhelo);
-- return sort(@badhelo);
--}
--
--sub get_badmailfrom
--{
-- my %list = $wdb->get('badmailfrom')->props;
--
-- my @badmailfrom = ();
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "Black") {
-- push @badmailfrom, $parameter;
-- }
-- }
--
-- return "" unless (scalar @badmailfrom);
--
--# return join "\n", sort(@badmailfrom);
-- return sort(@badmailfrom);
--}
--
--sub get_whitelisthosts
--{
-- my %list = $wdb->get('whitelisthosts')->props;
--
-- my @whitelisthosts = ();
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "White") {
-- push @whitelisthosts, $parameter;
-- }
-- }
--
-- return "" unless (scalar @whitelisthosts);
--
--# return join "\n", sort(@whitelisthosts);
-- return sort(@whitelisthosts);
--
--}
--
--sub get_whitelisthelo
--{
-- my %list = $wdb->get('whitelisthelo')->props;
--
-- my @whitelisthelo = ();
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "White") {
-- push @whitelisthelo, $parameter;
-- }
-- }
--
-- return "" unless (scalar @whitelisthelo);
--
--# return join "\n", sort(@whitelisthelo);
-- return sort(@whitelisthelo);
--}
--
--sub get_whitelistsenders
--{
-- my %list = $wdb->get('whitelistsenders')->props;
--
-- my @whitelistsenders = ();
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "White") {
-- push @whitelistsenders, $parameter;
-- }
-- }
--
-- return "" unless (scalar @whitelistsenders);
--
-- #return join "\n", sort(@whitelistsenders);
-- return sort(@whitelistsenders);
--}
--
--sub get_whitelistfrom
--{
-- my %list = $sdb->get('wbl.global')->props;
--
-- my @whitelistfrom = ();
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "White") {
-- push @whitelistfrom, $parameter;
-- }
-- }
--
-- return "" unless (scalar @whitelistfrom);
--
--# return join "\n", sort(@whitelistfrom);
-- return sort(@whitelistfrom);
--}
--
--sub create_modify_black
--{
-- my $fm = shift;
-- my $q = $fm->{'cgi'};
--
-- # qmail badhelo
-- my %list = $wdb->get('badhelo')->props;
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "Black") {
-- $wdb->get_prop_and_delete('badhelo', "$parameter");
-- }
-- }
--
-- my $BadHelo = $q->param("badhelo");
-- $BadHelo =~ s/\r\n/,/g;
-- my @BadHelo = sort(split /,/, $BadHelo);
-- foreach $BadHelo (@BadHelo)
-- {
-- $wdb->set_prop('badhelo', "$BadHelo", 'Black');
-- }
--
-- # qmail badmailfrom
-- my %list_badmailfrom = $wdb->get('badmailfrom')->props;
-- my $parameter_badmailfrom = "";
-- my $value_badmailfrom = "";
-- while (($parameter_badmailfrom,$value_badmailfrom) = each(%list_badmailfrom)) {
-- if ($parameter_badmailfrom eq "type") {next;}
--
-- if ($value_badmailfrom eq "Black") {
-- $wdb->get_prop_and_delete('badmailfrom', "$parameter_badmailfrom");
-- }
-- }
--
-- my $BadMailFrom = $q->param("badmailfrom");
-- $BadMailFrom =~ s/\r\n/,/g;
-- my @BadMailFrom = sort(split /,/, $BadMailFrom);
-- foreach $BadMailFrom (@BadMailFrom){
-- $wdb->set_prop('badmailfrom', "$BadMailFrom", 'Black');
-- }
-- # spamassassin blacklist_from
-- my %list_wblglobal = $sdb->get('wbl.global')->props;
-- my $parameter_wblglobal = "";
-- my $value_wblglobal = "";
-- while (($parameter_wblglobal,$value_wblglobal) = each(%list_wblglobal)) {
-- if ($parameter_wblglobal eq "type") {next;}
--
-- if ($value_wblglobal eq "Black") {
-- $sdb->get_prop_and_delete('wbl.global', "$parameter_wblglobal");
-- }
-- }
--
-- my $BlacklistFrom = $q->param("blacklistfrom");
-- $BlacklistFrom =~ s/\r\n/,/g;
-- my @BlacklistFrom = sort(split /,/, $BlacklistFrom);
-- foreach $BlacklistFrom (@BlacklistFrom){
-- $sdb->set_prop('wbl.global', "$BlacklistFrom", 'Black');
-- }
--
-- ##Update email settings
-- unless ( system ("/sbin/e-smith/signal-event", "smeserver-wbl-update") == 0 ){
-- $fm->error('ERROR_UPDATING');
-- return undef;
-- }
--
-- $fm->success('SUCCESS');
--}
--
--sub create_modify_white
--{
-- my $fm = shift;
-- my $q = $fm->{'cgi'};
--
-- # qpsmtpd whitelisthosts
-- my %list = $wdb->get('whitelisthosts')->props;
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "White") {
-- $wdb->get_prop_and_delete('whitelisthosts', "$parameter");
-- }
-- }
--
-- my $WhitelistHosts = $q->param("whitelisthosts");
-- $WhitelistHosts =~ s/\r\n/,/g;
-- my @WhitelistHosts = sort(split /,/, $WhitelistHosts);
-- foreach $WhitelistHosts (@WhitelistHosts)
-- {
-- $wdb->set_prop('whitelisthosts', "$WhitelistHosts", 'White');
-- }
--
-- # qpsmtpd whitelisthelo
-- my %list_whitelisthelo = $wdb->get('whitelisthelo')->props;
-- my $parameter_whitelisthelo = "";
-- my $value_whitelisthelo = "";
-- while (($parameter_whitelisthelo,$value_whitelisthelo) = each(%list_whitelisthelo)) {
-- if ($parameter_whitelisthelo eq "type") {next;}
--
-- if ($value_whitelisthelo eq "White") {
-- $wdb->get_prop_and_delete('whitelisthelo', "$parameter_whitelisthelo");
-- }
-- }
--
-- my $WhitelistHelo = $q->param("whitelisthelo");
-- $WhitelistHelo =~ s/\r\n/,/g;
-- my @WhitelistHelo = sort(split /,/, $WhitelistHelo);
-- foreach $WhitelistHelo (@WhitelistHelo)
-- {
-- $wdb->set_prop('whitelisthelo', "$WhitelistHelo", 'White');
-- }
--
-- # qpsmtpd whitelistsenders
-- my %list_whitelistsenders = $wdb->get('whitelistsenders')->props;
-- my $parameter_whitelistsenders = "";
-- my $value_whitelistsenders = "";
-- while (($parameter_whitelistsenders,$value_whitelistsenders) = each(%list_whitelistsenders)) {
-- if ($parameter_whitelistsenders eq "type") {next;}
--
-- if ($value_whitelistsenders eq "White") {
-- $wdb->get_prop_and_delete('whitelistsenders', "$parameter_whitelistsenders");
-- }
-- }
--
-- my $WhitelistSenders = $q->param("whitelistsenders");
-- $WhitelistSenders =~ s/\r\n/,/g;
-- my @WhitelistSenders = sort(split /,/, $WhitelistSenders);
-- foreach $WhitelistSenders (@WhitelistSenders)
-- {
-- $wdb->set_prop('whitelistsenders', "$WhitelistSenders", 'White');
-- }
--
-- # spamassassin whitelist_from
-- my %list_wblglobal = $sdb->get('wbl.global')->props;
-- my $parameter_wblglobal = "";
-- my $value_wblglobal = "";
-- while (($parameter_wblglobal,$value_wblglobal) = each(%list_wblglobal)) {
-- if ($parameter_wblglobal eq "type") {next;}
--
-- if ($value_wblglobal eq "White") {
-- $sdb->get_prop_and_delete('wbl.global', "$parameter_wblglobal");
-- }
-- }
--
-- my $WhitelistFrom = $q->param("whitelistfrom");
-- $WhitelistFrom =~ s/\r\n/,/g;
-- my @WhitelistFrom = sort(split /,/, $WhitelistFrom);
-- foreach $WhitelistFrom (@WhitelistFrom){
-- $sdb->set_prop('wbl.global', "$WhitelistFrom", 'White');
-- }
--
-- ##Update email settings
-- unless ( system ("/sbin/e-smith/signal-event", "smeserver-wbl-update") == 0 ){
-- $fm->error('ERROR_UPDATING');
-- return undef;
-- }
--
-- $fm->success('SUCCESS');
--}
--
--sub email_update
--{
-- my $fm = shift;
-- my $q = $fm->{'cgi'};
--
-- unless ( system ("/sbin/e-smith/signal-event", "smeserver-wbl-update") == 0 )
-- {
-- $fm->error('ERROR_UPDATING');
-- return undef;
-- }
--
-- $fm->success('SUCCESS');
--
--}
--
--sub get_blacklistfrom
--{
-- my %list = $sdb->get('wbl.global')->props;
--
-- my @blacklistfrom = ();
-- my $parameter = "";
-- my $value = "";
-- while (($parameter,$value) = each(%list)) {
-- if ($parameter eq "type") {next;}
--
-- if ($value eq "Black") {
-- push @blacklistfrom, $parameter;
-- }
-- }
--
-- return "" unless (scalar @blacklistfrom);
--
-- return join "\n", sort(@blacklistfrom);
--}
--sub create_modify_rbl
--{
-- my $fm = shift;
-- my $q = $fm->{'cgi'};
--
-- my $dnsbl = $q->param('dnsbl');
-- $db->set_prop('qpsmtpd', 'DNSBL', "$dnsbl");
--
-- my $rhsbl = $q->param('rhsbl');
-- $db->set_prop('qpsmtpd', 'RHSBL', "$rhsbl");
--
--
-- my $sbllistcgi = $q->param('sbllist');
-- my @sbllistcgi = split /\s{2,}/, $sbllistcgi;
-- my $sbllistdb = '';
-- foreach (@sbllistcgi) { $sbllistdb = $sbllistdb . ',' . $_; }
-- $sbllistdb =~ s/^,//;
--
-- $db->set_prop('qpsmtpd', 'SBLList', "$sbllistdb");
--
--
-- my $rbllistcgi = $q->param('rbllist');
-- my @rbllistcgi = split /\s{2,}/, $rbllistcgi;
-- my $rbllistdb = '';
-- foreach (@rbllistcgi) { $rbllistdb = $rbllistdb . ',' . $_; }
-- $rbllistdb =~ s/^,//;
--
-- $db->set_prop('qpsmtpd', 'RBLList', "$rbllistdb");
--
-- ##Update email settings
--
-- unless ( system ("/sbin/e-smith/signal-event", "smeserver-wbl-update") == 0 ){
-- $fm->error('ERROR_UPDATING');
-- return undef;
-- }
--
-- $fm->success('SUCCESS');
--}
--
--#Subroutine to display buttons
--#sub print_custom_button{
--# my ($fm,$desc,$url) = @_;
--# my $q = $fm->{cgi};
--# $url="wbl?page=0&page_stack=&Next=Next&wherenext=".$url;
--# print " \n \n";
--# print $q->p($q->a({href => $url, -class => "button-like"},$fm->localise($desc)));
--# print qq( \n);
--# return undef;
--#}
--#;
