1951 lines
		
	
	
		
			52 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
		
		
			
		
	
	
			1951 lines
		
	
	
		
			52 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
| 
								 | 
							
								#!/usr/bin/perl -wT
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#----------------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# heading     : Your Settings
							 | 
						||
| 
								 | 
							
								# description : User accounts
							 | 
						||
| 
								 | 
							
								# longdesc    : create and modify users
							 | 
						||
| 
								 | 
							
								# navigation  : 100 900
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Copyright (c) 2001 Mitel Networks Corporation
							 | 
						||
| 
								 | 
							
								#               Modified: Stephen Noble support@dungog.net
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# This program is free software; you can redistribute it and/or modify
							 | 
						||
| 
								 | 
							
								# it under the terms of the GNU General Public License as published by
							 | 
						||
| 
								 | 
							
								# the Free Software Foundation; either version 2 of the License, or
							 | 
						||
| 
								 | 
							
								# (at your option) any later version.
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# This program is distributed in the hope that it will be useful,
							 | 
						||
| 
								 | 
							
								# but WITHOUT ANY WARRANTY; without even the implied warranty of
							 | 
						||
| 
								 | 
							
								# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
							 | 
						||
| 
								 | 
							
								# GNU General Public License for more details.
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# You should have received a copy of the GNU General Public License
							 | 
						||
| 
								 | 
							
								# along with this program; if not, write to the Free Software
							 | 
						||
| 
								 | 
							
								# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								# Technical support for this program is available from e-smith, inc.
							 | 
						||
| 
								 | 
							
								# Please visit our web site www.e-smith.com for details.
							 | 
						||
| 
								 | 
							
								#----------------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								package esmith;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								use strict;
							 | 
						||
| 
								 | 
							
								use CGI ':all';
							 | 
						||
| 
								 | 
							
								use CGI::Carp qw(fatalsToBrowser);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								use esmith::cgi5;
							 | 
						||
| 
								 | 
							
								use esmith::config;
							 | 
						||
| 
								 | 
							
								use esmith::util;
							 | 
						||
| 
								 | 
							
								use esmith::db;
							 | 
						||
| 
								 | 
							
								use esmith::event;
							 | 
						||
| 
								 | 
							
								use esmith::cgi;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								# added by lorenzo
							 | 
						||
| 
								 | 
							
								use Crypt::Cracklib;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub showInitial ($$$);
							 | 
						||
| 
								 | 
							
								sub showHelp ($);
							 | 
						||
| 
								 | 
							
								sub genEmailForward ($$);
							 | 
						||
| 
								 | 
							
								sub genGroups ($$);
							 | 
						||
| 
								 | 
							
								sub createUser ($);
							 | 
						||
| 
								 | 
							
								sub performCreateUser ($);
							 | 
						||
| 
								 | 
							
								sub modifyUser ($);
							 | 
						||
| 
								 | 
							
								sub performModifyUser ($);
							 | 
						||
| 
								 | 
							
								sub deleteUser ($);
							 | 
						||
| 
								 | 
							
								sub performDeleteUser ($);
							 | 
						||
| 
								 | 
							
								sub passwdUser ($);
							 | 
						||
| 
								 | 
							
								sub performPasswdUser ($);
							 | 
						||
| 
								 | 
							
								sub lockUser ($);
							 | 
						||
| 
								 | 
							
								sub performlockUser ($);
							 | 
						||
| 
								 | 
							
								sub makePseudonyms ($$);
							 | 
						||
| 
								 | 
							
								sub getNextFreeID;
							 | 
						||
| 
								 | 
							
								sub performSelect ($);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								BEGIN
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    # Clear PATH and related environment variables so that calls to
							 | 
						||
| 
								 | 
							
								    # external programs do not cause results to be tainted. See
							 | 
						||
| 
								 | 
							
								    # "perlsec" manual page for details.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    $ENV {'PATH'} = '';
							 | 
						||
| 
								 | 
							
								    $ENV {'SHELL'} = '/bin/bash';
							 | 
						||
| 
								 | 
							
								    delete $ENV {'ENV'};
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								esmith::util::setRealToEffective ();
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								$CGI::POST_MAX=1024 * 100;  # max 100K posts
							 | 
						||
| 
								 | 
							
								$CGI::DISABLE_UPLOADS = 1;  # no uploads
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								my %conf;
							 | 
						||
| 
								 | 
							
								tie %conf, 'esmith::config';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								my %accounts;
							 | 
						||
| 
								 | 
							
								tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# examine state parameter and display the appropriate form
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								my $q = new CGI;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								if (! grep (/^state$/, $q->param))
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    showInitial ($q, '', '');
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "help")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    showHelp ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "create")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    createUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "performCreate")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    performCreateUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "modify")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    modifyUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "performModify")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    performModifyUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "delete")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    deleteUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "performDelete")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    performDeleteUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "passwd")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    passwdUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "performPasswd")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    performPasswdUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "lock")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    lockUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "performLock")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    performlockUser ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								elsif ($q->param ('state') eq "select")
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    performSelect ($q);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								else
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genStateError ($q, \%conf);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								exit (0);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# subroutine to display initial form
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub showInitial ($$$)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q, $msg, $passg) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # If there's a message, we just finished an operation so show the
							 | 
						||
| 
								 | 
							
								    # status report. If no message, this is a new list of accounts.
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($msg eq '')
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genHeaderNonCacheable
							 | 
						||
| 
								 | 
							
									    ($q, \%conf, 'Create, remove, or change user accounts');
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genHeaderNonCacheable
							 | 
						||
| 
								 | 
							
									    ($q, \%conf, 'Operation status report');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->p ($msg);
							 | 
						||
| 
								 | 
							
									print $q->hr;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Look up accounts and user names
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my @userAccounts = ();
							 | 
						||
| 
								 | 
							
									  my $user;
							 | 
						||
| 
								 | 
							
								    my $acctN = $ENV{'REMOTE_USER'};
							 | 
						||
| 
								 | 
							
								    my $fGroup = '';
							 | 
						||
| 
								 | 
							
								    my @ulist = ();
							 | 
						||
| 
								 | 
							
								    my $members =  '';
							 | 
						||
| 
								 | 
							
								    my @members =  ();
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    # find system groups
							 | 
						||
| 
								 | 
							
								    my @glist = ();
							 | 
						||
| 
								 | 
							
								    foreach (sort keys %accounts)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								       push (@glist, $_)
							 | 
						||
| 
								 | 
							
								           if (db_get_type(\%accounts, $_) eq 'group');
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    # is user a member of this group, add to ulist
							 | 
						||
| 
								 | 
							
								    foreach my $group (@glist)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								       $members = db_get_prop(\%accounts, $group, 'Members') || '';
							 | 
						||
| 
								 | 
							
								       @members = split (/,/, $members);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								       foreach my $user (@members)
							 | 
						||
| 
								 | 
							
								       {
							 | 
						||
| 
								 | 
							
								          if ($user eq $acctN)
							 | 
						||
| 
								 | 
							
								          {
							 | 
						||
| 
								 | 
							
								          	push (@ulist, $group);
							 | 
						||
| 
								 | 
							
								            $fGroup = $group;
							 | 
						||
| 
								 | 
							
								          }
							 | 
						||
| 
								 | 
							
								        }
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    #number of user in group
							 | 
						||
| 
								 | 
							
								    my $ulist = @ulist;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #my  $bGroup = db_get(\%conf, 'fGroup');
							 | 
						||
| 
								 | 
							
								    if (exists $conf {'fGroup'})
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      $fGroup = db_get(\%conf, 'fGroup');
							 | 
						||
| 
								 | 
							
								      db_delete(\%conf, 'fGroup');
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #change to a passed value / swap group
							 | 
						||
| 
								 | 
							
								    if ($passg ne '')
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $fGroup = $passg;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $groupLimit = db_get_prop(\%accounts, 'groupLimit', $fGroup) || '999';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    $members = db_get_prop(\%accounts, $fGroup, 'Members') || '';
							 | 
						||
| 
								 | 
							
								    @members = split (/,/, $members);
							 | 
						||
| 
								 | 
							
								    my $numMembers = @members || '0';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($ulist == 0)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        print $q->p ($q->b ("This user is not in a group so he cannot add users"));
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      if ($groupLimit > $numMembers)
							 | 
						||
| 
								 | 
							
								      {
							 | 
						||
| 
								 | 
							
								         print $q->p ($q->a ({href => $q->url (-absolute => 1) . "?state=create&fGroup=$fGroup"},
							 | 
						||
| 
								 | 
							
										   	'Click here'),
							 | 
						||
| 
								 | 
							
									   	    "to create a user account in group <b>$fGroup</b>.");
							 | 
						||
| 
								 | 
							
								      }
							 | 
						||
