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 |
|
|
-#; |