/[smeserver]/rpms/smeserver-manager/sme10/smeserver-manager-0.1.0-remove_tests.patch
ViewVC logotype

Annotation of /rpms/smeserver-manager/sme10/smeserver-manager-0.1.0-remove_tests.patch

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Tue Apr 14 13:28:09 2020 UTC (4 years, 2 months ago) by michel
Branch: MAIN
CVS Tags: smeserver-manager-0_1_0-28_el7_sme, smeserver-manager-0_1_0-25_el7_sme, smeserver-manager-0_1_0-29_el7_sme, smeserver-manager-0_1_0-26_el7_sme, smeserver-manager-0_1_0-30_el7_sme, smeserver-manager-0_1_0-20_el7_sme, smeserver-manager-0_1_0-27_el7_sme, smeserver-manager-0_1_0-24_el7_sme, smeserver-manager-0_1_0-21_el7_sme, smeserver-manager-0_1_0-31_el7_sme, smeserver-manager-0_1_2-1_el7_sme, smeserver-manager-0_1_0-23_el7_sme, smeserver-manager-0_1_0-22_el7_sme, smeserver-manager-0_1_0-19_el7_sme
make: « clog » est à jour.

1 michel 1.1 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
2     --- smeserver-manager-0.1.0.old/root/usr/share/perl5/vendor_perl/smeserver/Panel/useraccountsNew.pm 2020-04-14 16:50:23.000000000 +0400
3     +++ smeserver-manager-0.1.0/root/usr/share/perl5/vendor_perl/smeserver/Panel/useraccountsNew.pm 1970-01-01 04:00:00.000000000 +0400
4     @@ -1,1310 +0,0 @@
5     -#!/usr/bin/perl -w
6     -
7     -#----------------------------------------------------------------------
8     -# $Id: smeserver-manager-add-basic-files.patch,v 1.1 2019/12/15 22:14:17 jcrisp Exp $
9     -#----------------------------------------------------------------------
10     -# copyright (C) 1999-2006 Mitel Networks Corporation
11     -#
12     -# This program is free software; you can redistribute it and/or modify
13     -# it under the terms of the GNU General Public License as published by
14     -# the Free Software Foundation; either version 2 of the License, or
15     -# (at your option) any later version.
16     -#
17     -# This program is distributed in the hope that it will be useful,
18     -# but WITHOUT ANY WARRANTY; without even the implied warranty of
19     -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20     -# GNU General Public License for more details.
21     -#
22     -# You should have received a copy of the GNU General Public License
23     -# along with this program; if not, write to the Free Software
24     -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25     -#----------------------------------------------------------------------
26     -package smeserver::Panel::useraccountsNew;
27     -
28     -use strict;
29     -
30     -# Get shot of FormMagick and cgi
31     -
32     -
33     -use esmith::AccountsDB;
34     -use esmith::ConfigDB;
35     -#use esmith::FormMagick;
36     -#use esmith::cgi;
37     -use esmith::util;
38     -use File::Basename;
39     -use Exporter;
40     -use Carp qw(verbose);
41     -
42     -# This will have to go - where do we need it ?
43     -our @ISA = qw( Exporter);
44     -
45     -# Anything with print is a non starter and should be renamed
46     -our @EXPORT = qw(
47     - get_user_accounts
48     - print_user_table
49     - print_acctName_field
50     - print_groupMemberships_field
51     - print_page_description
52     - get_ldap_value
53     - username_clash
54     - pseudonym_clash
55     - handle_user_accounts
56     - modify_admin
57     - emailforward
58     - verifyPasswords
59     - lock_account
60     - remove_account
61     - reset_password
62     - check_password
63     - print_save_or_add_button
64     - get_pptp_value
65     - print_ipsec_client_section
66     - get_prop
67     -
68     - system_password_compare
69     - system_valid_password
70     - system_change_password
71     - system_check_password
72     - system_authenticate_password
73     -);
74     -
75     -our $VERSION = sprintf '%d.%03d', q$Revision: 1.1 $ =~ /: (\d+).(\d+)/;
76     -
77     -our $accountdb = esmith::AccountsDB->open();
78     -our $configdb = esmith::ConfigDB->open();
79     -
80     -=pod
81     -
82     -=head1 NAME
83     -
84     -esmith::FormMagick::Panels::useraccounts - useful panel functions
85     -
86     -=head1 SYNOPSIS
87     -
88     -use esmith::FormMagick::Panels::useraccount;
89     -
90     -my $panel = esmith::FormMagick::Panel::useraccount->new();
91     -$panel->display();
92     -
93     -=head1 DESCRIPTION
94     -
95     -
96     -=head2 new();
97     -
98     -Exactly as for esmith::FormMagick
99     -
100     -=begin testing
101     -
102     -$ENV{ESMITH_ACCOUNT_DB} = "10e-smith-base/accounts.conf";
103     -$ENV{ESMITH_CONFIG_DB} = "10e-smith-base/configuration.conf";
104     -
105     -open DATA, "echo '<form></form>'|";
106     -use_ok('esmith::FormMagick::Panel::useraccounts');
107     -use vars qw($panel);
108     -ok($panel = esmith::FormMagick::Panel::useraccounts->new(),
109     -"Create panel object");
110     -close DATA;
111     -isa_ok($panel, 'esmith::FormMagick::Panel::useraccounts');
112     -$panel->{cgi} = CGI->new();
113     -$panel->parse_xml();
114     -
115     -{ package esmith::FormMagick::Panel::useraccounts;
116     -our $accountdb;
117     -::isa_ok($accountdb, 'esmith::AccountsDB');
118     -}
119     -
120     -=end testing
121     -
122     -=cut
123     -
124     -# Errrr ? No FormMagick now.
125     -sub new {
126     - shift;
127     - my $self = esmith::FormMagick->new();
128     - $self->{calling_package} = (caller)[0];
129     - bless $self;
130     - return $self;
131     -}
132     -
133     -=head1 HTML GENERATION ROUTINES
134     -
135     -Routines for generating chunks of HTML needed by the panel.
136     -
137     -=head2 print_user_table
138     -
139     -Prints out the user table on the front page.
140     -
141     -=for testing
142     -$panel->print_user_table;
143     -like($_STDOUT_, qr/bart/, "Found usernames in user table output");
144     -like($_STDOUT_, qr/ff0000/, "Found red 'reset password' output");
145     -
146     -=cut
147     -
148     -# The whole print_user_table routine can go - we just need get_users here
149     -
150     -sub get_user_accounts {
151     - #my $self = shift;
152     - #my $q = $self->{cgi};
153     - #my $account = $self->localise('ACCOUNT');
154     - #my $acctName = $self->localise('USER_NAME');
155     - #
156     - #my $modify = $self->localise('MODIFY');
157     - #my $resetpw = $self->localise('PASSWORD_RESET');
158     - #my $lock = $self->localise('LOCK_ACCOUNT');
159     - #my $account_locked = $self->localise('ACCOUNT_LOCKED');
160     - #my $remove = $self->localise('REMOVE');
161     -
162     - my @users = $accountdb->get('admin');
163     - push @users, $accountdb->users();
164     -
165     - unless ( scalar @users )
166     - {
167     - return "No user accounts available";
168     - }
169     - return @users;
170     -}
171     -
172     -# Not required
173     -
174     -sub print_user_table {
175     - my $self = shift;
176     - my $q = $self->{cgi};
177     - my $account = $self->localise('ACCOUNT');
178     - my $acctName = $self->localise('USER_NAME');
179     -
180     - my $modify = $self->localise('MODIFY');
181     - my $resetpw = $self->localise('PASSWORD_RESET');
182     - my $lock = $self->localise('LOCK_ACCOUNT');
183     - my $account_locked = $self->localise('ACCOUNT_LOCKED');
184     - my $remove = $self->localise('REMOVE');
185     -
186     - my @users = $accountdb->get('admin');
187     - push @users, $accountdb->users();
188     -
189     - unless ( scalar @users )
190     - {
191     - print $q->Tr($q->td($self->localise('NO_USER_ACCOUNTS')));
192     - return "";
193     - }
194     - print " <tr>\n <td colspan=\"2\">\n ";
195     - print $q->start_table ({-CLASS => "sme-border"}),"\n ";
196     - print $q->Tr(
197     - esmith::cgi::genSmallCell($q, $self->localise($account),"header"),
198     - esmith::cgi::genSmallCell($q, $self->localise($acctName),"header"),
199     - esmith::cgi::genSmallCell($q, $self->localise('VPN_CLIENT_ACCESS'), "header"),
200     - esmith::cgi::genSmallCell($q, $self->localise('FORWARDING_ADDRESS'), "header"),
201     - esmith::cgi::genSmallCell($q, $self->localise('ACTION'),"header",4));
202     -
203     - my $scriptname = basename($0);
204     - my $index=0;
205     -
206     - foreach my $u (@users) {
207     - my $username = $u->key();
208     - my $first = $u->prop('FirstName');
209     - my $last = $u->prop('LastName');
210     - my $lockable = $u->prop('Lockable') || 'yes';
211     - my $removable = $u->prop('Removable') || 'yes';
212     - my $fwd = (($u->prop('EmailForward') || 'local') =~ m/^forward|both$/) ?
213     - $u->prop('ForwardAddress') : '';
214     - my $vpnaccess = $u->prop('VPNClientAccess') || 'no';
215     - $vpnaccess = $vpnaccess eq 'yes' ? $self->localise('YES') :
216     - $self->localise('NO');
217     -
218     - my $params = $self->build_user_cgi_params($username, $u->props());
219     -
220     - my $password_set = $u->prop('PasswordSet');
221     -
222     - my $pagenum = ($username eq "admin") ? $self->get_page_by_name('SystemPasswordDummy')
223     - : $self->get_page_by_name('ResetPasswordDummy');
224     -
225     - # make normal links
226     - my $lock_url = ($password_set eq 'yes') ?
227     - qq(<a href="$scriptname?$params&Next=Next&wherenext=LockAccount">$lock</a>) :
228     - qq($account_locked);
229     -
230     - $lock_url = "" unless ($lockable eq "yes");
231     -
232     - my $where_next = ($username eq "admin") ? "ModifyAdmin" : "CreateModify";
233     - my $action1 = "<a href=\"$scriptname?page=0&page_stack=&acctName=$username&Next=Next&action=modify&wherenext=$where_next\">$modify</a>";
234     -
235     - my $action2 = "<a href=\"$scriptname?page=$pagenum&page_stack=&Next=Next&acctName=$username\">$resetpw</a>";
236     -
237     - unless ($password_set eq 'yes')
238     - {
239     - $action2 = "<span class='error-noborders'>" . $action2 . "</span>";
240     - }
241     -
242     - my $action3 = ($removable eq "yes") ? "<a href=\"$scriptname?$params&Next=Next&wherenext=RemoveAccount\">$remove</a>" : '';
243     -
244     - print $q->Tr(esmith::cgi::genSmallCell($q, $username,"normal")," ",
245     - esmith::cgi::genSmallCell($q, "$first $last","normal")," ",
246     - esmith::cgi::genSmallCell($q, $vpnaccess),
247     - esmith::cgi::genSmallCell($q, $fwd),
248     - esmith::cgi::genSmallCell($q, "$action1","normal")," ",
249     - esmith::cgi::genSmallCell($q, "$action2","normal")," ",
250     - esmith::cgi::genSmallCell($q, "$lock_url","normal")," ",
251     - esmith::cgi::genSmallCell($q, "$action3","normal"));
252     -
253     - $index++;
254     - }
255     -
256     - print qq(</table></td></tr>\n);
257     -
258     - return "";
259     -}
260     -
261     -=head2 print_acctName_field
262     -
263     -This subroutine is used to generate the Account name field on the form in
264     -the case of "create user", or to make it a plain uneditable string in the case
265     -of "modify user".
266     -
267     -=begin testing
268     -
269     -my $self = esmith::FormMagick::Panel::useraccounts->new();
270     -$self->{cgi} = CGI->new("");
271     -print_acctName_field($self);
272     -like($_STDOUT_, qr/text.*acctName/, "print text field if acctName not set");
273     -like($_STDOUT_, qr/create/, "action=create if acctName not set");
274     -$self->{cgi}->param(-name => 'acctName', -value => 'foo');
275     -$self->{cgi}->param(-name => 'action', -value => 'modify');
276     -print_acctName_field($self);
277     -like($_STDOUT_, qr/hidden.*acctName/, "print hidden field if acctName is set");
278     -like($_STDOUT_, qr/modify/, "action=modify if acctName already set");
279     -
280     -=end testing
281     -
282     -=cut
283     -
284     -sub print_acctName_field {
285     - my $self = shift;
286     - my $cgi = $self->{cgi};
287     - my $an = $cgi->param('acctName') || '';
288     - print qq(<tr><td class=\"sme-noborders-label\">) . $self->localise('ACCOUNT_NAME') . qq(</td>\n);
289     - my $action = $cgi->param('action') || '';
290     - if ( $action eq 'modify') {
291     - print qq(
292     - <td>$an
293     - <input type="hidden" name="acctName" value="$an">
294     - <input type="hidden" name="action" value="modify">
295     - </td>
296     - );
297     - # if there's no CGI data, fill in the fields with the account db
298     - # data for this user
299     - my $rec = $accountdb->get($an);
300     - my $fn = $cgi->param('FirstName') ?
301     - $cgi->param('FirstName') :
302     - ($rec ? ($rec->prop('FirstName')) : '');
303     - my $ln = $cgi->param('LastName') ?
304     - $cgi->param('LastName') :
305     - ($rec ? ($rec->prop('LastName')) : '');
306     - my $dept = $cgi->param('Dept') ?
307     - $cgi->param('Dept') :
308     - ($rec ? ($rec->prop('Dept')) : '');
309     - my $company = $cgi->param('Company') ?
310     - $cgi->param('Company') :
311     - ($rec ? ($rec->prop('Company')) : '');
312     - my $street = $cgi->param('Street') ?
313     - $cgi->param('Street') :
314     - ($rec ? ($rec->prop('Street')) : '');
315     - my $city = $cgi->param('City') ?
316     - $cgi->param('City') :
317     - ($rec ? ($rec->prop('City')) : '');
318     - my $phone = $cgi->param('Phone') ?
319     - $cgi->param('Phone') :
320     - ($rec ? ($rec->prop('Phone')) : '');
321     - my $emf = $cgi->param('EmailForward') ?
322     - $cgi->param('EmailForward') :
323     - ($rec ? ($rec->prop('EmailForward')) : 'local');
324     - my $fwd = $cgi->param('ForwardAddress') ?
325     - $cgi->param('ForwardAddress') :
326     - ($rec ? ($rec->prop('ForwardAddress')) : '');
327     - my $pptp = $cgi->param('VPNClientAccess') ?
328     - $cgi->param('VPNClientAccess') :
329     - ($rec ? ($rec->prop('VPNClientAccess')) : 'no');
330     - # now that we're down with the 411, let's set the values
331     - $cgi->param(-name=>'FirstName', -value=>$fn);
332     - $cgi->param(-name=>'LastName', -value=>$ln);
333     - $cgi->param(-name=>'Dept', -value=>$dept);
334     - $cgi->param(-name=>'Company', -value=>$company);
335     - $cgi->param(-name=>'Street', -value=>$street);
336     - $cgi->param(-name=>'City', -value=>$city);
337     - $cgi->param(-name=>'Phone', -value=>$phone);
338     - $cgi->param(-name=>'EmailForward', -value=>$emf);
339     - $cgi->param(-name=>'ForwardAddress', -value=>$fwd);
340     - $cgi->param(-name=>'VPNClientAccess', -value=>$pptp);
341     - } else {
342     - print qq(
343     - <td><input type="text" name="acctName" value="$an">
344     - <input type="hidden" name="action" value="create">
345     - </td>
346     - );
347     - }
348     -
349     - print qq(</tr>\n);
350     - return undef;
351     -
352     -}
353     -
354     -=head2 print_groupMemberships_field()
355     -
356     -Builds a list of groups for the create/modify user screen.
357     -
358     -=begin testing
359     -
360     -my $self = esmith::FormMagick::Panel::useraccounts->new();
361     -$self->{cgi} = CGI->new("");
362     -$self->print_groupMemberships_field();
363     -like($_STDOUT_, qr/simpsons/, "Found simpsons in group list");
364     -like($_STDOUT_, qr/flanders/, "Found flanders in group list");
365     -$self->{cgi}->param(-name => 'acctName', -value => 'rod');
366     -$self->print_groupMemberships_field();
367     -like($_STDOUT_, qr/checked value="flanders"/, "Checked flanders group for user rod");
368     -
369     -=end testing
370     -
371     -=cut
372     -
373     -sub print_groupMemberships_field {
374     - my ($self) = @_;
375     - my $q = $self->{cgi};
376     - my $user = $q->param('acctName');
377     -
378     - if (my @groups = $accountdb->groups()) {
379     -
380     - print "<tr><td class=\"sme-noborders-label\">",
381     - $self->localise('GROUP_MEMBERSHIPS'),
382     - "</td><td>\n";
383     -
384     - print $q->start_table({-class => "sme-border"}),"\n";
385     - print $q->Tr(
386     - esmith::cgi::genSmallCell($q, $self->localise('MEMBER'),"header"),
387     - esmith::cgi::genSmallCell($q, $self->localise('GROUP'),"header"),
388     - esmith::cgi::genSmallCell($q, $self->localise('DESCRIPTION'),"header")
389     - );
390     -
391     - foreach my $g (@groups) {
392     - my $groupname = $g->key();
393     - my $checked;
394     - if ($user and $accountdb->is_user_in_group($user, $groupname)) {
395     - $checked = 'checked';
396     - } else {
397     - $checked = '';
398     - }
399     -
400     - print $q->Tr(
401     - $q->td(
402     - "<input type=\"checkbox\""
403     - . " name=\"groupMemberships\""
404     - . " $checked value=\"$groupname\">"
405     - ),
406     - esmith::cgi::genSmallCell($q, $groupname,"normal"),
407     - esmith::cgi::genSmallCell( $q, $accountdb->get($groupname)->prop("Description"),"normal")
408     - );
409     - }
410     -
411     - print "</table></td></tr>\n";
412     -
413     - }
414     -
415     - return undef;
416     -
417     -}
418     -
419     -=head2 print_page_description($self, "reset|lock|remove")
420     -
421     -Generates the page description for the the somewhat similar Reset
422     -Password, Lock Account and Remove Account pages.
423     -
424     -=begin testing
425     -
426     -my $self = esmith::FormMagick::Panel::useraccounts->new();
427     -$self->{cgi} = CGI->new({ acctName => 'bart' });
428     -print_page_description($self, "reset");
429     -like($_STDOUT_, qr/bart/, "print_page_description prints username");
430     -like($_STDOUT_, qr/Bart Simpson/, "print_page_description prints name");
431     -like($_STDOUT_, qr/RESET_DESC/, "print_page_description prints description");
432     -
433     -=end testing
434     -
435     -=cut
436     -
437     -sub print_page_description {
438     - my ($self, $pagename) = @_;
439     - unless (grep /^$pagename$/, qw(reset lock remove)) {
440     - warn "Can't generate page description for invalid pagename $pagename\n";
441     - return;
442     - }
443     -
444     - $pagename = uc($pagename);
445     -
446     - my $desc = $self->localise("${pagename}_DESC");
447     - my $desc2 = $self->localise("${pagename}_DESC2");
448     -
449     - my $acctName = $self->{cgi}->param('acctName');
450     - my $name = $accountdb->get($acctName)->prop('FirstName') . " "
451     - . $accountdb->get($acctName)->prop('LastName');
452     -
453     - print qq{
454     - <tr><td colspan="2">
455     - <p>$desc "$acctName" ($name)</p>
456     - $desc2
457     - <input type="hidden" name="acctName" value="$acctName">
458     - </td></tr>
459     - };
460     -
461     - return;
462     -}
463     -
464     -=head1 ROUTINES FOR FILLING IN FIELD DEFAULT VALUES
465     -
466     -=head2 get_ldap_value($field)
467     -
468     -This subroutine generates the default field value on the form using the
469     -parameter specified.
470     -
471     -In this case, the default field values come from LDAP/directory
472     -settings.
473     -
474     -If a CGI parameter has been passed that contains an account name, we
475     -assume that a value has already been set, as we're modifying a user, and
476     -use that value instead of a default.
477     -
478     -=for testing
479     -my $self = esmith::FormMagick::Panel::useraccounts->new();
480     -$self->{cgi} = CGI->new("");
481     -is(get_ldap_value($self, "Dept"), "Main", "Pick up default value from LDAP");
482     -$self->{cgi} = CGI->new({ acctName => 'bart' });
483     -is(get_ldap_value($self, "Dept"), undef, "Don't pick up LDAP data if username provided");
484     -
485     -=cut
486     -
487     -sub get_ldap_value {
488     - my ($self, $field) = @_;
489     -
490     - # don't do the lookup if this is a modification of an existing user
491     - if ($self->{cgi}->param('acctName')) {
492     - return $self->{cgi}->param($field);
493     - }
494     -
495     - my %CGIParam2DBfield = (
496     - Dept => 'defaultDepartment',
497     - Company => 'defaultCompany',
498     - Street => 'defaultStreet',
499     - City => 'defaultCity',
500     - Phone => 'defaultPhoneNumber'
501     - );
502     -
503     - return $configdb->get('ldap')->prop($CGIParam2DBfield{$field});
504     -}
505     -
506     -sub get_pptp_value
507     -{
508     - return $configdb->get('pptpd')->prop('AccessDefault') || 'no';
509     -}
510     -
511     -=head1 VALIDATION ROUTINES
512     -
513     -=head2 pseudonym_clash
514     -
515     -Validation routine to check whether a the first/last names clash with
516     -existing pseudonyms.
517     -
518     -Note that it won't be considered a "clash" if there is an existing
519     -pseudonym which belongs to the same user -- it's only a clash if the
520     -generated pseudonyms are the same but the usernames aren't.
521     -
522     -=begin testing
523     -
524     -my $self = esmith::FormMagick::Panel::useraccounts->new();
525     -
526     -$self->{cgi} = CGI->new({
527     - acctName => 'skud',
528     - FirstName => 'Kirrily',
529     - LastName => 'Robert'
530     -});
531     -
532     -is (pseudonym_clash($self, 'Kirrily'), "OK", "New name doesn't clash pseudonyms");
533     -
534     -$self->{cgi} = CGI->new({
535     - acctName => 'bart2',
536     - FirstName => 'Bart',
537     - LastName => 'Simpson'
538     -});
539     -
540     -isnt(pseudonym_clash($self, 'Bart'), "OK", "Existing pseudonym with non-matching username causes clash");
541     -
542     -$self->{cgi} = CGI->new({
543     - acctName => 'bart',
544     - FirstName => 'Bart',
545     - LastName => 'Simpson'
546     -});
547     -
548     -is(pseudonym_clash($self, 'Bart'), "OK", "Existing pseudonym with matching username shouldn't clash");
549     -
550     -=end testing
551     -
552     -=cut
553     -
554     -sub pseudonym_clash {
555     - my ($self, $first) = @_;
556     - $first ||= "";
557     - my $last = $self->{cgi}->param('LastName') || "";
558     - my $acctName = $self->{cgi}->param('acctName') || "";
559     -
560     - my $up = "$first $last";
561     -
562     - $up =~ s/^\s+//;
563     - $up =~ s/\s+$//;
564     - $up =~ s/\s+/ /g;
565     - $up =~ s/\s/_/g;
566     -
567     - my $dp = $up;
568     - $dp =~ s/_/./g;
569     -
570     - $dp = $accountdb->get($dp);
571     - $up = $accountdb->get($up);
572     -
573     - my $da = $dp->prop('Account') if $dp;
574     - my $ua = $up->prop('Account') if $up;
575     - if ($dp and $da and $da ne $acctName)
576     - {
577     - return $self->localise('PSEUDONYM_CLASH',
578     - {
579     - acctName => $acctName,
580     - clashName => $da,
581     - pseudonym => $dp->key
582     - });
583     - }
584     - elsif ($up and $ua and $ua ne $acctName)
585     - {
586     - return $self->localise('PSEUDONYM_CLASH',
587     - {
588     - acctName => $acctName,
589     - clashName => $ua,
590     - pseudonym => $up->key
591     - });
592     - }
593     - else
594     - {
595     - return "OK";
596     - }
597     -}
598     -
599     -=head2 emailforward()
600     -
601     -Validation routine for email forwarding
602     -
603     -=cut
604     -
605     -sub emailforward {
606     - my ($self, $data) = @_;
607     - my $response = $self->email_simple($data);
608     - if ($response eq "OK")
609     - {
610     - return "OK";
611     - }
612     - elsif ($data eq "")
613     - {
614     - # Blank is ok, only if we're not forwarding, which means that the
615     - # EmailForward param must be set to 'local'.
616     - my $email_forward = $self->{cgi}->param('EmailForward') || '';
617     - $email_forward =~ s/^\s+|\s+$//g;
618     - return 'OK' if $email_forward eq 'local';
619     - return $self->localise('CANNOT_CONTAIN_WHITESPACE');
620     - }
621     - else
622     - {
623     - return $self->localise('CANNOT_CONTAIN_WHITESPACE')
624     - if ( $data =~ /\s+/ );
625     - # Permit a local address.
626     - return "OK" if $data =~ /^[a-zA-Z][a-zA-Z0-9\._\-]*$/;
627     - return $self->localise('UNACCEPTABLE_CHARS');
628     - }
629     -}
630     -
631     -=head2 verifyPasswords()
632     -
633     -Returns an error message if the two new passwords input don't match.
634     -
635     -=cut
636     -
637     -sub verifyPasswords {
638     - my $self = shift;
639     - my $pass2 = shift;
640     -
641     - my $pass1 = $self->{cgi}->param('password1');
642     - unless ($pass1 eq $pass2) {
643     - $self->{cgi}->param( -name => 'wherenext', -value => 'Password' );
644     - return "PASSWORD_VERIFY_ERROR";
645     - }
646     - return "OK";
647     -}
648     -
649     -=head1 CREATING AND MODIFYING USERS
650     -
651     -=head2 handle_user_accounts()
652     -
653     -This is the routine called by the "Save" button on the create/modify page.
654     -It checks the "action" param and calls either create_user() or modify_user()
655     -as appropriate.
656     -
657     -=cut
658     -
659     -sub handle_user_accounts {
660     - my ($self) = @_;
661     -
662     - my $cgi = $self->{cgi};
663     -
664     - if ($cgi->param("action") eq "create") {
665     - my $msg = create_user($self);
666     - if ($msg eq 'USER_CREATED')
667     - {
668     - $self->success($msg);
669     - }
670     - else
671     - {
672     - $self->error($msg);
673     - }
674     - }
675     - else {
676     - modify_user($self);
677     - $self->success('USER_MODIFIED');
678     - }
679     -}
680     -
681     -=head2 print_save_or_add_button()
682     -
683     -=cut
684     -
685     -sub print_save_or_add_button {
686     -
687     - my ($self) = @_;
688     -
689     - my $cgi = $self->{cgi};
690     -
691     - if (($cgi->param("action") || '') eq "modify") {
692     - $self->print_button("SAVE");
693     - } else {
694     - $self->print_button("ADD");
695     - }
696     -
697     -}
698     -
699     -=head2 modify_admin($self)
700     -
701     -=cut
702     -
703     -sub modify_admin
704     -{
705     - my ($self) = @_;
706     -
707     - my $acct = $accountdb->get('admin');
708     -
709     - my %newProperties = (
710     - 'FirstName' => $self->{cgi}->param('FirstName'),
711     - 'LastName' => $self->{cgi}->param('LastName'),
712     - 'EmailForward' => $self->{cgi}->param('EmailForward'),
713     - 'ForwardAddress' => $self->{cgi}->param('ForwardAddress'),
714     - 'VPNClientAccess'=> $self->{cgi}->param('VPNClientAccess'),
715     - );
716     -
717     - $acct->merge_props(%newProperties);
718     -
719     - undef $accountdb;
720     -
721     - my $status =
722     - system ("/sbin/e-smith/signal-event", "user-modify-admin", 'admin');
723     -
724     - $accountdb = esmith::AccountsDB->open();
725     -
726     - if ($status == 0)
727     - {
728     - $self->success('USER_MODIFIED', 'First');
729     - }
730     - else
731     - {
732     - $self->error('CANNOT_MODIFY_USER', 'First');
733     - }
734     - return;
735     -}
736     -
737     -=head2 modify_user($self)
738     -
739     -=cut
740     -
741     -sub modify_user {
742     - my ($self) = @_;
743     - my $acctName = $self->{cgi}->param('acctName');
744     -
745     - unless (($acctName) = ($acctName =~ /^(\w[\-\w_\.]*)$/)) {
746     - return $self->error($self->localise('TAINTED_USER',
747     - { acctName => $acctName }));
748     - }
749     - # Untaint the username before use in system()
750     - $acctName = $1;
751     -
752     - my $acct = $accountdb->get($acctName);
753     - my $acctType = $acct->prop('type');
754     -
755     - if ($acctType eq "user")
756     - {
757     - $accountdb->remove_user_auto_pseudonyms($acctName);
758     - my %newProperties = (
759     - 'FirstName' => $self->{cgi}->param('FirstName'),
760     - 'LastName' => $self->{cgi}->param('LastName'),
761     - 'Phone' => $self->{cgi}->param('Phone'),
762     - 'Company' => $self->{cgi}->param('Company'),
763     - 'Dept' => $self->{cgi}->param('Dept'),
764     - 'City' => $self->{cgi}->param('City'),
765     - 'Street' => $self->{cgi}->param('Street'),
766     - 'EmailForward' => $self->{cgi}->param('EmailForward'),
767     - 'ForwardAddress' => $self->{cgi}->param('ForwardAddress'),
768     - 'VPNClientAccess'=> $self->{cgi}->param('VPNClientAccess'),
769     - );
770     -
771     - $acct->merge_props(%newProperties);
772     -
773     - $accountdb->create_user_auto_pseudonyms($acctName);
774     -
775     - my @old_groups = $accountdb->user_group_list($acctName);
776     - my @new_groups = $self->{cgi}->param("groupMemberships");
777     - $accountdb->remove_user_from_groups($acctName, @old_groups);
778     - $accountdb->add_user_to_groups($acctName, @new_groups);
779     -
780     - undef $accountdb;
781     -
782     - unless (system ("/sbin/e-smith/signal-event", "user-modify",
783     - $acctName) == 0) {
784     - $accountdb = esmith::AccountsDB->open();
785     - return $self->error('CANNOT_MODIFY_USER');
786     - }
787     - $accountdb = esmith::AccountsDB->open();
788     - }
789     - $self->success('USER_MODIFIED');
790     -}
791     -
792     -=head2 create_user
793     -
794     -Adds a user to the accounts db.
795     -
796     -=cut
797     -
798     -sub create_user {
799     - my $self = shift;
800     - my $q = $self->{cgi};
801     -
802     - my $acctName = $q->param('acctName');
803     -
804     - my $msg = $self->validate_acctName($acctName);
805     - unless ($msg eq "OK")
806     - {
807     - return $msg;
808     - }
809     -
810     - $msg = $self->validate_acctName_length($acctName);
811     - unless ($msg eq "OK")
812     - {
813     - return $msg;
814     - }
815     -
816     - $msg = $self->validate_acctName_conflict($acctName);
817     - unless ($msg eq "OK")
818     - {
819     - return $msg;
820     - }
821     -
822     - my %userprops;
823     - foreach my $field ( qw( FirstName LastName Phone Company Dept
824     - City Street EmailForward ForwardAddress VPNClientAccess) )
825     - {
826     - $userprops{$field} = $q->param($field);
827     - }
828     - $userprops{'PasswordSet'} = "no";
829     - $userprops{'type'} = 'user';
830     -
831     - my $acct = $accountdb->new_record($acctName)
832     - or warn "Can't create new account for $acctName (does it already exist?)\n";
833     - $acct->reset_props(%userprops);
834     - $accountdb->create_user_auto_pseudonyms($acctName);
835     - my @groups = $self->{cgi}->param("groupMemberships");
836     - $accountdb->add_user_to_groups($acctName, @groups);
837     -
838     - undef $accountdb;
839     -
840     - # Untaint the username before use in system()
841     - $acctName =~ /^(\w[\-\w_\.]*)$/;
842     - $acctName = $1;
843     -
844     - if (system ("/sbin/e-smith/signal-event", "user-create", $acctName))
845     - {
846     - $accountdb = esmith::AccountsDB->open();
847     - return $self->localise("ERR_OCCURRED_CREATING");
848     - }
849     -
850     - $accountdb = esmith::AccountsDB->open();
851     -
852     - $self->set_groups();
853     - return 'USER_CREATED';
854     -}
855     -
856     -=head2 set_groups
857     -
858     -Sets a user's groups in the accounts db. This is called as part of the
859     -create_user() routine.
860     -
861     -=cut
862     -
863     -sub set_groups
864     -{
865     - my $self = shift;
866     - my $q = $self->{cgi};
867     - my $acctName = $q->param('acctName');
868     -
869     - my @groups = $q->param('groupMemberships');
870     - $accountdb->set_user_groups($acctName, @groups);
871     -
872     -}
873     -
874     -=head1 REMOVING ACCOUNTS
875     -
876     -=head2 remove_account()
877     -
878     -=cut
879     -
880     -sub remove_account {
881     - my ($self) = @_;
882     - my $acctName = $self->{cgi}->param('acctName');
883     -
884     - my $acct = $accountdb->get($acctName);
885     - if ($acct->prop('type') eq "user") {
886     - $acct->set_prop('type', "user-deleted");
887     -
888     - undef $accountdb;
889     -
890     - # Untaint the username before use in system()
891     - $acctName =~ /^(\w[\-\w_\.]*)$/;
892     - $acctName = $1;
893     - if (system ("/sbin/e-smith/signal-event", "user-delete", $acctName))
894     - {
895     - $accountdb = esmith::AccountsDB->open();
896     - return $self->error("ERR_OCCURRED_DELETING");
897     - }
898     -
899     - $accountdb = esmith::AccountsDB->open();
900     - $accountdb->get($acctName)->delete;
901     -
902     - } else {
903     - # FIXME - this should be handled by input validation
904     - # XXX error message here
905     - }
906     - $self->{cgi}->param(-name => 'wherenext', -value => 'First');
907     -}
908     -
909     -=head1 RESETTING THE PASSWORD
910     -
911     -=head2 reset_password()
912     -
913     -=cut
914     -
915     -sub reset_password {
916     - my ($self) = @_;
917     - my $acctName = $self->{cgi}->param('acctName');
918     -
919     - unless (($acctName) = ($acctName =~ /^(\w[\-\w_\.]*)$/)) {
920     - return $self->error('TAINTED_USER');
921     - }
922     - $acctName = $1;
923     -
924     - my $acct = $accountdb->get($acctName);
925     -
926     - if ( $acct->prop('type') eq "user")
927     - {
928     - esmith::util::setUserPassword ($acctName,
929     - $self->{cgi}->param('password1'));
930     -
931     - $acct->set_prop("PasswordSet", "yes");
932     - undef $accountdb;
933     -
934     - if (system("/sbin/e-smith/signal-event", "password-modify", $acctName))
935     - {
936     - $accountdb = esmith::AccountsDB->open();
937     - $self->error("ERR_OCCURRED_MODIFYING_PASSWORD");
938     - }
939     - $accountdb = esmith::AccountsDB->open();
940     -
941     - $self->success($self->localise('PASSWORD_CHANGE_SUCCEEDED',
942     - { acctName => $acctName}));
943     - }
944     - else
945     - {
946     - $self->error($self->localise('NO_SUCH_USER',
947     - { acctName => $acctName}));
948     - }
949     -}
950     -
951     -=head1 LOCKING AN ACCOUNT
952     -
953     -=head2 lock_account()
954     -
955     -=cut
956     -
957     -sub lock_account {
958     - my ($self) = @_;
959     - my $acctName = $self->{cgi}->param('acctName');
960     - my $acct = $accountdb->get($acctName);
961     - if ($acct->prop('type') eq "user")
962     - {
963     - undef $accountdb;
964     -
965     - # Untaint the username before use in system()
966     - $acctName =~ /^(\w[\-\w_\.]*)$/;
967     - $acctName = $1;
968     - if (system("/sbin/e-smith/signal-event", "user-lock", $acctName))
969     - {
970     - $accountdb = esmith::AccountsDB->open();
971     - return $self->error("ERR_OCCURRED_LOCKING");
972     - }
973     -
974     - $accountdb = esmith::AccountsDB->open();
975     -
976     - $self->success($self->localise('LOCKED_ACCOUNT',
977     - { acctName => $acctName}));
978     - }
979     - else
980     - {
981     - $self->error($self->localise('NO_SUCH_USER',
982     - { acctName => $acctName}));
983     - }
984     -}
985     -
986     -
987     -=head1 MISCELLANEOUS ROUTINES
988     -
989     -=head2 build_user_cgi_params()
990     -
991     -Builds a CGI query string based on user data, using various sensible
992     -defaults and esmith::FormMagick's props_to_query_string() method.
993     -
994     -=cut
995     -
996     -sub build_user_cgi_params {
997     - my ($self, $acctName, %oldprops) = @_;
998     -
999     - my %props = (
1000     - page => 0,
1001     - page_stack => "",
1002     - ".id" => $self->{cgi}->param('.id') || "",
1003     - acctName => $acctName,
1004     - #%oldprops
1005     - );
1006     -
1007     - return $self->props_to_query_string(\%props);
1008     -}
1009     -
1010     -=pod
1011     -
1012     -=head2 validate_acctName
1013     -
1014     -Checks that the name supplied does not contain any unacceptable chars.
1015     -Returns OK on success or a localised error message otherwise.
1016     -
1017     -=for testing
1018     -is($panel->validate_acctName('foo'), 'OK', 'validate_acctName');
1019     -isnt($panel->validate_acctName('3amigos'), 'OK', ' .. cannot start with number');
1020     -isnt($panel->validate_acctName('betty ford'), 'OK', ' .. cannot contain space');
1021     -
1022     -=cut
1023     -
1024     -sub validate_acctName
1025     -{
1026     - my ($self, $acctName) = @_;
1027     -
1028     - unless ($accountdb->validate_account_name($acctName))
1029     - {
1030     - return $self->localise('ACCT_NAME_HAS_INVALID_CHARS',
1031     - {acctName => $acctName});
1032     - }
1033     - return "OK";
1034     -}
1035     -
1036     -=head2 validate_account_length FM ACCOUNTNAME
1037     -
1038     -returns 'OK' if the account name is shorter than the maximum account name length
1039     -returns 'ACCOUNT_TOO_LONG' otherwise
1040     -
1041     -=begin testing
1042     -
1043     -ok(($panel->validate_acctName_length('foo') eq 'OK'), "a short account name passes");
1044     -ok(($panel->validate_acctName_length('fooooooooooooooooo') eq 'ACCOUNT_TOO_LONG'), "a long account name fails");
1045     -
1046     -=end testing
1047     -
1048     -=cut
1049     -
1050     -sub validate_acctName_length {
1051     - my $self = shift;
1052     - my $acctName = shift;
1053     -
1054     -
1055     - my $maxAcctNameLength = ($configdb->get('maxAcctNameLength')
1056     - ? $configdb->get('maxAcctNameLength')->prop('type')
1057     - : "") || 12;
1058     -
1059     - if ( length $acctName > $maxAcctNameLength ) {
1060     -
1061     - return $self->localise('ACCOUNT_TOO_LONG',
1062     - {maxLength => $maxAcctNameLength});
1063     - }
1064     - else {
1065     - return ('OK');
1066     - }
1067     -}
1068     -
1069     -=head2 validate_acctName_conflict
1070     -
1071     -Returns 'OK' if the account name doesn't yet exist. Returns a localised error
1072     -otherwise.
1073     -
1074     -=cut
1075     -
1076     -sub validate_acctName_conflict
1077     -{
1078     - my $self = shift;
1079     - my $acctName = shift;
1080     -
1081     - my $account = $accountdb->get($acctName);
1082     - my $type;
1083     -
1084     - if (defined $account)
1085     - {
1086     - $type = $account->prop('type');
1087     - }
1088     - elsif (defined getpwnam($acctName) || defined getgrnam($acctName))
1089     - {
1090     - $type = "system";
1091     - }
1092     - else
1093     - {
1094     - return('OK');
1095     - }
1096     - return $self->localise('ACCOUNT_CONFLICT',
1097     - { account => $acctName,
1098     - type => $type,
1099     -});
1100     -}
1101     -
1102     -=head2 check_password
1103     -
1104     -Validates the password using the desired strength
1105     -
1106     -=cut
1107     -
1108     -sub check_password {
1109     - my $self = shift;
1110     - my $pass1 = shift;
1111     -
1112     - my $check_type;
1113     - my $rec = $configdb->get('passwordstrength');
1114     - $check_type = ($rec ? ($rec->prop('Users') || 'none') : 'none');
1115     -
1116     - return $self->validate_password($check_type,$pass1);
1117     -}
1118     -
1119     -
1120     -=head2 get_prop ITEM PROP
1121     -
1122     -A simple accessor for esmith::ConfigDB::Record::prop
1123     -
1124     -=cut
1125     -
1126     -sub get_prop
1127     -{
1128     - my ($fm, $item, $prop, $default) = @_;
1129     -
1130     - return $configdb->get_prop($item, $prop) || $default;
1131     -}
1132     -
1133     -
1134     -=head1 System Password manipulation routines
1135     -
1136     -XXX FIXME - These should be merged with the useraccouts versions
1137     -
1138     -=head2 system_password_compare
1139     -
1140     -=cut
1141     -
1142     -sub system_password_compare
1143     -{
1144     - my $self = shift;
1145     - my $pass2 = shift;
1146     -
1147     - my $pass1 = $self->{cgi}->param('pass');
1148     - unless ($pass1 eq $pass2) {
1149     - $self->{cgi}->param( -name => 'wherenext', -value => 'Password' );
1150     - return "SYSTEM_PASSWORD_VERIFY_ERROR";
1151     - }
1152     - return "OK";
1153     -}
1154     -
1155     -=head2 system_valid_password
1156     -
1157     -Throw an error if the password doesn't consist solely of one or more printable characters.
1158     -
1159     -=cut
1160     -
1161     -sub system_valid_password
1162     -{
1163     - my $self = shift;
1164     - my $pass1 = shift;
1165     - # If the password contains one or more printable character
1166     - if ($pass1 =~ /^([ -~]+)$/) {
1167     - return('OK');
1168     - } else {
1169     - $self->{cgi}->param( -name => 'wherenext', -value => 'Password' );
1170     - return 'SYSTEM_PASSWORD_UNPRINTABLES_IN_PASS';
1171     - }
1172     -}
1173     -
1174     -=head2 system_check_password
1175     -
1176     -Validates the password using the desired strength
1177     -
1178     -=cut
1179     -
1180     -sub system_check_password
1181     -{
1182     - my $self = shift;
1183     - my $pass1 = shift;
1184     -
1185     - use esmith::ConfigDB;
1186     - my $conf = esmith::ConfigDB->open();
1187     - my $check_type;
1188     - my $rec;
1189     - if ($conf)
1190     - {
1191     - $rec = $conf->get('passwordstrength');
1192     - }
1193     - $check_type = ($rec ? ($rec->prop('Admin') || 'strong') : 'strong');
1194     -
1195     - return $self->validate_password($check_type,$pass1);
1196     -}
1197     -
1198     -=head2 authenticate_password
1199     -
1200     -Compares the password with the current system password
1201     -
1202     -=cut
1203     -
1204     -sub system_authenticate_password
1205     -{
1206     - my $self = shift;
1207     - my $pass = shift;
1208     -
1209     - if (esmith::util::authenticateUnixPassword( ($configdb->get_value("AdminIsNotRoot") eq 'enabled') ? 'admin' : 'root', $pass))
1210     - {
1211     - return "OK";
1212     - }
1213     - else
1214     - {
1215     - return "SYSTEM_PASSWORD_AUTH_ERROR";
1216     - }
1217     -}
1218     -
1219     -=head2 system_change_password
1220     -
1221     -If everything has been validated, properly, go ahead and set the new password.
1222     -
1223     -=cut
1224     -
1225     -sub system_change_password
1226     -{
1227     - my ($self) = @_;
1228     - my $pass = $self->{cgi}->param('pass');
1229     -
1230     - ($configdb->get_value("AdminIsNotRoot") eq 'enabled') ? esmith::util::setUnixPassword('admin',$pass) : esmith::util::setUnixSystemPassword($pass);
1231     - esmith::util::setServerSystemPassword($pass);
1232     -
1233     - my $result = system("/sbin/e-smith/signal-event password-modify admin");
1234     -
1235     - if ($result == 0)
1236     - {
1237     - $self->success('SYSTEM_PASSWORD_CHANGED', 'First');
1238     - }
1239     - else
1240     - {
1241     - $self->error("Error occurred while modifying password for admin.", 'First');
1242     - }
1243     -
1244     - return;
1245     -}
1246     -
1247     -sub print_ipsec_client_section
1248     -{
1249     - my $self = shift;
1250     - my $q = $self->cgi;
1251     -
1252     - # Don't show ipsecrw setting unless the status property exists
1253     - return '' unless ($configdb->get('ipsec')
1254     - && $configdb->get('ipsec')->prop('RoadWarriorStatus'));
1255     - # Don't show ipsecrw setting unless /sbin/e-smith/roadwarrior exists
1256     - return '' unless -x '/sbin/e-smith/roadwarrior';
1257     - my $acct = $q->param('acctName');
1258     - my $rec = $accountdb->get($acct) if $acct;
1259     - if ($acct and $rec)
1260     - {
1261     - my $pwset = $rec->prop('PasswordSet') || 'no';
1262     - my $VPNaccess = $rec->prop('VPNClientAccess') || 'no';
1263     - if ($pwset eq 'yes' and $VPNaccess eq 'yes')
1264     - {
1265     - print $q->Tr(
1266     - $q->td({-class=>'sme-noborders-label'},
1267     - $self->localise('LABEL_IPSECRW_DOWNLOAD')),
1268     - $q->td({-class=>'sme-noborders-content'},
1269     - $q->a({-class=>'button-like',
1270     - -href=>"?action=getCert&user=$acct"},
1271     - $self->localise('DOWNLOAD'))));
1272     - }
1273     - }
1274     - return '';
1275     -}
1276     -
1277     -sub get_ipsec_client_cert
1278     -{
1279     - my $self = shift;
1280     - my $q = shift;
1281     - my $user = $q->param('user');
1282     - ($user) = ($user =~ /^(.*)$/);
1283     -
1284     - die "Invalid user: $user\n" unless getpwnam($user);
1285     -
1286     - open (KID, "/sbin/e-smith/roadwarrior get_client_cert $user |")
1287     - or die "Can't fork: $!";
1288     - my $certfile = <KID>;
1289     - close KID;
1290     -
1291     - require File::Basename;
1292     - my $certname = File::Basename::basename($certfile);
1293     -
1294     - print "Expires: 0\n";
1295     - print "Content-type: application/x-pkcs12\n";
1296     - print "Content-disposition: inline; filename=$certname\n";
1297     - print "\n";
1298     -
1299     - open (CERT, "<$certfile");
1300     - while (<CERT>)
1301     - {
1302     - print;
1303     - }
1304     - close CERT;
1305     -
1306     - return '';
1307     -}
1308     -
1309     -sub display_email_forwarding
1310     -{
1311     - return defined $configdb->get('smtpd');
1312     -}
1313     -
1314     -1;
1315     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
1316     --- smeserver-manager-0.1.0.old/root/usr/share/perl5/vendor_perl/smeserver/Panel/wblNew.pm 2020-04-14 16:50:23.000000000 +0400
1317     +++ smeserver-manager-0.1.0/root/usr/share/perl5/vendor_perl/smeserver/Panel/wblNew.pm 1970-01-01 04:00:00.000000000 +0400
1318     @@ -1,455 +0,0 @@
1319     -#!/usr/bin/perl -w
1320     -
1321     -# package esmith::FormMagick::Panel::wblNew;
1322     -package smeserver::Panel::wblNew;
1323     -
1324     -use strict;
1325     -use warnings;
1326     -#use esmith::FormMagick;
1327     -#use esmith::cgi;
1328     -use esmith::ConfigDB;
1329     -use esmith::util;
1330     -use File::Basename;
1331     -use Exporter;
1332     -use Carp qw(verbose);
1333     -
1334     -our @ISA = qw( Exporter);
1335     -
1336     -our @EXPORT = qw(
1337     -get_dnsbl
1338     -get_rhsbl
1339     -get_uribl
1340     -get_sbllist
1341     -get_rbllist
1342     -get_ubllist
1343     -get_badhelo
1344     -get_badmailfrom
1345     -get_whitelisthosts
1346     -get_whitelisthelo
1347     -get_whitelistsenders
1348     -get_whitelistfrom
1349     -create_modify_black
1350     -create_modify_white
1351     -email_update
1352     -get_blacklistfrom
1353     -create_modify_rbl
1354     -);
1355     -
1356     -our $VERSION = sprintf '%d.%03d', q$Revision: 1.1 $ =~ /: (\d+).(\d+)/;
1357     -
1358     -our $db = esmith::ConfigDB->open() or die "Couldn't open ConfigDB\n";
1359     -our $wdb = esmith::ConfigDB->open('wbl') or die "Couldn't open wbl dbase\n";
1360     -our $sdb = esmith::ConfigDB->open('spamassassin') or die "Couldn't open spamassassin dbase\n";
1361     -
1362     -sub get_dnsbl
1363     -{
1364     - return ($db->get_prop('qpsmtpd', 'DNSBL') || 'disabled');
1365     -}
1366     -
1367     -sub get_rhsbl
1368     -{
1369     - return ($db->get_prop('qpsmtpd', 'RHSBL') || 'disabled');
1370     -}
1371     -
1372     -sub get_uribl
1373     -{
1374     - return ($db->get_prop('qpsmtpd', 'URIBL') || 'disabled');
1375     -}
1376     -
1377     -sub get_sbllist
1378     -{
1379     -my $sbllistform = $db->get_prop('qpsmtpd', 'SBLList') || '';
1380     -$sbllistform =~ s/,/\n/g;
1381     -return $sbllistform;
1382     -}
1383     -
1384     -sub get_rbllist
1385     -{
1386     -my $rbllistform = $db->get_prop('qpsmtpd', 'RBLList') || '';
1387     -$rbllistform =~ s/,/\n/g;
1388     -return $rbllistform;
1389     -}
1390     -
1391     -sub get_ubllist
1392     -{
1393     -my $rbllistform = $db->get_prop('qpsmtpd', 'UBLList') || '';
1394     -$rbllistform =~ s/,/\n/g;
1395     -return $rbllistform;
1396     -}
1397     -
1398     -
1399     -sub get_badhelo
1400     -{
1401     - my %list = $wdb->get('badhelo')->props;
1402     -
1403     - my @badhelo = ();
1404     - my $parameter = "";
1405     - my $value = "";
1406     - while (($parameter,$value) = each(%list)) {
1407     - if ($parameter eq "type") {next;}
1408     -
1409     - if ($value eq "Black") {
1410     - push @badhelo, $parameter;
1411     - }
1412     - }
1413     -
1414     - return "" unless (scalar @badhelo);
1415     -
1416     -# return join "\n", sort(@badhelo);
1417     - return sort(@badhelo);
1418     -}
1419     -
1420     -sub get_badmailfrom
1421     -{
1422     - my %list = $wdb->get('badmailfrom')->props;
1423     -
1424     - my @badmailfrom = ();
1425     - my $parameter = "";
1426     - my $value = "";
1427     - while (($parameter,$value) = each(%list)) {
1428     - if ($parameter eq "type") {next;}
1429     -
1430     - if ($value eq "Black") {
1431     - push @badmailfrom, $parameter;
1432     - }
1433     - }
1434     -
1435     - return "" unless (scalar @badmailfrom);
1436     -
1437     -# return join "\n", sort(@badmailfrom);
1438     - return sort(@badmailfrom);
1439     -}
1440     -
1441     -sub get_whitelisthosts
1442     -{
1443     - my %list = $wdb->get('whitelisthosts')->props;
1444     -
1445     - my @whitelisthosts = ();
1446     - my $parameter = "";
1447     - my $value = "";
1448     - while (($parameter,$value) = each(%list)) {
1449     - if ($parameter eq "type") {next;}
1450     -
1451     - if ($value eq "White") {
1452     - push @whitelisthosts, $parameter;
1453     - }
1454     - }
1455     -
1456     - return "" unless (scalar @whitelisthosts);
1457     -
1458     -# return join "\n", sort(@whitelisthosts);
1459     - return sort(@whitelisthosts);
1460     -
1461     -}
1462     -
1463     -sub get_whitelisthelo
1464     -{
1465     - my %list = $wdb->get('whitelisthelo')->props;
1466     -
1467     - my @whitelisthelo = ();
1468     - my $parameter = "";
1469     - my $value = "";
1470     - while (($parameter,$value) = each(%list)) {
1471     - if ($parameter eq "type") {next;}
1472     -
1473     - if ($value eq "White") {
1474     - push @whitelisthelo, $parameter;
1475     - }
1476     - }
1477     -
1478     - return "" unless (scalar @whitelisthelo);
1479     -
1480     -# return join "\n", sort(@whitelisthelo);
1481     - return sort(@whitelisthelo);
1482     -}
1483     -
1484     -sub get_whitelistsenders
1485     -{
1486     - my %list = $wdb->get('whitelistsenders')->props;
1487     -
1488     - my @whitelistsenders = ();
1489     - my $parameter = "";
1490     - my $value = "";
1491     - while (($parameter,$value) = each(%list)) {
1492     - if ($parameter eq "type") {next;}
1493     -
1494     - if ($value eq "White") {
1495     - push @whitelistsenders, $parameter;
1496     - }
1497     - }
1498     -
1499     - return "" unless (scalar @whitelistsenders);
1500     -
1501     - #return join "\n", sort(@whitelistsenders);
1502     - return sort(@whitelistsenders);
1503     -}
1504     -
1505     -sub get_whitelistfrom
1506     -{
1507     - my %list = $sdb->get('wbl.global')->props;
1508     -
1509     - my @whitelistfrom = ();
1510     - my $parameter = "";
1511     - my $value = "";
1512     - while (($parameter,$value) = each(%list)) {
1513     - if ($parameter eq "type") {next;}
1514     -
1515     - if ($value eq "White") {
1516     - push @whitelistfrom, $parameter;
1517     - }
1518     - }
1519     -
1520     - return "" unless (scalar @whitelistfrom);
1521     -
1522     -# return join "\n", sort(@whitelistfrom);
1523     - return sort(@whitelistfrom);
1524     -}
1525     -
1526     -sub create_modify_black
1527     -{
1528     - my $fm = shift;
1529     - my $q = $fm->{'cgi'};
1530     -
1531     - # qmail badhelo
1532     - my %list = $wdb->get('badhelo')->props;
1533     - my $parameter = "";
1534     - my $value = "";
1535     - while (($parameter,$value) = each(%list)) {
1536     - if ($parameter eq "type") {next;}
1537     -
1538     - if ($value eq "Black") {
1539     - $wdb->get_prop_and_delete('badhelo', "$parameter");
1540     - }
1541     - }
1542     -
1543     - my $BadHelo = $q->param("badhelo");
1544     - $BadHelo =~ s/\r\n/,/g;
1545     - my @BadHelo = sort(split /,/, $BadHelo);
1546     - foreach $BadHelo (@BadHelo)
1547     - {
1548     - $wdb->set_prop('badhelo', "$BadHelo", 'Black');
1549     - }
1550     -
1551     - # qmail badmailfrom
1552     - my %list_badmailfrom = $wdb->get('badmailfrom')->props;
1553     - my $parameter_badmailfrom = "";
1554     - my $value_badmailfrom = "";
1555     - while (($parameter_badmailfrom,$value_badmailfrom) = each(%list_badmailfrom)) {
1556     - if ($parameter_badmailfrom eq "type") {next;}
1557     -
1558     - if ($value_badmailfrom eq "Black") {
1559     - $wdb->get_prop_and_delete('badmailfrom', "$parameter_badmailfrom");
1560     - }
1561     - }
1562     -
1563     - my $BadMailFrom = $q->param("badmailfrom");
1564     - $BadMailFrom =~ s/\r\n/,/g;
1565     - my @BadMailFrom = sort(split /,/, $BadMailFrom);
1566     - foreach $BadMailFrom (@BadMailFrom){
1567     - $wdb->set_prop('badmailfrom', "$BadMailFrom", 'Black');
1568     - }
1569     - # spamassassin blacklist_from
1570     - my %list_wblglobal = $sdb->get('wbl.global')->props;
1571     - my $parameter_wblglobal = "";
1572     - my $value_wblglobal = "";
1573     - while (($parameter_wblglobal,$value_wblglobal) = each(%list_wblglobal)) {
1574     - if ($parameter_wblglobal eq "type") {next;}
1575     -
1576     - if ($value_wblglobal eq "Black") {
1577     - $sdb->get_prop_and_delete('wbl.global', "$parameter_wblglobal");
1578     - }
1579     - }
1580     -
1581     - my $BlacklistFrom = $q->param("blacklistfrom");
1582     - $BlacklistFrom =~ s/\r\n/,/g;
1583     - my @BlacklistFrom = sort(split /,/, $BlacklistFrom);
1584     - foreach $BlacklistFrom (@BlacklistFrom){
1585     - $sdb->set_prop('wbl.global', "$BlacklistFrom", 'Black');
1586     - }
1587     -
1588     - ##Update email settings
1589     - unless ( system ("/sbin/e-smith/signal-event", "smeserver-wbl-update") == 0 ){
1590     - $fm->error('ERROR_UPDATING');
1591     - return undef;
1592     - }
1593     -
1594     - $fm->success('SUCCESS');
1595     -}
1596     -
1597     -sub create_modify_white
1598     -{
1599     - my $fm = shift;
1600     - my $q = $fm->{'cgi'};
1601     -
1602     - # qpsmtpd whitelisthosts
1603     - my %list = $wdb->get('whitelisthosts')->props;
1604     - my $parameter = "";
1605     - my $value = "";
1606     - while (($parameter,$value) = each(%list)) {
1607     - if ($parameter eq "type") {next;}
1608     -
1609     - if ($value eq "White") {
1610     - $wdb->get_prop_and_delete('whitelisthosts', "$parameter");
1611     - }
1612     - }
1613     -
1614     - my $WhitelistHosts = $q->param("whitelisthosts");
1615     - $WhitelistHosts =~ s/\r\n/,/g;
1616     - my @WhitelistHosts = sort(split /,/, $WhitelistHosts);
1617     - foreach $WhitelistHosts (@WhitelistHosts)
1618     - {
1619     - $wdb->set_prop('whitelisthosts', "$WhitelistHosts", 'White');
1620     - }
1621     -
1622     - # qpsmtpd whitelisthelo
1623     - my %list_whitelisthelo = $wdb->get('whitelisthelo')->props;
1624     - my $parameter_whitelisthelo = "";
1625     - my $value_whitelisthelo = "";
1626     - while (($parameter_whitelisthelo,$value_whitelisthelo) = each(%list_whitelisthelo)) {
1627     - if ($parameter_whitelisthelo eq "type") {next;}
1628     -
1629     - if ($value_whitelisthelo eq "White") {
1630     - $wdb->get_prop_and_delete('whitelisthelo', "$parameter_whitelisthelo");
1631     - }
1632     - }
1633     -
1634     - my $WhitelistHelo = $q->param("whitelisthelo");
1635     - $WhitelistHelo =~ s/\r\n/,/g;
1636     - my @WhitelistHelo = sort(split /,/, $WhitelistHelo);
1637     - foreach $WhitelistHelo (@WhitelistHelo)
1638     - {
1639     - $wdb->set_prop('whitelisthelo', "$WhitelistHelo", 'White');
1640     - }
1641     -
1642     - # qpsmtpd whitelistsenders
1643     - my %list_whitelistsenders = $wdb->get('whitelistsenders')->props;
1644     - my $parameter_whitelistsenders = "";
1645     - my $value_whitelistsenders = "";
1646     - while (($parameter_whitelistsenders,$value_whitelistsenders) = each(%list_whitelistsenders)) {
1647     - if ($parameter_whitelistsenders eq "type") {next;}
1648     -
1649     - if ($value_whitelistsenders eq "White") {
1650     - $wdb->get_prop_and_delete('whitelistsenders', "$parameter_whitelistsenders");
1651     - }
1652     - }
1653     -
1654     - my $WhitelistSenders = $q->param("whitelistsenders");
1655     - $WhitelistSenders =~ s/\r\n/,/g;
1656     - my @WhitelistSenders = sort(split /,/, $WhitelistSenders);
1657     - foreach $WhitelistSenders (@WhitelistSenders)
1658     - {
1659     - $wdb->set_prop('whitelistsenders', "$WhitelistSenders", 'White');
1660     - }
1661     -
1662     - # spamassassin whitelist_from
1663     - my %list_wblglobal = $sdb->get('wbl.global')->props;
1664     - my $parameter_wblglobal = "";
1665     - my $value_wblglobal = "";
1666     - while (($parameter_wblglobal,$value_wblglobal) = each(%list_wblglobal)) {
1667     - if ($parameter_wblglobal eq "type") {next;}
1668     -
1669     - if ($value_wblglobal eq "White") {
1670     - $sdb->get_prop_and_delete('wbl.global', "$parameter_wblglobal");
1671     - }
1672     - }
1673     -
1674     - my $WhitelistFrom = $q->param("whitelistfrom");
1675     - $WhitelistFrom =~ s/\r\n/,/g;
1676     - my @WhitelistFrom = sort(split /,/, $WhitelistFrom);
1677     - foreach $WhitelistFrom (@WhitelistFrom){
1678     - $sdb->set_prop('wbl.global', "$WhitelistFrom", 'White');
1679     - }
1680     -
1681     - ##Update email settings
1682     - unless ( system ("/sbin/e-smith/signal-event", "smeserver-wbl-update") == 0 ){
1683     - $fm->error('ERROR_UPDATING');
1684     - return undef;
1685     - }
1686     -
1687     - $fm->success('SUCCESS');
1688     -}
1689     -
1690     -sub email_update
1691     -{
1692     - my $fm = shift;
1693     - my $q = $fm->{'cgi'};
1694     -
1695     - unless ( system ("/sbin/e-smith/signal-event", "smeserver-wbl-update") == 0 )
1696     - {
1697     - $fm->error('ERROR_UPDATING');
1698     - return undef;
1699     - }
1700     -
1701     - $fm->success('SUCCESS');
1702     -
1703     -}
1704     -
1705     -sub get_blacklistfrom
1706     -{
1707     - my %list = $sdb->get('wbl.global')->props;
1708     -
1709     - my @blacklistfrom = ();
1710     - my $parameter = "";
1711     - my $value = "";
1712     - while (($parameter,$value) = each(%list)) {
1713     - if ($parameter eq "type") {next;}
1714     -
1715     - if ($value eq "Black") {
1716     - push @blacklistfrom, $parameter;
1717     - }
1718     - }
1719     -
1720     - return "" unless (scalar @blacklistfrom);
1721     -
1722     - return join "\n", sort(@blacklistfrom);
1723     -}
1724     -sub create_modify_rbl
1725     -{
1726     - my $fm = shift;
1727     - my $q = $fm->{'cgi'};
1728     -
1729     - my $dnsbl = $q->param('dnsbl');
1730     - $db->set_prop('qpsmtpd', 'DNSBL', "$dnsbl");
1731     -
1732     - my $rhsbl = $q->param('rhsbl');
1733     - $db->set_prop('qpsmtpd', 'RHSBL', "$rhsbl");
1734     -
1735     -
1736     - my $sbllistcgi = $q->param('sbllist');
1737     - my @sbllistcgi = split /\s{2,}/, $sbllistcgi;
1738     - my $sbllistdb = '';
1739     - foreach (@sbllistcgi) { $sbllistdb = $sbllistdb . ',' . $_; }
1740     - $sbllistdb =~ s/^,//;
1741     -
1742     - $db->set_prop('qpsmtpd', 'SBLList', "$sbllistdb");
1743     -
1744     -
1745     - my $rbllistcgi = $q->param('rbllist');
1746     - my @rbllistcgi = split /\s{2,}/, $rbllistcgi;
1747     - my $rbllistdb = '';
1748     - foreach (@rbllistcgi) { $rbllistdb = $rbllistdb . ',' . $_; }
1749     - $rbllistdb =~ s/^,//;
1750     -
1751     - $db->set_prop('qpsmtpd', 'RBLList', "$rbllistdb");
1752     -
1753     - ##Update email settings
1754     -
1755     - unless ( system ("/sbin/e-smith/signal-event", "smeserver-wbl-update") == 0 ){
1756     - $fm->error('ERROR_UPDATING');
1757     - return undef;
1758     - }
1759     -
1760     - $fm->success('SUCCESS');
1761     -}
1762     -
1763     -#Subroutine to display buttons
1764     -#sub print_custom_button{
1765     -# my ($fm,$desc,$url) = @_;
1766     -# my $q = $fm->{cgi};
1767     -# $url="wbl?page=0&page_stack=&Next=Next&wherenext=".$url;
1768     -# print " <tr>\n <td colspan='2'>\n";
1769     -# print $q->p($q->a({href => $url, -class => "button-like"},$fm->localise($desc)));
1770     -# print qq(</tr>\n);
1771     -# return undef;
1772     -#}
1773     -#;

admin@koozali.org
ViewVC Help
Powered by ViewVC 1.2.1 RSS 2.0 feed