| 
								 | 
							
								      else
							 | 
						||
| 
								 | 
							
								      {
							 | 
						||
| 
								 | 
							
									    print $q->p ("The maximum number of members in this group <b>$fGroup</b> has been reached.");
							 | 
						||
| 
								 | 
							
								      }
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    foreach (keys %accounts)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									  push (@userAccounts, $_)
							 | 
						||
| 
								 | 
							
									    if (db_get_type(\%accounts, $_) eq "user");
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless (scalar @userAccounts)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									  print $q->p ($q->b ('There are no user accounts in the system.'));
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my $description = <<END_TEXT;
							 | 
						||
| 
								 | 
							
								You can modify, lock or remove any account or reset the
							 | 
						||
| 
								 | 
							
								account's password by clicking on the
							 | 
						||
| 
								 | 
							
								corresponding command next to the account.
							 | 
						||
| 
								 | 
							
								<P>
							 | 
						||
| 
								 | 
							
								If the account is marked as locked,
							 | 
						||
| 
								 | 
							
								that means that the user's password needs
							 | 
						||
| 
								 | 
							
								to be reset.  Please note that newly created
							 | 
						||
| 
								 | 
							
								accounts are automatically locked until the
							 | 
						||
| 
								 | 
							
								password is changed.
							 | 
						||
| 
								 | 
							
								END_TEXT
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->p ($description);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($ulist == 0)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        print $q->p ($q->b ("This user is not in a group so he cannot edit users"));
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        #if ($ulist == 1)
							 | 
						||
| 
								 | 
							
								        #{
							 | 
						||
| 
								 | 
							
								        #    print $q->p ($q->td ("Current group is <b>$fGroup</b>"));
							 | 
						||
| 
								 | 
							
								        #}
							 | 
						||
| 
								 | 
							
								        if ($ulist > 1)
							 | 
						||
| 
								 | 
							
								        {
							 | 
						||
| 
								 | 
							
								            print $q->p ($q->td ("You are in multiple groups, you can change the group to create users in below..."));
							 | 
						||
| 
								 | 
							
								            foreach (@ulist)
							 | 
						||
| 
								 | 
							
								            {
							 | 
						||
| 
								 | 
							
								              print $q->Tr ($q->td ($q->a ({href => $q->url (-absolute => 1) . "?state=select&swap=$_"},
							 | 
						||
| 
								 | 
							
								                      "$_"), " ; "));
							 | 
						||
| 
								 | 
							
								            }
							 | 
						||
| 
								 | 
							
								        }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    print $q->p ($q->b ('Current List of User Accounts'));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        print "<table border=1 cellspacing=1 cellpadding=4>";
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    print $q->Tr (esmith::cgi5::genSmallCell ($q, $q->b ('Account')),
							 | 
						||
| 
								 | 
							
									    	      esmith::cgi5::genSmallCell ($q, $q->b ('User Name')),
							 | 
						||
| 
								 | 
							
									    	      $q->td (' '),
							 | 
						||
| 
								 | 
							
									    	      $q->td (' '),
							 | 
						||
| 
								 | 
							
									    	      $q->td (' '),
							 | 
						||
| 
								 | 
							
									    	      $q->td (' '));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    foreach $user (sort @userAccounts)
							 | 
						||
| 
								 | 
							
									    {
							 | 
						||
| 
								 | 
							
								         my $members = db_get_prop(\%accounts, $fGroup, 'Members') || '';
							 | 
						||
| 
								 | 
							
								         my @members = split (/,/, $members);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								         foreach (@members)
							 | 
						||
| 
								 | 
							
								         {
							 | 
						||
| 
								 | 
							
								 	      if ($_ eq $user)
							 | 
						||
| 
								 | 
							
								          {
							 | 
						||
| 
								 | 
							
									        my $name = db_get_prop(\%accounts, $user, "FirstName")
							 | 
						||
| 
								 | 
							
									    	. " "
							 | 
						||
| 
								 | 
							
									    	. db_get_prop(\%accounts, $user, "LastName");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									        if (db_get_prop(\%accounts, $user, "PasswordSet") eq "yes")
							 | 
						||
| 
								 | 
							
									        {
							 | 
						||
| 
								 | 
							
									    	print $q->Tr (esmith::cgi5::genSmallCell ($q, $user),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallCell ($q, $name),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallCell ($q,
							 | 
						||
| 
								 | 
							
									    			$q->a ({href => $q->url (-absolute => 1)
							 | 
						||
| 
								 | 
							
									    				     . "?state=modify&acct="
							 | 
						||
| 
								 | 
							
									    				     . "$user&fGroup=$fGroup"}, 'Modify...')),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallCell ($q,
							 | 
						||
| 
								 | 
							
									    			$q->a ({href => $q->url (-absolute => 1)
							 | 
						||
| 
								 | 
							
									    				     . "?state=passwd&acct="
							 | 
						||
| 
								 | 
							
									    				     . "$user&fGroup=$fGroup"}, 'Reset password...')),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallCell ($q,
							 | 
						||
| 
								 | 
							
									    			$q->a ({href => $q->url (-absolute => 1)
							 | 
						||
| 
								 | 
							
									    				     . "?state=lock&acct="
							 | 
						||
| 
								 | 
							
									    				     . "$user&fGroup=$fGroup"}, 'Lock Account...')),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallCell ($q,
							 | 
						||
| 
								 | 
							
									    			$q->a ({href => $q->url (-absolute => 1)
							 | 
						||
| 
								 | 
							
									    				     . "?state=delete&acct="
							 | 
						||
| 
								 | 
							
									    				     . "$user&fGroup=$fGroup"}, 'Remove...')));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									        }
							 | 
						||
| 
								 | 
							
									        else
							 | 
						||
| 
								 | 
							
									        {
							 | 
						||
| 
								 | 
							
									    	print $q->Tr (esmith::cgi5::genSmallRedCell ($q, $user),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallRedCell ($q, $name),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallCell ($q,
							 | 
						||
| 
								 | 
							
									    			$q->a ({href => $q->url (-absolute => 1)
							 | 
						||
| 
								 | 
							
									    				     . "?state=modify&acct="
							 | 
						||
| 
								 | 
							
									    				     . "$user&fGroup=$fGroup"}, 'Modify...')),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallCell ($q,
							 | 
						||
| 
								 | 
							
									    			$q->a ({href => $q->url (-absolute => 1)
							 | 
						||
| 
								 | 
							
									    				     . "?state=passwd&acct="
							 | 
						||
| 
								 | 
							
									    				     . "$user&fGroup=$fGroup"}, 'Reset password...')),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallRedCell ($q,
							 | 
						||
| 
								 | 
							
									    					"Account is locked"),
							 | 
						||
| 
								 | 
							
									    		      esmith::cgi5::genSmallCell ($q,
							 | 
						||
| 
								 | 
							
									    			$q->a ({href => $q->url (-absolute => 1)
							 | 
						||
| 
								 | 
							
									    				     . "?state=delete&acct="
							 | 
						||
| 
								 | 
							
									    				     . "$user&fGroup=$fGroup"}, 'Remove...')));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									        }#password
							 | 
						||
| 
								 | 
							
								          }#if user = group member
							 | 
						||
| 
								 | 
							
								         }#foreach group
							 | 
						||
| 
								 | 
							
									    }#foreach user
							 | 
						||
| 
								 | 
							
									   print '</table>';
							 | 
						||
| 
								 | 
							
								    }#if ulist = 0
							 | 
						||
| 
								 | 
							
								    }#if accounts >0
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->endform;
							 | 
						||
| 
								 | 
							
								#    print $q->p ($q->hr, $q->font ({size => "-1"}, "www.dungog.net/sme",
							 | 
						||
| 
								 | 
							
								    esmith::cgi::genFooter($q);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								          print $q->a ({href => $q->url (-absolute => 1) . "?state=help"}, 'Useraccounts help'), " ...";
							 | 
						||
| 
								 | 
							
								    print '</FONT>';
							 | 
						||
| 
								 | 
							
								    print '</DIV>';
							 | 
						||
| 
								 | 
							
								    print $q->end_html;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub genEmailForward ($$)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q, $currentSetting) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ((! defined $currentSetting) || ($currentSetting eq ''))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$currentSetting = 'local';
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my %emailLabels = ('local'   => 'Deliver e-mail locally',
							 | 
						||
| 
								 | 
							
										       'forward' => 'Forward to address below',
							 | 
						||
| 
								 | 
							
								                       'both'     => 'Both deliver locally and forward');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    return esmith::cgi5::genCell ($q, $q->popup_menu (-name    => 'emailForward',
							 | 
						||
| 
								 | 
							
														     -values  => ['local', 'forward', 'both'],
							 | 
						||
| 
								 | 
							
														     -default => $currentSetting,
							 | 
						||
| 
								 | 
							
														     -labels  => \%emailLabels));
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub genGroups ($$)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q, $user) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $key;
							 | 
						||
