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-14 16:50:23.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(
-
-
-
- );
- }
-
- 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(
- " "
- ),
- esmith::cgi::genSmallCell($q, $groupname,"normal"),
- esmith::cgi::genSmallCell( $q, $accountdb->get($groupname)->prop("Description"),"normal")
- );
- }
-
- print " \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-14 16:50:23.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;
-#}
-#;