| 
								 | 
							
								    my $value;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my @groups = ();
							 | 
						||
| 
								 | 
							
								    my @selected = ();
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    foreach (sort keys %accounts)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									if (db_get_type(\%accounts, $_) eq "group")
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    push @groups, $_;
							 | 
						||
| 
								 | 
							
									    if ($user ne '')
							 | 
						||
| 
								 | 
							
									    {
							 | 
						||
| 
								 | 
							
										my @members =
							 | 
						||
| 
								 | 
							
										    split (/,/, db_get_prop(\%accounts, $_, "Members"));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
										if (grep (/^$user$/, @members))
							 | 
						||
| 
								 | 
							
										{
							 | 
						||
| 
								 | 
							
										    push @selected, $_;
							 | 
						||
| 
								 | 
							
										}
							 | 
						||
| 
								 | 
							
									    }
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    @groups = sort @groups;
							 | 
						||
| 
								 | 
							
								    my $count = scalar @groups;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $out;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($count > 0)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$out = "<table border=1 cellspacing=1 cellpadding=4>";
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									$out .= $q->Tr ($q->td (' '),
							 | 
						||
| 
								 | 
							
										        esmith::cgi5::genSmallCell ($q, $q->b ('Group')),
							 | 
						||
| 
								 | 
							
										        esmith::cgi5::genSmallCell ($q, $q->b ('Description')));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									my $group;
							 | 
						||
| 
								 | 
							
									foreach $group (@groups)
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    my $checked = "";
							 | 
						||
| 
								 | 
							
									    if (grep (/^$group$/, @selected))
							 | 
						||
| 
								 | 
							
									    {
							 | 
						||
| 
								 | 
							
										$checked = "checked";
							 | 
						||
| 
								 | 
							
									    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    $out .=
							 | 
						||
| 
								 | 
							
										$q->Tr (
							 | 
						||
| 
								 | 
							
											$q->td (
							 | 
						||
| 
								 | 
							
												"<input type=\"checkbox\""
							 | 
						||
| 
								 | 
							
												. " name=\"groupMemberships\""
							 | 
						||
| 
								 | 
							
												. " $checked value=\"$group\">"
							 | 
						||
| 
								 | 
							
											    ),
							 | 
						||
| 
								 | 
							
											esmith::cgi5::genSmallCell ($q, $group),
							 | 
						||
| 
								 | 
							
											esmith::cgi5::genSmallCell (
							 | 
						||
| 
								 | 
							
												$q,
							 | 
						||
| 
								 | 
							
												db_get_prop(\%accounts, $group, "Description")
							 | 
						||
| 
								 | 
							
											    )
							 | 
						||
| 
								 | 
							
										    );
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									$out .= '</table>';
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$out = $q->b ('Not applicable (no groups defined yet).');
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    return $out;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub createUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								    my $acctN = $ENV{'REMOTE_USER'};
							 | 
						||
| 
								 | 
							
								    my $fGroup = $q->param ('fGroup');
							 | 
						||
| 
								 | 
							
								    db_set(\%conf, 'fGroup', $fGroup);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $description = <<END_TEXT;
							 | 
						||
| 
								 | 
							
								The account name should contain only lower-case letters, numbers, and
							 | 
						||
| 
								 | 
							
								hyphens, and should start with a lower-case letter. For example "betty",
							 | 
						||
| 
								 | 
							
								"hjohnson", and "mary-jane" are all valid account names, but
							 | 
						||
| 
								 | 
							
								"3friends", "John Smith", and "henry_miller" are not.
							 | 
						||
| 
								 | 
							
								<P>
							 | 
						||
| 
								 | 
							
								Note that two special pseudonyms will be created for each new
							 | 
						||
| 
								 | 
							
								account.  These pseudonyms provide the ability to have alternative
							 | 
						||
| 
								 | 
							
								mail accounts for that user which include their first name and last
							 | 
						||
| 
								 | 
							
								name seperated with a period (.) and underscore (_). So, for the
							 | 
						||
| 
								 | 
							
								account "betty" with first name "Betty" and last name "Rubble"
							 | 
						||
| 
								 | 
							
								two pseudonyms are created as betty.rubble and betty_rubble.
							 | 
						||
| 
								 | 
							
								<P>
							 | 
						||
| 
								 | 
							
								The directory information (department, company, etc.) can be changed
							 | 
						||
| 
								 | 
							
								from the defaults shown below. The changes will apply only to this user.
							 | 
						||
| 
								 | 
							
								END_TEXT
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genHeaderNonCacheable
							 | 
						||
| 
								 | 
							
									($q, \%conf, 'Create a new user account');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->startform (-method => 'POST',
							 | 
						||
| 
								 | 
							
											 -action => $q->url (-absolute => 1));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genTextRow ($q,
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    $q->p ($description)),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
												      "Account name",
							 | 
						||
| 
								 | 
							
												      "acctName",
							 | 
						||
| 
								 | 
							
												      ""),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
												      "First name",
							 | 
						||
| 
								 | 
							
												      "firstName",
							 | 
						||
| 
								 | 
							
												      ""),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
												      "Last name",
							 | 
						||
| 
								 | 
							
												      "lastName",
							 | 
						||
| 
								 | 
							
												      ""),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
								                                  "Department",
							 | 
						||
| 
								 | 
							
								                                  "department",
							 | 
						||
| 
								 | 
							
								                                  db_get_prop (\%conf, 'ldap', 'defaultDepartment')),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
								                                  "Company",
							 | 
						||
| 
								 | 
							
								                                  "company",
							 | 
						||
| 
								 | 
							
								                                  db_get_prop (\%conf, 'ldap', 'defaultCompany')),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
								                                  "Street address",
							 | 
						||
| 
								 | 
							
								                                  "street",
							 | 
						||
| 
								 | 
							
								                                  db_get_prop (\%conf, 'ldap', 'defaultStreet')),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
								                                  "City",
							 | 
						||
| 
								 | 
							
								                                  "city",
							 | 
						||
| 
								 | 
							
								                                  db_get_prop (\%conf, 'ldap', 'defaultCity')),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
								                                  "Phone number",
							 | 
						||
| 
								 | 
							
								                                  "phone",
							 | 
						||
| 
								 | 
							
								                                  db_get_prop (\%conf, 'ldap', 'defaultPhoneNumber')),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    $q->Tr (esmith::cgi5::genCell ($q, "E-mail delivery:"),
							 | 
						||
| 
								 | 
							
									genEmailForward ($q, '')),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
											      "Forwarding address",
							 | 
						||
| 
								 | 
							
											      "forwardAddress",
							 | 
						||
| 
								 | 
							
											      ""),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genWidgetRow ($q, "VPN Client Access",
							 | 
						||
| 
								 | 
							
								            $q->popup_menu (-name    => 'VPNClientAccess',
							 | 
						||
| 
								 | 
							
								                            -values  => ['no','yes'])),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genTextRow ($q,
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    $q->p ("This user will be added to the <b>$fGroup</b> Group")),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									esmith::cgi5::genButtonRow ($q,
							 | 
						||
| 
								 | 
							
												   $q->submit (-name => 'action',
							 | 
						||
| 
								 | 
							
													       -value => 'Create')));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->hidden (-name => 'groupMemberships', -override => 1, -default => $fGroup);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->hidden (-name => 'state',
							 | 
						||
| 
								 | 
							
										      -override => 1,
							 | 
						||
| 
								 | 
							
										      -default => 'performCreate');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->endform;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->endform;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#    print $q->p ($q->hr, $q->font ({size => "-1"}, "www.dungog.net/sme"));
							 | 
						||
| 
								 | 
							
								    esmith::cgi::genFooter($q);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print '</FONT>';
							 | 
						||
| 
								 | 
							
								    print '</DIV>';
							 | 
						||
| 
								 | 
							
								    print $q->end_html;
							 | 
						||
| 
								 | 
							
								    #esmith::cgi5::genFooter ($q);
							 | 
						||
| 
								 | 
							
								    return;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub performCreateUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Validate parameters and untaint them
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $acctName = $q->param ('acctName');
							 | 
						||
| 
								 | 
							
								    if ($acctName =~ /^([a-z][\-a-z0-9]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$acctName = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: unexpected characters in account name: " .
							 | 
						||
| 
								 | 
							
										     "\"$acctName\". The account name should contain only " .
							 | 
						||
| 
								 | 
							
										     "lower-case letters, numbers, and hyphens, and should " .
							 | 
						||
| 
								 | 
							
										     "start with a lower-case letter. For example \"betty\", " .
							 | 
						||
| 
								 | 
							
										     "\"hjohnson\", and \"mary-jane\" are all valid account " .
							 | 
						||
| 
								 | 
							
										     "names, but \"3friends\", \"John Smith\" and " .
							 | 
						||
| 
								 | 
							
										     "\"henry_miller\" are not.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    my $maxAcctNameLength = defined $conf{'maxAcctNameLength'} ?
							 | 
						||
| 
								 | 
							
									$conf{'maxAcctNameLength'} : 12;
							 | 
						||
| 
								 | 
							
								    if (length $acctName > $maxAcctNameLength)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
									     "Error: account name " .
							 | 
						||
| 
								 | 
							
										 "\"$acctName\" is too long. " .
							 | 
						||
| 
								 | 
							
										 "The maximum is $maxAcctNameLength characters.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $firstName = $q->param ('firstName');
							 | 
						||
| 
								 | 
							
								    if ($firstName =~ /^\s*([a-zA-Z0-9\'\.\-\s]+?)\s*$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$firstName = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: unexpected or missing characters in first name: " .
							 | 
						||
| 
								 | 
							
										     "\"$firstName\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $lastName = $q->param ('lastName');
							 | 
						||
| 
								 | 
							
								    if ($lastName =~ /^\s*([a-zA-Z0-9\'\.\-\s]+?)\s*$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$lastName = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: unexpected or missing characters in last name: " .
							 | 
						||
| 
								 | 
							
										     "\"$lastName\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $department = $q->param ('department');
							 | 
						||
| 
								 | 
							
								    if ($department =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$department = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: unexpected characters in department: " .
							 | 
						||
| 
								 | 
							
										     "\"$department\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $company = $q->param ('company');
							 | 
						||
| 
								 | 
							
								    if ($company =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$company = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: unexpected characters in company: " .
							 | 
						||
| 
								 | 
							
										     "\"$company\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $street = $q->param ('street');
							 | 
						||
| 
								 | 
							
								    if ($street =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$street = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: unexpected characters in street address: " .
							 | 
						||
| 
								 | 
							
										     "\"$street\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $city = $q->param ('city');
							 | 
						||
| 
								 | 
							
								    if ($city =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$city = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: unexpected characters in city: " .
							 | 
						||
| 
								 | 
							
										     "\"$city\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $phone = $q->param ('phone');
							 | 
						||
| 
								 | 
							
								    if ($phone =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$phone = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: unexpected characters in phone number: " .
							 | 
						||
| 
								 | 
							
										     "\"$phone\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $emailForward = $q->param ('emailForward');
							 | 
						||
| 
								 | 
							
								    if ($emailForward =~ /^(.*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$emailForward = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$emailForward = "";
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $VPNClientAccess = $q->param ('VPNClientAccess');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $forwardAddress = $q->param ('forwardAddress');
							 | 
						||
| 
								 | 
							
								    if (($emailForward eq 'local') && ($forwardAddress =~ /^([^\|]*)$/))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $forwardAddress = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    elsif (($emailForward eq 'forward') && ($forwardAddress =~ /^([^\|]+)$/))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $forwardAddress = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    elsif (($emailForward eq 'both') && ($forwardAddress =~ /^([^\|]+)$/))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $forwardAddress = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected or missing characters in email forwarding address: " .
							 | 
						||
| 
								 | 
							
								                     "\"$forwardAddress\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my ($dot_pseudonym, $underbar_pseudonym)
							 | 
						||
| 
								 | 
							
									= makePseudonyms($firstName, $lastName);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Looks good. Find out if this account has been taken or there is
							 | 
						||
| 
								 | 
							
								    # a name clash with the pseudonyms
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if (db_get(\%accounts, $acctName))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my $type = db_get_type(\%accounts, $acctName);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									if ($type eq "pseudonym")
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    my $acct = db_get_prop(\%accounts, $acctName, "Account");
							 | 
						||
| 
								 | 
							
									    my $acct_type = db_get_type(\%accounts, $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    showInitial ($q,
							 | 
						||
| 
								 | 
							
										    "Error: account \"$acctName\" clashes with pseudonym"
							 | 
						||
| 
								 | 
							
										    . " details for $acct_type account \"$acct\"."
							 | 
						||
| 
								 | 
							
										    . "<p> $acctName is a pseudonym for $acct. </p>",""
							 | 
						||
| 
								 | 
							
										 );
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
									else
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: account \"$acctName\" is an existing"
							 | 
						||
| 
								 | 
							
										     . " $type account.",""
							 | 
						||
| 
								 | 
							
										 );
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if (db_get(\%accounts, $dot_pseudonym))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my $type = db_get_type(\%accounts, $dot_pseudonym);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									if ($type eq "pseudonym")
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    my $acct = db_get_prop(\%accounts, $dot_pseudonym, "Account");
							 | 
						||
| 
								 | 
							
									    my $acct_type = db_get_type(\%accounts, $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    showInitial ($q,
							 | 
						||
| 
								 | 
							
										    "Error: first and last name details for account"
							 | 
						||
| 
								 | 
							
										    . " \"$acctName\" clash with pseudonym details for"
							 | 
						||
| 
								 | 
							
										    . " $acct_type account \"$acct\"."
							 | 
						||
| 
								 | 
							
										    . "<p> $dot_pseudonym is a pseudonym for $acct. </p>",""
							 | 
						||
| 
								 | 
							
										 );
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
									else
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    showInitial ($q,
							 | 
						||
| 
								 | 
							
										    "Error: first and last name details for account"
							 | 
						||
| 
								 | 
							
										    . " \"$acctName\" clash with an existing $type"
							 | 
						||
| 
								 | 
							
										    . " account $dot_pseudonym.",""
							 | 
						||
| 
								 | 
							
										 );
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if (db_get(\%accounts, $underbar_pseudonym))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my $type = db_get_type(\%accounts, $underbar_pseudonym);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									if ($type eq "pseudonym")
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    my $acct = db_get_prop(\%accounts, $underbar_pseudonym, "Account");
							 | 
						||
| 
								 | 
							
									    my $acct_type = db_get_type(\%accounts, $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    showInitial ($q,
							 | 
						||
| 
								 | 
							
										    "Error: first and last name details for account"
							 | 
						||
| 
								 | 
							
										     . " \"$acctName\" clash with pseudonym details for"
							 | 
						||
| 
								 | 
							
										     . " $acct_type account \"$acct\"."
							 | 
						||
| 
								 | 
							
										    . "<p> $underbar_pseudonym is a pseudonym for $acct. </p>",""
							 | 
						||
| 
								 | 
							
										 );
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
									else
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: first and last name details for account"
							 | 
						||
| 
								 | 
							
										     . " \"$acctName\" clash with an existing $type"
							 | 
						||
| 
								 | 
							
										     . " account $underbar_pseudonym.",""
							 | 
						||
| 
								 | 
							
										 );
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $userID = getNextFreeID();
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Account is available! Update accounts database.
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    db_set(\%accounts, $acctName, "user",
							 | 
						||
| 
								 | 
							
									   {
							 | 
						||
| 
								 | 
							
									       'FirstName'       => $firstName,
							 | 
						||
| 
								 | 
							
									       'LastName'        => $lastName,
							 | 
						||
| 
								 | 
							
									       'Phone'           => $phone,
							 | 
						||
| 
								 | 
							
									       'Company'         => $company,
							 | 
						||
| 
								 | 
							
									       'Dept'            => $department,
							 | 
						||
| 
								 | 
							
									       'City'            => $city,
							 | 
						||
| 
								 | 
							
									       'Street'          => $street,
							 | 
						||
| 
								 | 
							
								               'EmailForward'    => $emailForward,
							 | 
						||
| 
								 | 
							
									       'ForwardAddress'  => $forwardAddress,
							 | 
						||
| 
								 | 
							
									       'VPNClientAccess' => $VPNClientAccess,
							 | 
						||
| 
								 | 
							
								               'PasswordSet'     => "no",
							 | 
						||
| 
								 | 
							
								               'Uid'             => $userID,
							 | 
						||
| 
								 | 
							
								               'Gid'             => $userID
							 | 
						||
| 
								 | 
							
									       } );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    db_set(\%accounts, $dot_pseudonym, 'pseudonym', { Account => $acctName } )
							 | 
						||
| 
								 | 
							
								        or die ("Error occurred while creating pseudonym in database.\n");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    db_set(\%accounts, $underbar_pseudonym, 'pseudonym',
							 | 
						||
| 
								 | 
							
									   { Account => $acctName } )
							 | 
						||
| 
								 | 
							
								        or die ("Error occurred while creating pseudonym in database.\n");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Signal the create-user event.
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    untie %accounts;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    system ("/sbin/e-smith/signal-event", "user-create", "$acctName") == 0
							 | 
						||
| 
								 | 
							
									or die ("Error occurred while creating user.\n");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Add user to any relevant groups
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my @groups = $q->param ('groupMemberships');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $group;
							 | 
						||
| 
								 | 
							
								    foreach $group (@groups)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									# untaint group so that we can use it in "system" call later
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									if ($group =~ /^(.*)$/)
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    $group = $1;
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
									else
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    $group = "";
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									db_set_prop(\%accounts, $group, "Members",
							 | 
						||
| 
								 | 
							
									db_get_prop(\%accounts, $group, "Members") . ",$acctName");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									untie %accounts;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									system ("/sbin/e-smith/signal-event", "group-modify", "$group") == 0
							 | 
						||
| 
								 | 
							
									    or warn ("Error occurred while updating group.\n");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    showInitial ($q, "Successfully created user account $acctName.","");
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub modifyUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genHeaderNonCacheable ($q, \%conf, 'Modify user account');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print
							 | 
						||
| 
								 | 
							
									$q->startform (-method => 'POST', -action => $q->url (-absolute => 1));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $acct = $q->param ('acct');
							 | 
						||
| 
								 | 
							
								    my $fGroup = $q->param ('fGroup');
							 | 
						||
| 
								 | 
							
								    db_set(\%conf, 'fGroup', $fGroup);
							 | 
						||
| 
								 | 
							
								    my $acctN = $ENV{'REMOTE_USER'};
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            $q->Tr (esmith::cgi5::genCell ($q, "Account name:"),
							 | 
						||
| 
								 | 
							
										    esmith::cgi5::genCell ($q, $acct)),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
										    "First name",
							 | 
						||
| 
								 | 
							
										    "firstName",
							 | 
						||
| 
								 | 
							
										    db_get_prop(\%accounts, $acct, "FirstName")
							 | 
						||
| 
								 | 
							
										),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
										    "Last name",
							 | 
						||
| 
								 | 
							
										    "lastName",
							 | 
						||
| 
								 | 
							
										    db_get_prop(\%accounts, $acct, "LastName")
							 | 
						||
| 
								 | 
							
										),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
										    "Department",
							 | 
						||
| 
								 | 
							
										    "department",
							 | 
						||
| 
								 | 
							
										    db_get_prop(\%accounts, $acct, "Dept")
							 | 
						||
| 
								 | 
							
										),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
										    "Company",
							 | 
						||
| 
								 | 
							
										    "company",
							 | 
						||
| 
								 | 
							
										    db_get_prop(\%accounts, $acct, "Company")
							 | 
						||
| 
								 | 
							
										),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
										    "Street address",
							 | 
						||
| 
								 | 
							
										    "street",
							 | 
						||
| 
								 | 
							
										    db_get_prop(\%accounts, $acct, "Street")
							 | 
						||
| 
								 | 
							
										),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
										    "City",
							 | 
						||
| 
								 | 
							
										    "city",
							 | 
						||
| 
								 | 
							
										    db_get_prop(\%accounts, $acct, "City")
							 | 
						||
| 
								 | 
							
										),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
										    "Phone number",
							 | 
						||
| 
								 | 
							
										    "phone",
							 | 
						||
| 
								 | 
							
										    db_get_prop(\%accounts, $acct, "Phone")
							 | 
						||
| 
								 | 
							
										),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            $q->Tr (
							 | 
						||
| 
								 | 
							
											esmith::cgi5::genCell ($q, "E-mail delivery:"),
							 | 
						||
| 
								 | 
							
											genEmailForward (
							 | 
						||
| 
								 | 
							
												    $q,
							 | 
						||
| 
								 | 
							
												    db_get_prop(\%accounts,
							 | 
						||
| 
								 | 
							
													$acct, "EmailForward")
							 | 
						||
| 
								 | 
							
												)
							 | 
						||
| 
								 | 
							
										    ),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genNameValueRow ($q,
							 | 
						||
| 
								 | 
							
											"Forwarding address",
							 | 
						||
| 
								 | 
							
											"forwardAddress",
							 | 
						||
| 
								 | 
							
										    db_get_prop(\%accounts, $acct, "ForwardAddress")
							 | 
						||
| 
								 | 
							
										),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        $q->Tr (esmith::cgi5::genWidgetRow ($q, "VPN Client Access",
							 | 
						||
| 
								 | 
							
								            $q->popup_menu (-name    => 'VPNClientAccess',
							 | 
						||
| 
								 | 
							
								                            -values  => ['no','yes'] ,
							 | 
						||
| 
								 | 
							
								                            -default => db_get_prop (\%accounts, $acct, "VPNClientAccess")))),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    #esmith::cgi5::genTextRow ($q,
							 | 
						||
| 
								 | 
							
									    #    $q->p ("This user is in the <b>$fGroup</b> Group.")),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								            esmith::cgi5::genButtonRow ($q,
							 | 
						||
| 
								 | 
							
								                                   $q->submit (-name => 'action',
							 | 
						||
| 
								 | 
							
								                                               -value => 'Modify')));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #print $q->hidden (-name => 'groupMemberships', -override => 1, -default => 'nochange');
							 | 
						||
| 
								 | 
							
								    print $q->hidden (-name => 'fGroup', -override => 1, -default => $fGroup);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->hidden (-name => 'acctName',
							 | 
						||
| 
								 | 
							
											  -override => 1,
							 | 
						||
| 
								 | 
							
											  -default => $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->hidden (-name => 'state',
							 | 
						||
| 
								 | 
							
											  -override => 1,
							 | 
						||
| 
								 | 
							
											  -default => 'performModify');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->endform;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#    print $q->p ($q->hr, $q->font ({size => "-1"}, "www.dungog.net/sme"));
							 | 
						||
| 
								 | 
							
								    esmith::cgi::genFooter($q);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print '</FONT>';
							 | 
						||
| 
								 | 
							
								    print '</DIV>';
							 | 
						||
| 
								 | 
							
								    print $q->end_html;
							 | 
						||
| 
								 | 
							
								    #esmith::cgi5::genFooter ($q);
							 | 
						||
| 
								 | 
							
								    return;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub performModifyUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Validate parameters and untaint them
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $acctName = $q->param ('acctName');
							 | 
						||
| 
								 | 
							
								    if ($acctName =~ /^([a-z][\-\_\.a-z0-9]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $acctName = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										"Error: unexpected characters in account name:"
							 | 
						||
| 
								 | 
							
										. " \"$acctName\". The account name should contain only"
							 | 
						||
| 
								 | 
							
										. " lower-case letters, numbers, hyphens, periods, and"
							 | 
						||
| 
								 | 
							
										. " underscores, and should start with a lower-case"
							 | 
						||
| 
								 | 
							
										. " letter. For example \"betty\", \"hjohnson\", and"
							 | 
						||
| 
								 | 
							
										. " \"john.smith\" are all valid account names, but"
							 | 
						||
| 
								 | 
							
										. " \"3friends\", \"John Smith\" and \"Henry-Miller\""
							 | 
						||
| 
								 | 
							
										. " are not.",""
							 | 
						||
| 
								 | 
							
									    );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Looks good. Make sure this is a valid account
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless (exists $accounts {$acctName})
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
									    "Error: account \"$acctName\" is not an existing account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $firstName = $q->param ('firstName');
							 | 
						||
| 
								 | 
							
								    if ($firstName =~ /^\s*([a-zA-Z0-9\'\.\-\s]+?)\s*$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $firstName = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected or missing characters in first name: " .
							 | 
						||
| 
								 | 
							
								                     "\"$firstName\". Did not modify account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $lastName = $q->param ('lastName');
							 | 
						||
| 
								 | 
							
								    if ($lastName =~ /^\s*([a-zA-Z0-9\'\.\-\s]+?)\s*$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $lastName = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected or missing characters in last name: " .
							 | 
						||
| 
								 | 
							
								                     "\"$lastName\". Did not modify account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $department = $q->param ('department');
							 | 
						||
| 
								 | 
							
								    if ($department =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $department = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected characters in department: " .
							 | 
						||
| 
								 | 
							
								                     "\"$department\". Did not modify account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $company = $q->param ('company');
							 | 
						||
| 
								 | 
							
								    if ($company =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $company = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected characters in company: " .
							 | 
						||
| 
								 | 
							
								                     "\"$company\". Did not modify account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $street = $q->param ('street');
							 | 
						||
| 
								 | 
							
								    if ($street =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $street = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected characters in street address: " .
							 | 
						||
| 
								 | 
							
								                     "\"$street\". Did not modify account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $city = $q->param ('city');
							 | 
						||
| 
								 | 
							
								    if ($city =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $city = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected characters in city: " .
							 | 
						||
| 
								 | 
							
								                     "\"$city\". Did not modify account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $phone = $q->param ('phone');
							 | 
						||
| 
								 | 
							
								    if ($phone =~ /^([^\|]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $phone = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected characters in phone number: " .
							 | 
						||
| 
								 | 
							
								                     "\"$phone\". Did not modify account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $emailForward = $q->param ('emailForward');
							 | 
						||
| 
								 | 
							
								    if ($emailForward =~ /^(.*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$emailForward = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$emailForward = "";
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $VPNClientAccess = $q->param ('VPNClientAccess');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $forwardAddress = $q->param ('forwardAddress');
							 | 
						||
| 
								 | 
							
								    if (($emailForward eq 'local') && ($forwardAddress =~ /^([^\|]*)$/))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $forwardAddress = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    elsif (($emailForward eq 'forward') && ($forwardAddress =~ /^([^\|]+)$/))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $forwardAddress = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    elsif (($emailForward eq 'both') && ($forwardAddress =~ /^([^\|]+)$/))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        $forwardAddress = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial ($q,
							 | 
						||
| 
								 | 
							
								                     "Error: unexpected or missing characters in email forwarding address: " .
							 | 
						||
| 
								 | 
							
								                     "\"$forwardAddress\". Did not create new account.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my ($dot_pseudonym, $underbar_pseudonym)
							 | 
						||
| 
								 | 
							
									= makePseudonyms($firstName, $lastName);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless (db_get_type(\%accounts, $acctName) eq "user")
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial (
							 | 
						||
| 
								 | 
							
										$q,
							 | 
						||
| 
								 | 
							
										"Error: account \"$acctName\" is not an existing user account.",""
							 | 
						||
| 
								 | 
							
									    );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Looks good. Find out if there is a name clash with the pseudonyms.
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if (db_get(\%accounts, $dot_pseudonym))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my $type = db_get_type(\%accounts, $dot_pseudonym);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									if ($type eq "pseudonym")
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    my $acct = db_get_prop(\%accounts, $dot_pseudonym, "Account");
							 | 
						||
| 
								 | 
							
									    my $acct_type = db_get_type(\%accounts, $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    unless ($acct eq $acctName)
							 | 
						||
| 
								 | 
							
									    {
							 | 
						||
| 
								 | 
							
										showInitial ($q,
							 | 
						||
| 
								 | 
							
											"Error: first and last name details for account"
							 | 
						||
| 
								 | 
							
											. " \"$acctName\" clash with pseudonym details for"
							 | 
						||
| 
								 | 
							
											. " $acct_type account \"$acct\"."
							 | 
						||
| 
								 | 
							
											. "<p> $dot_pseudonym is a pseudonym for $acct. </p>",""
							 | 
						||
| 
								 | 
							
										     );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
										return;
							 | 
						||
| 
								 | 
							
									    }
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
									else
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: first and last name details for account"
							 | 
						||
| 
								 | 
							
										     . " \"$acctName\" clash with an existing $type"
							 | 
						||
| 
								 | 
							
										     . " account $dot_pseudonym.",""
							 | 
						||
| 
								 | 
							
										 );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    return;
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if (db_get(\%accounts, $underbar_pseudonym))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my $type = db_get_type(\%accounts, $underbar_pseudonym);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									if ($type eq "pseudonym")
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    my $acct = db_get_prop(\%accounts, $underbar_pseudonym, "Account");
							 | 
						||
| 
								 | 
							
									    my $acct_type = db_get_type(\%accounts, $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    unless ($acct eq $acctName)
							 | 
						||
| 
								 | 
							
									    {
							 | 
						||
| 
								 | 
							
										showInitial ($q,
							 | 
						||
| 
								 | 
							
											"Error: first and last name details for account"
							 | 
						||
| 
								 | 
							
											. " \"$acctName\" clash with pseudonym details for"
							 | 
						||
| 
								 | 
							
											. " $acct_type account \"$acct\"."
							 | 
						||
| 
								 | 
							
											. "<p> $underbar_pseudonym is a"
							 | 
						||
| 
								 | 
							
											. " pseudonym for $acct. </p>",""
							 | 
						||
| 
								 | 
							
										     );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
										return;
							 | 
						||
| 
								 | 
							
									    }
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
									else
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    showInitial ($q,
							 | 
						||
| 
								 | 
							
										     "Error: first and last name details for account"
							 | 
						||
| 
								 | 
							
										     . " \"$acctName\" clash with an existing $type"
							 | 
						||
| 
								 | 
							
										     . " account $underbar_pseudonym.",""
							 | 
						||
| 
								 | 
							
										 );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    return;
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Update accounts database and signal the user-modify event.
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    # First we need to remember the old first.last and first_last pseudonyms
							 | 
						||
| 
								 | 
							
								    # for this user.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my ($old_dot_pseudonym, $old_underbar_pseudonym) =
							 | 
						||
| 
								 | 
							
									makePseudonyms(
							 | 
						||
| 
								 | 
							
										db_get_prop(\%accounts, $acctName, 'FirstName'),
							 | 
						||
| 
								 | 
							
										db_get_prop(\%accounts, $acctName, 'LastName'),
							 | 
						||
| 
								 | 
							
									    );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Now we can update the user and the pseudonyms
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my ($acctType, %oldProperties) = db_get(\%accounts, $acctName);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my %newProperties =
							 | 
						||
| 
								 | 
							
								    (
							 | 
						||
| 
								 | 
							
									 'FirstName'       => $firstName,
							 | 
						||
| 
								 | 
							
									 'LastName'        => $lastName,
							 | 
						||
| 
								 | 
							
									 'Phone'           => $phone,
							 | 
						||
| 
								 | 
							
									 'Company'         => $company,
							 | 
						||
| 
								 | 
							
									 'Dept'            => $department,
							 | 
						||
| 
								 | 
							
									 'City'            => $city,
							 | 
						||
| 
								 | 
							
									 'Street'          => $street,
							 | 
						||
| 
								 | 
							
									 'EmailForward'    => $emailForward,
							 | 
						||
| 
								 | 
							
									 'ForwardAddress'  => $forwardAddress,
							 | 
						||
| 
								 | 
							
									 'VPNClientAccess' => $VPNClientAccess,
							 | 
						||
| 
								 | 
							
								     );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    db_set(\%accounts, $acctName, "user", { %oldProperties, %newProperties } );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless ( $old_dot_pseudonym eq $dot_pseudonym )
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									db_delete(\%accounts, $old_dot_pseudonym);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									db_set(\%accounts, $dot_pseudonym, 'pseudonym',
							 | 
						||
| 
								 | 
							
									       { Account => $acctName } )
							 | 
						||
| 
								 | 
							
									    or die ("Error occurred while creating pseudonym in database.\n");
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless ( $old_underbar_pseudonym eq $underbar_pseudonym )
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									db_delete(\%accounts, $old_underbar_pseudonym);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									db_set(\%accounts, $underbar_pseudonym, 'pseudonym',
							 | 
						||
| 
								 | 
							
									       { Account => $acctName } )
							 | 
						||
| 
								 | 
							
									    or die ("Error occurred while creating pseudonym in database.\n");
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    untie %accounts;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    system ("/sbin/e-smith/signal-event", "user-modify", "$acctName") == 0
							 | 
						||
| 
								 | 
							
								        or die ("Error occurred while modifying user.\n");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genHeaderNonCacheable ($q, \%conf, "Operation status report.");
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genResult ($q, "Successfully modified user account $acctName. <a href=userpanel-useraccounts>refresh</a>");
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub deleteUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								    my $fGroup = $q->param ('fGroup');
							 | 
						||
| 
								 | 
							
								    db_set(\%conf, 'fGroup', $fGroup);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genHeaderNonCacheable ($q, \%conf, 'Remove user account');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->startform
							 | 
						||
| 
								 | 
							
									(-method => 'POST', -action => $q->url (-absolute => 1));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $acct = $q->param ('acct');
							 | 
						||
| 
								 | 
							
								    my $value = $accounts {$acct};
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($value)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my ($type, %properties) = split (/\|/, $value, -1);
							 | 
						||
| 
								 | 
							
									my $name = $properties {'FirstName'} . ' ' . $properties {'LastName'};
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->p ('You are about to remove the user account "'
							 | 
						||
| 
								 | 
							
										     . $acct
							 | 
						||
| 
								 | 
							
										     . '" (user name "' . $name . '").');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->p ('All files belonging to this user account will be',
							 | 
						||
| 
								 | 
							
										     'deleted. Also, any e-mail for this user account still',
							 | 
						||
| 
								 | 
							
										     'remaining on the server (i.e. that has not yet been',
							 | 
						||
| 
								 | 
							
										     'retrieved by the user) will be discarded.');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->p ($q->b ('Are you sure you wish to remove this account?'));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->submit (-name => 'action', -value => 'Remove');
							 | 
						||
| 
								 | 
							
									print $q->hidden (-name => 'acct', -override => 1, -default => $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->hidden (-name	    => 'state',
							 | 
						||
| 
								 | 
							
											  -override => 1,
							 | 
						||
| 
								 | 
							
											  -default  => 'performDelete');
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->endform;
							 | 
						||
| 
								 | 
							
								    esmith::cgi::genFooter($q);
							 | 
						||
| 
								 | 
							
								    return;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub performDeleteUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Attempt to delete user
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $acct = $q->param ('acct');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($acct =~ /^([a-z][\-\_\.a-z0-9]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$acct = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										     'Error: internal failure while removing account "' .
							 | 
						||
| 
								 | 
							
										     $acct . '".',"");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless (db_get_type(\%accounts, $acct) eq "user")
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								        showInitial (
							 | 
						||
| 
								 | 
							
										$q,
							 | 
						||
| 
								 | 
							
										"Error: account \"$acct\" is not an existing user account." ,""
							 | 
						||
| 
								 | 
							
									    );
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    db_set_type(\%accounts, $acct, "user-deleted");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # First, find all "group" entries in the e-smith accounts database
							 | 
						||
| 
								 | 
							
								    # that contain this user.
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $key;
							 | 
						||
| 
								 | 
							
								    my $value;
							 | 
						||
| 
								 | 
							
								    my @groups = ();
							 | 
						||
| 
								 | 
							
								    while (($key,$value) = each %accounts)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my ($type, %properties) = split (/\|/, $value, -1);
							 | 
						||
| 
								 | 
							
									if ($type eq 'group')
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    #--------------------------------------------------
							 | 
						||
| 
								 | 
							
									    # Get a list of members and count the number of
							 | 
						||
| 
								 | 
							
									    # occurrences of this username. If greater than zero,
							 | 
						||
| 
								 | 
							
									    # add this group to the list.
							 | 
						||
| 
								 | 
							
									    #--------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    my $count = grep (/^$acct$/, split (/,/, $properties {'Members'}));
							 | 
						||
| 
								 | 
							
									    if ($count > 0)
							 | 
						||
| 
								 | 
							
									    {
							 | 
						||
| 
								 | 
							
										push (@groups, $key);
							 | 
						||
| 
								 | 
							
									    }
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Next, for each group remove this user from the members list.
							 | 
						||
| 
								 | 
							
								    # Then signal the group-modify event so that the group is brought
							 | 
						||
| 
								 | 
							
								    # up to date. Make sure each group has at least one member; if
							 | 
						||
| 
								 | 
							
								    # the list is empty, add in user "admin".
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $group;
							 | 
						||
| 
								 | 
							
								    foreach $group (@groups)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my $value = $accounts {$group};
							 | 
						||
| 
								 | 
							
									my ($type, %properties) = split (/\|/, $value, -1);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									my @members = split (/,/, $properties {'Members'});
							 | 
						||
| 
								 | 
							
									@members = grep (!/^$acct$/, @members);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									my $count = @members;
							 | 
						||
| 
								 | 
							
									if ($count == 0)
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    @members = ('admin');
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									$properties{'Members'} = join(',', @members);
							 | 
						||
| 
								 | 
							
									$accounts {$group} = "group|" . join ('|', %properties);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        system ("/sbin/e-smith/signal-event", "group-modify", "$group") == 0
							 | 
						||
| 
								 | 
							
									    or warn ("Error occurred while updating group.\n");
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Remove any pseudonyms associated with this user
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    foreach (db_get(\%accounts))
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									if (db_get_type(\%accounts, $_) eq "pseudonym")
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									    if (db_get_prop(\%accounts, $_, "Account") eq $acct)
							 | 
						||
| 
								 | 
							
									    {
							 | 
						||
| 
								 | 
							
										db_delete(\%accounts, $_);
							 | 
						||
| 
								 | 
							
									    }
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Finally signal user-delete event
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    untie %accounts;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    system ("/sbin/e-smith/signal-event", "user-delete", "$acct");# == 0
							 | 
						||
| 
								 | 
							
									#gives error, dunno why ?
							 | 
						||
| 
								 | 
							
									#or die ("Error occurred while deleting user.\n");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    delete $accounts {$acct};
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    showInitial ($q, "Successfully deleted user account $acct.","");
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub passwdUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $fGroup = $q->param ('fGroup');
							 | 
						||
| 
								 | 
							
								    db_set(\%conf, 'fGroup', $fGroup);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genHeaderNonCacheable ($q, \%conf, 'Reset password for user account');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->startform
							 | 
						||
| 
								 | 
							
									(-method => 'POST', -action => $q->url (-absolute => 1));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $acct = $q->param ('acct');
							 | 
						||
| 
								 | 
							
								    my $value = $accounts {$acct};
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($value)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									my ($type, %properties) = split (/\|/, $value, -1);
							 | 
						||
| 
								 | 
							
									my $name = $properties {'FirstName'} . ' ' . $properties {'LastName'};
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    esmith::cgi5::genTextRow ($q,
							 | 
						||
| 
								 | 
							
										$q->p ('You are about to change the password for the user',
							 | 
						||
| 
								 | 
							
										       "account \"$acct\" (user name \"$name\").")),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    esmith::cgi5::genNamePasswdRow ($q,
							 | 
						||
| 
								 | 
							
													   "New password",
							 | 
						||
| 
								 | 
							
													   "newPass",
							 | 
						||
| 
								 | 
							
													   ""),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    esmith::cgi5::genNamePasswdRow ($q,
							 | 
						||
| 
								 | 
							
													   "New password (verify)",
							 | 
						||
| 
								 | 
							
													   "newPassVerify",
							 | 
						||
| 
								 | 
							
													   ""),
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									    esmith::cgi5::genButtonRow ($q,
							 | 
						||
| 
								 | 
							
												       $q->submit (-name => 'action',
							 | 
						||
| 
								 | 
							
														   -value => 'Change')));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->hidden (-name => 'acct',
							 | 
						||
| 
								 | 
							
											  -override => 1,
							 | 
						||
| 
								 | 
							
											  -default => $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									print $q->hidden (-name => 'state',
							 | 
						||
| 
								 | 
							
											  -override => 1,
							 | 
						||
| 
								 | 
							
											  -default => 'performPasswd');
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->endform;
							 | 
						||
| 
								 | 
							
								    esmith::cgi::genFooter($q);
							 | 
						||
| 
								 | 
							
								    return;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# Attempt to change user password
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub performPasswdUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								    my $acct          = $q->param ('acct') || "1" ;
							 | 
						||
| 
								 | 
							
								    my $newPass       = $q->param ('newPass')  || "3";
							 | 
						||
| 
								 | 
							
								    my $newPassVerify = $q->param ('newPassVerify')  || "4";
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($acct =~ /^([a-z][\-\_\.a-z0-9]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      $acct = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      showInitial ($q, 'Error: invalid account "' . $acct . '".',"");
							 | 
						||
| 
								 | 
							
								      return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #verify data entry
							 | 
						||
| 
								 | 
							
								    if ($newPass =~ /^([ -~]+)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      $newPass = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      showInitial ($q, 'Error: new password must contain only printable characters.',"");
							 | 
						||
| 
								 | 
							
								      return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($newPassVerify =~ /^([ -~]+)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      $newPassVerify = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      showInitial ($q, 'Error: duplicate password must contain only printable characters.',"");
							 | 
						||
| 
								 | 
							
								      return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($newPass ne $newPassVerify)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
								      showInitial ($q, "Error: passwords are not identical.","");
							 | 
						||
| 
								 | 
							
								      return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $usermode = db_get_prop(\%conf,"passwordstrength", "Users") ||'';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $test = &validate_password($usermode,$newPass);
							 | 
						||
| 
								 | 
							
								    if ($test ne 'OK')
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q, "Error: Sorry the password is not good because $test.","");
							 | 
						||
| 
								 | 
							
								        return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::util::setUserPassword ($acct, $newPass);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # update the user's PasswordSet field in the accounts database
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $value = $accounts {$acct};
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my ($type, %properties) = split (/\|/, $value, -1);
							 | 
						||
| 
								 | 
							
								    $properties {'PasswordSet'} = 'yes';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    $accounts {$acct} = "user|" . join('|', %properties);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    system("/sbin/e-smith/signal-event", "password-modify", "${acct}") == 0
							 | 
						||
| 
								 | 
							
								        or die ("Error occurred while modifying password for ${acct}.\n");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    showInitial ($q, "Successfully changed password for user account $acct.","");
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# lock user
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub lockUser ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $acct = $q->param ('acct');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $fGroup = $q->param ('fGroup');
							 | 
						||
| 
								 | 
							
								    db_set(\%conf, 'fGroup', $fGroup);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($acct =~ /^([a-z][\-\_\.a-z0-9]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$acct = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										'Error: internal failure while locking account "' .
							 | 
						||
| 
								 | 
							
										$acct . '".',"");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my ($type, %properties) = db_get(\%accounts, $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless (defined $type)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										"There is no user account called \"$acct\".","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless ($type eq "user")
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										"Account \"$acct\" is of type \"$type\", not \"user\".","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genHeaderNonCacheable ($q, \%conf, 'Lock user account verify');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->startform
							 | 
						||
| 
								 | 
							
									(-method => 'POST', -action => $q->url (-absolute => 1));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $name = $properties {'FirstName'} . ' ' . $properties {'LastName'};
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->p ('You are about to remove the user account "'
							 | 
						||
| 
								 | 
							
										     . $acct
							 | 
						||
| 
								 | 
							
										     . '" (user name "' . $name . '").');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->p ('This user account will be locked. This means that this',
							 | 
						||
| 
								 | 
							
								                    'user will not be able to log in, and will not be able',
							 | 
						||
| 
								 | 
							
								                    'to collect e-mail. Any e-mail arriving will still be',
							 | 
						||
| 
								 | 
							
								                    'stored and/or forwarded to an external e-mail',
							 | 
						||
| 
								 | 
							
								                    'address, as configured. The account may be activated',
							 | 
						||
| 
								 | 
							
								                    'in the future by setting a new password. The current',
							 | 
						||
| 
								 | 
							
								                    'password will not be retained.');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->p ($q->b ('Are you sure you wish to lock this account?'));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->submit (-name => 'action', -value => 'Lock');
							 | 
						||
| 
								 | 
							
								    print $q->hidden (-name => 'acct', -override => 1, -default => $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->hidden (-name	    => 'state',
							 | 
						||
| 
								 | 
							
										      -override => 1,
							 | 
						||
| 
								 | 
							
										      -default  => 'performLock');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->endform;
							 | 
						||
| 
								 | 
							
								    esmith::cgi::genFooter($q);
							 | 
						||
| 
								 | 
							
								    return;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								#
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub performlockUser($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Attempt to lock user account
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $acct = $q->param ('acct');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    if ($acct =~ /^([a-z][\-\_\.a-z0-9]*)$/)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									$acct = $1;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    else
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										'Error: internal failure while locking account "' .
							 | 
						||
| 
								 | 
							
										$acct . '".',"");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $type = db_get_type(\%accounts, $acct);
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    unless (defined $type)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										"There is no user account called \"$acct\".","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								    unless ($type eq "user")
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									showInitial ($q,
							 | 
						||
| 
								 | 
							
										"Account \"$acct\" is of type \"$type\", not \"user\".","");
							 | 
						||
| 
								 | 
							
									return;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    untie %accounts;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    system("/sbin/e-smith/signal-event", "user-lock", "${acct}") == 0
							 | 
						||
| 
								 | 
							
								        or die ("Error occurred while locking account ${acct}.\n");
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    showInitial ($q, "Successfully locked account $acct.","");
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub makePseudonyms ($$)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								    # Generate First.Last and First_Last pseudonyms
							 | 
						||
| 
								 | 
							
								    #------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my ($firstName, $lastName) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $dot_pseudonym = "$firstName $lastName";
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    $dot_pseudonym =~ s/^\s+//;		# Strip leading whitespace
							 | 
						||
| 
								 | 
							
								    $dot_pseudonym =~ s/\s+$//;		# Strip trailing whitespace
							 | 
						||
| 
								 | 
							
								    $dot_pseudonym =~ s/\s+/ /g;	# Multiple spaces become single spaces
							 | 
						||
| 
								 | 
							
								    $dot_pseudonym =~ s/\s/./g;		# Change all spaces to dots
							 | 
						||
| 
								 | 
							
								    $dot_pseudonym = lc $dot_pseudonym;	# Change to lower case
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $underbar_pseudonym = $dot_pseudonym;
							 | 
						||
| 
								 | 
							
								    $underbar_pseudonym =~ s/\./_/g;	# Change dots to underbars
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    return ($dot_pseudonym, $underbar_pseudonym);
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub getNextFreeID
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my %id;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $minid = $conf{'MinUid'};
							 | 
						||
| 
								 | 
							
								    $minid = 5000 unless $minid;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $maxid = 1 << 31;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    # Take note of all the used uids and gids from the passwd entries
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    while ((undef, undef, my $uid, my $gid) = getpwent)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									++$id{$uid} if ($uid > $minid);
							 | 
						||
| 
								 | 
							
									++$id{$gid} if ($gid > $minid);
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    # Take note of all the used gids from the group entries
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    while ((undef, undef, my $gid) = getgrent)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									++$id{$gid} if ($gid > $minid);
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    # Find the first free id
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    my $count = $minid + 1;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    while ($count < $maxid)
							 | 
						||
| 
								 | 
							
								    {
							 | 
						||
| 
								 | 
							
									return $count
							 | 
						||
| 
								 | 
							
									    unless (exists $id{$count});
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									++$count;
							 | 
						||
| 
								 | 
							
								    }
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub performSelect ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								    my $swap = $q->param ('swap');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    showInitial ($q, "Group switched to $swap" ,"$swap");
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								# Function to validate password with cracklib added by Lorenzo
							 | 
						||
| 
								 | 
							
								#------------------------------------------------------------
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub validate_password
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								  my ($strength,$pass) = @_;
							 | 
						||
| 
								 | 
							
								  my $reason = "Software error: password check failed";
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								  if ($strength eq 'strong')
							 | 
						||
| 
								 | 
							
								        {
							 | 
						||
| 
								 | 
							
								                 $reason = fascist_check($pass, '/usr/lib/cracklib_dict') if ( -e '/usr/lib/cracklib_dict.pwd');
							 | 
						||
| 
								 | 
							
								                 $reason = fascist_check($pass, '/usr/lib64/cracklib_dict') if ( -e '/usr/lib64/cracklib_dict.pwd');
							 | 
						||
| 
								 | 
							
								        }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									elsif (($strength eq "none") || ($strength eq "normal"))
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									   $reason = 'OK';
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
									if ($reason eq 'ok' || $reason eq 'OK')
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
										 return('OK');
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
									else
							 | 
						||
| 
								 | 
							
									{
							 | 
						||
| 
								 | 
							
									   return $reason;
							 | 
						||
| 
								 | 
							
									}
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								sub showHelp ($)
							 | 
						||
| 
								 | 
							
								{
							 | 
						||
| 
								 | 
							
								    my ($q) = @_;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    esmith::cgi5::genHeaderNonCacheable
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        ($q, \%conf, 'User Account Help');
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->startform (-method => 'POST',
							 | 
						||
| 
								 | 
							
								                         -action => $q->url (-absolute => 1));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								        esmith::cgi5::genTextRow ($q, $q->p ('<pre>
							 | 
						||
| 
								 | 
							
								* <a href="#group">Groups</a>
							 | 
						||
| 
								 | 
							
								* <a href="#limit">Limits</a>
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								<a name="group"><h3>Groups</h3></a>
							 | 
						||
| 
								 | 
							
								<b>Create users in a selected groups</b>
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								Users will be created in the active group.
							 | 
						||
| 
								 | 
							
								The active groups can be toggled from the available groups that are listed.
							 | 
						||
| 
								 | 
							
								If you are only in one group this option is not displayed.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								<a name="limit"><h3>Limits</h3></a>
							 | 
						||
| 
								 | 
							
								<b>Limits to the number of users that can be created</b>
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								Admin may place limits on the numbers of users that may be created
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								 /sbin/e-smith/db accounts setprop groupLimit support 15
							 | 
						||
| 
								 | 
							
								   setting the group support to a limit of 15 users
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								 /sbin/e-smith/db accounts get groupLimit
							 | 
						||
| 
								 | 
							
								   displays current values > setting|support|15|spare|5
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								</pre>   ')));
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								    print $q->endform;
							 | 
						||
| 
								 | 
							
								#    print $q->p ($q->hr, $q->font ({size => "-1"}, "www.dungog.net/sme ",
							 | 
						||
| 
								 | 
							
								    esmith::cgi::genFooter($q);
							 | 
						||
| 
								 | 
							
								    return;
							 | 
						||
| 
								 | 
							
								}
							 | 
						||
| 
								 | 
							
								
							 |