Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 10010

1
#!/usr/bin/perl -w
2
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California 
5
#
6
#   '$Author: cjones $'
7
#     '$Date: 2016-10-17 11:54:38 -0700 (Mon, 17 Oct 2016) $'
8
# '$Revision: 10010 $' 
9
# 
10
# This program is free software; you can redistribute it and/or modify
11
# it under the terms of the GNU General Public License as published by
12
# the Free Software Foundation; either version 2 of the License, or
13
# (at your option) any later version.
14
#
15
# This program is distributed in the hope that it will be useful,
16
# but WITHOUT ANY WARRANTY; without even the implied warranty of
17
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
# GNU General Public License for more details.
19
#
20
# You should have received a copy of the GNU General Public License
21
# along with this program; if not, write to the Free Software
22
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
23
#
24

    
25
#
26
# This is a web-based application for allowing users to register a new
27
# account for Metacat access.  We currently only support LDAP even
28
# though metacat could potentially support other types of directories.
29

    
30
use lib '../WEB-INF/lib';
31
use strict;             # turn on strict syntax checking
32
use Template;           # load the template-toolkit module
33
use CGI qw/:standard :html3/; # load the CGI module 
34
use Net::LDAP;          # load the LDAP net libraries
35
use Net::SMTP;          # load the SMTP net libraries
36
use Digest::SHA1;       # for creating the password hash
37
use MIME::Base64;       # for creating the password hash
38
use URI;                # for parsing URL syntax
39
use Config::Properties; # for parsing Java .properties files
40
use File::Basename;     # for path name parsing
41
use DateTime;			# for parsing dates
42
use DateTime::Duration; # for substracting
43
use Captcha::reCAPTCHA; # for protection against spams
44
use Cwd 'abs_path';
45
use Scalar::Util qw(looks_like_number);
46

    
47
# Global configuration paramters
48
# This entire block (including skin parsing) could be pushed out to a separate .pm file
49
my $cgiUrl = $ENV{'SCRIPT_FILENAME'};
50
my $workingDirectory = dirname($cgiUrl);
51
my $metacatProps = "${workingDirectory}/../WEB-INF/metacat.properties";
52
my $properties = new Config::Properties();
53
unless (open (METACAT_PROPERTIES, $metacatProps)) {
54
    print "Content-type: text/html\n\n";
55
    print "Unable to locate Metacat properties. Working directory is set as " . 
56
        $workingDirectory .", is this correct?";
57
    exit(0);
58
}
59

    
60
$properties->load(*METACAT_PROPERTIES);
61

    
62
# local directory configuration
63
my $skinsDir = "${workingDirectory}/../style/skins";
64
my $templatesDir = abs_path("${workingDirectory}/../style/common/templates");
65
my $tempDir = $properties->getProperty('application.tempDir');
66

    
67
# url configuration
68
my $server = $properties->splitToTree(qr/\./, 'server');
69
my $protocol = 'http://';
70
if ( $properties->getProperty('server.httpPort') eq '443' ) {
71
	$protocol = 'https://';
72
}
73
my $serverUrl = $protocol . $properties->getProperty('server.name');
74
if ($properties->getProperty('server.httpPort') ne '80') {
75
        $serverUrl = $serverUrl . ':' . $properties->getProperty('server.httpPort');
76
}
77
my $context = $properties->getProperty('application.context');
78
my $contextUrl = $serverUrl . '/' .  $context;
79

    
80
my $metacatUrl = $contextUrl . "/metacat";
81
my $cgiPrefix = "/" . $context . "/cgi-bin";
82
my $styleSkinsPath = $contextUrl . "/style/skins";
83
my $styleCommonPath = $contextUrl . "/style/common";
84
my $caCertFileProp = $properties->getProperty('ldap.server.ca.certificate');
85
my $ldapServerCACertFile;
86
if ($caCertFileProp eq "") {
87
   $ldapServerCACertFile = "/etc/ssl/certs/ca-certificates.crt";
88
   debug("Metacat doesn't specify the ca file, we use the default one " . $ldapServerCACertFile);
89
} else {
90
   $ldapServerCACertFile = $workingDirectory. "/../" . $properties->getProperty('ldap.server.ca.certificate');
91
   debug("Metacat does specify the ca file, we will use it - " . $ldapServerCACertFile);
92
}
93

    
94

    
95
#recaptcha key information
96
my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');
97
my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');
98

    
99
my @errorMessages;
100
my $error = 0;
101

    
102
my $emailVerification= 'emailverification';
103

    
104
 my $dn_store_next_uid=$properties->getProperty('ldap.nextuid.storing.dn');
105
 my $attribute_name_store_next_uid = $properties->getProperty('ldap.nextuid.storing.attributename');
106

    
107
# Import all of the HTML form fields as variables
108
import_names('FORM');
109

    
110
# Must have a config to use Metacat
111
my $skinName = "";
112
if ($FORM::cfg) {
113
    $skinName = $FORM::cfg;
114
} elsif ($ARGV[0]) {
115
    $skinName = $ARGV[0];
116
} else {
117
    debug("No configuration set.");
118
    print "Content-type: text/html\n\n";
119
    print 'LDAPweb Error: The registry requires a skin name to continue.';
120
    exit();
121
}
122

    
123
# Metacat isn't initialized, the registry will fail in strange ways.
124
if (!($metacatUrl)) {
125
    debug("No Metacat.");
126
    print "Content-type: text/html\n\n";
127
    'Registry Error: Metacat is not initialized! Make sure' .
128
        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';
129
    exit();
130
}
131

    
132
my $skinProperties = new Config::Properties();
133
if (!($skinName)) {
134
    $error = "Application misconfigured.  Please contact the administrator.";
135
    push(@errorMessages, $error);
136
} else {
137
    my $skinProps = "$skinsDir/$skinName/$skinName.properties";
138
    unless (open (SKIN_PROPERTIES, $skinProps)) {
139
        print "Content-type: text/html\n\n";
140
        print "Unable to locate skin properties at $skinProps.  Is this path correct?";
141
        exit(0);
142
    }
143
    $skinProperties->load(*SKIN_PROPERTIES);
144
}
145

    
146
my $config = $skinProperties->splitToTree(qr/\./, 'registry.config');
147

    
148
# XXX HACK: this is a temporary fix to pull out the UCNRS password property from the
149
#           NRS skin instead of metacat.properties. The intent is to prevent editing
150
#           of our core properties file, which is manipulated purely through the web.
151
#           Once organizations are editable, this section should be removed as should
152
#           the properties within nrs/nrs.properties.
153
my $nrsProperties = new Config::Properties();
154
my $nrsProps = "$skinsDir/nrs/nrs.properties";
155
unless (open (NRS_PROPERTIES, $nrsProps)) {
156
    print "Content-type: text/html\n\n";
157
    print "Unable to locate skin properties at $nrsProps.  Is this path correct?";
158
    exit(0);
159
}
160
$nrsProperties->load(*NRS_PROPERTIES);
161

    
162
my $nrsConfig = $nrsProperties->splitToTree(qr/\./, 'registry.config');
163

    
164
# XXX END HACK
165

    
166

    
167
my $searchBase;
168
my $ldapUsername;
169
my $ldapPassword;
170
# TODO: when should we use surl instead? Is there a setting promoting one over the other?
171
# TODO: the default tree for accounts should be exposed somewhere, defaulting to unaffiliated
172
my $ldapurl = $properties->getProperty('auth.url');
173

    
174
# Java uses miliseconds, Perl expects whole seconds
175
my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;
176

    
177
# Get the CGI input variables
178
my $query = new CGI;
179
my $debug = 1;
180

    
181
#--------------------------------------------------------------------------80c->
182
# Set up the Template Toolkit to read html form templates
183

    
184
# templates hash, imported from ldap.templates tree in metacat.properties
185
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
186
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
187
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
188

    
189
# set some configuration options for the template object
190
my $ttConfig = {
191
             INCLUDE_PATH => $templatesDir,
192
             INTERPOLATE  => 0,
193
             POST_CHOMP   => 1,
194
             DEBUG        => 1, 
195
             };
196

    
197
# create an instance of the template
198
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
199

    
200
# custom LDAP properties hash
201
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
202

    
203
# This is a hash which has the keys of the organization's properties 'name', 'base', 'organization'.
204
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
205

    
206
#This is a hash which has the keys of the ldap sub tree names of the organizations, such as 'NCEAS', 'LTER' and 'KU', and values are real name of the organization.
207
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
208
# pull out properties available e.g. 'name', 'base'
209
my @orgData = keys(%$orgProps);
210

    
211
my @orgList; #An array has the names (i.e, sub tree names, such as 'NCEAS', 'LTER' and 'KU')  of the all organizations in the metacat.properties. 
212
while (my ($oKey, $oVal) = each(%$orgNames)) {
213
    push(@orgList, $oKey);
214
}
215

    
216
my $authBase = $properties->getProperty("auth.base");
217
my $ldapConfig;
218
foreach my $o (@orgList) {
219
    foreach my $d (@orgData) {
220
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
221
    }
222

    
223
    # XXX hack, remove after 1.9
224
    if ($o eq 'UCNRS') {
225
        $ldapConfig->{'UCNRS'}{'base'} = $nrsConfig->{'base'};
226
        $ldapConfig->{'UCNRS'}{'user'} = $nrsConfig->{'username'};
227
        $ldapConfig->{'UCNRS'}{'password'} = $nrsConfig->{'password'};
228
    }
229

    
230
    # set default base
231
    if (!$ldapConfig->{$o}{'base'}) {
232
        $ldapConfig->{$o}{'base'} = $authBase;
233
    }
234

    
235
    # include filter information. By default, our filters are 'o=$name', e.g. 'o=NAPIER'
236
    # these can be overridden by specifying them in metacat.properties. Non-default configs
237
    # such as UCNRS must specify all LDAP properties.
238
    if ($ldapConfig->{$o}{'base'} eq $authBase) {
239
        my $filter = "o=$o";
240
        if (!$ldapConfig->{$o}{'org'}) {
241
            $ldapConfig->{$o}{'org'} = $filter;
242
        }
243
        if (!$ldapConfig->{$o}{'filter'}) {
244
            #$ldapConfig->{$o}{'filter'} = $filter;
245
            $ldapConfig->{$o}{'filter'} = $ldapConfig->{$o}{'org'};
246
        }
247
        # also include DN, which is just org + base
248
        if ($ldapConfig->{$o}{'org'}) {
249
            $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'org'} . "," . $ldapConfig->{$o}{'base'};
250
        }
251
    } else {
252
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
253
    }
254
    
255
    # set LDAP administrator user account
256
    if (!$ldapConfig->{$o}{'user'}) {
257
        $ldapConfig->{$o}{'user'} = $ldapConfig->{'unaffiliated'}{'user'};
258
    }
259
    # check for a fully qualified LDAP name. If it doesn't exist, append base.
260
    my @userParts = split(',', $ldapConfig->{$o}{'user'});
261
    if (scalar(@userParts) == 1) {
262
        $ldapConfig->{$o}{'user'} = $ldapConfig->{$o}{'user'} . "," . $ldapConfig->{$o}{'base'};
263
    }
264

    
265
    if (!$ldapConfig->{$o}{'password'}) {
266
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
267
    }
268
}
269

    
270
### Determine the display organization list (such as NCEAS, Account ) in the ldap template files
271
my $displayOrgListStr;
272
$displayOrgListStr = $skinProperties->getProperty("ldap.templates.organizationList") or $displayOrgListStr = $properties->getProperty('ldap.templates.organizationList');
273
debug("the string of the org from properties : " . $displayOrgListStr);
274
my @displayOrgList = split(';', $displayOrgListStr);
275

    
276
my @validDisplayOrgList; #this array contains the org list which will be shown in the templates files.
277

    
278
my %orgNamesHash = %$orgNames;
279
foreach my $element (@displayOrgList) {
280
    if(exists $orgNamesHash{$element}) {
281
         my $label = $ldapConfig->{$element}{'label'};
282
         my %displayHash;
283
         $displayHash{$element} = $label;
284
         debug("push a hash containing the key " . $element . "with the value label" . $label . " into the display array");
285
         #if the name is found in the organization part of metacat.properties, put it into the valid array
286
         push(@validDisplayOrgList, \%displayHash);
287
    } 
288
    
289
}
290

    
291
if(!@validDisplayOrgList) {
292
     my $sender;
293
     my $contact;
294
     $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
295
     $contact = $skinProperties->getProperty("email.contact") or $contact = $properties->getProperty('email.contact');
296
    print "Content-type: text/html\n\n";
297
    print "The value of property ldap.templates.organizationList in " 
298
     . $skinName . ".properties file or metacat.properties file (if the property doesn't exist in the " 
299
     . $skinName . ".properties file) is invalid. Please send the information to ". $contact;
300
    exit(0);
301
}
302

    
303

    
304
#--------------------------------------------------------------------------80c->
305
# Define the main program logic that calls subroutines to do the work
306
#--------------------------------------------------------------------------80c->
307

    
308
# The processing step we are handling
309
my $stage = $query->param('stage') || $templates->{'stage'};
310

    
311
my $cfg = $query->param('cfg');
312
debug("started with stage $stage, cfg $cfg");
313

    
314
# define the possible stages
315
my %stages = (
316
              'initregister'      => \&handleInitRegister,
317
              'register'          => \&handleRegister,
318
              'registerconfirmed' => \&handleRegisterConfirmed,
319
              'simplesearch'      => \&handleSimpleSearch,
320
              'initaddentry'      => \&handleInitAddEntry,
321
              'addentry'          => \&handleAddEntry,
322
              'initmodifyentry'   => \&handleInitModifyEntry,
323
              'modifyentry'       => \&handleModifyEntry,
324
              'changepass'        => \&handleChangePassword,
325
              'initchangepass'    => \&handleInitialChangePassword,
326
              'resetpass'         => \&handleResetPassword,
327
              'initresetpass'     => \&handleInitialResetPassword,
328
              'emailverification' => \&handleEmailVerification,
329
              'lookupname'        => \&handleLookupName,
330
              'searchnamesbyemail'=> \&handleSearchNameByEmail,
331
              #'getnextuid'        => \&getExistingHighestUidNum,
332
             );
333

    
334
# call the appropriate routine based on the stage
335
if ( $stages{$stage} ) {
336
  $stages{$stage}->();
337
} else {
338
  &handleResponseMessage();
339
}
340

    
341
#--------------------------------------------------------------------------80c->
342
# Define the subroutines to do the work
343
#--------------------------------------------------------------------------80c->
344

    
345
sub clearTemporaryAccounts {
346
	
347
    #search accounts that have expired
348
	my $org = $query->param('o'); 
349
    my $ldapUsername = $ldapConfig->{$org}{'user'};
350
    my $ldapPassword = $ldapConfig->{$org}{'password'};
351
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
352
    my $orgExpiration = $ldapConfig->{$org}{'expiration'};
353
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
354
	
355
	my $dt = DateTime->now;
356
	$dt->subtract( hours => $orgExpiration );
357
	my $expirationDate = $dt->ymd("") . $dt->hms("") . "Z";
358
    my $filter = "(&(objectClass=inetOrgPerson)(createTimestamp<=" . $expirationDate . "))";
359
    debug("Clearing expired accounts with filter: " . $filter . ", base: " . $tmpSearchBase);    
360
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
361

    
362
    my $ldap;
363
    my $mesg;
364
    
365
    my $dn;
366

    
367
    #if main ldap server is down, a html file containing warning message will be returned
368
    debug("clearTemporaryAccounts: connecting to $ldapurl, $timeout");
369
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
370
    if ($ldap) {
371
    	$ldap->start_tls( verify => 'require',
372
                      cafile => $ldapServerCACertFile);
373
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
374
		$mesg = $ldap->search (
375
			base   => $tmpSearchBase,
376
			filter => $filter,
377
			attrs => \@attrs,
378
		);
379
	    if ($mesg->count() > 0) {
380
			my $entry;
381
			foreach $entry ($mesg->all_entries) { 
382
            	$dn = $entry->dn();
383
            	# remove the entry
384
   				debug("Removing expired account: " . $dn);
385
            	$ldap->delete($dn);
386
			}
387
        }
388
    	$ldap->unbind;   # take down session
389
    }
390

    
391
    return 0;
392
}
393

    
394
sub fullTemplate {
395
    my $templateList = shift;
396
    my $templateVars = setVars(shift);
397
    my $c = Captcha::reCAPTCHA->new;
398
    my $captcha = 'captcha';
399
    #my $error=null;
400
    my $use_ssl= 1;
401
    #my $options=null;
402
    # use the AJAX style, only need to provide the public key to the template
403
    $templateVars->{'recaptchaPublicKey'} = $recaptchaPublicKey;
404
    #$templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
405
    $template->process( $templates->{'header'}, $templateVars );
406
    foreach my $tmpl (@{$templateList}) {
407
        $template->process( $templates->{$tmpl}, $templateVars );
408
    }
409
    $template->process( $templates->{'footer'}, $templateVars );
410
}
411

    
412

    
413
#
414
# Initialize a form for a user to request the account name associated with an email address
415
#
416
sub handleLookupName {
417
    
418
    print "Content-type: text/html\n\n";
419
    # process the template files:
420
    fullTemplate(['lookupName']); 
421
    exit();
422
}
423

    
424
#
425
# Handle the user's request to look up account names with a specified email address.
426
# This relates to "Forget your user name"
427
#
428
sub handleSearchNameByEmail{
429

    
430
    print "Content-type: text/html\n\n";
431
   
432
    my $allParams = {'mail' => $query->param('mail')};
433
    my @requiredParams = ('mail');
434
    if (! paramsAreValid(@requiredParams)) {
435
        my $errorMessage = "Required information is missing. " .
436
            "Please fill in all required fields and resubmit the form.";
437
        fullTemplate(['lookupName'], { allParams => $allParams,
438
                                     errorMessage => $errorMessage });
439
        exit();
440
    }
441
    my $mail = $query->param('mail');
442
    
443
    #search accounts with the specified emails 
444
    $searchBase = $authBase; 
445
    my $filter = "(mail=" . $mail . ")";
446
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
447
    my $notHtmlFormat = 1;
448
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs, $notHtmlFormat);
449
    my $accountInfo;
450
    if ($found) {
451
        $accountInfo = $found;
452
    } else {
453
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n";
454
    }
455

    
456
    my $mailhost = $properties->getProperty('email.mailhost');
457
    my $sender;
458
    my $contact;
459
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
460
    $contact = $skinProperties->getProperty("email.contact") or $contact = $properties->getProperty('email.contact');
461
    debug("the sender is " . $sender);
462
    debug("the contact is " . $contact);
463
    my $recipient = $query->param('mail');
464
    # Send the email message to them
465
    my $smtp = Net::SMTP->new($mailhost) or do {  
466
                                                  fullTemplate( ['lookupName'], {allParams => $allParams, 
467
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " . 
468
                                                                $skinProperties->getProperty("email.recipient") . "." });  
469
                                                  exit(0);
470
                                               };
471
    $smtp->mail($sender);
472
    $smtp->to($recipient);
473

    
474
    my $message = <<"     ENDOFMESSAGE";
475
    To: $recipient
476
    From: $sender
477
    Subject: Your Account Information
478
        
479
    Somebody (hopefully you) looked up the account information associated with the email address.  
480
    Here is the account information:
481
    
482
    $accountInfo
483

    
484
    Thanks,
485
        $sender
486
    
487
     ENDOFMESSAGE
488
     $message =~ s/^[ \t\r\f]+//gm;
489
    
490
     $smtp->data($message);
491
     $smtp->quit;
492
     fullTemplate( ['lookupNameSuccess'] );
493
    
494
}
495

    
496

    
497
#
498
# create the initial registration form 
499
#
500
sub handleInitRegister {
501
  my $vars = shift;
502
  print "Content-type: text/html\n\n";
503
  # process the template files:
504
  fullTemplate(['register'], {stage => "register"}); 
505
  exit();
506
}
507

    
508

    
509

    
510
#
511
# process input from the register stage, which occurs when
512
# a user submits form data to create a new account
513
#
514
sub handleRegister {
515
    
516
    #print "Content-type: text/html\n\n";
517
    if ($query->param('o') =~ "LTER") {
518
      print "Content-type: text/html\n\n";
519
      fullTemplate( ['registerLter'] );
520
      exit(0);
521
    } 
522
    
523
    my $allParams = { 'givenName' => $query->param('givenName'), 
524
                      'sn' => $query->param('sn'),
525
                      'o' => $query->param('o'), 
526
                      'mail' => $query->param('mail'), 
527
                      'uid' => $query->param('uid'), 
528
                      'userPassword' => $query->param('userPassword'), 
529
                      'userPassword2' => $query->param('userPassword2'), 
530
                      'title' => $query->param('title'), 
531
                      'telephoneNumber' => $query->param('telephoneNumber') };
532
    
533
    # Check the recaptcha
534
    my $c = Captcha::reCAPTCHA->new;
535
    my $challenge = $query->param('recaptcha_challenge_field');
536
    my $response = $query->param('recaptcha_response_field');
537
    # Verify submission
538
    my $result = $c->check_answer(
539
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
540
        $challenge, $response
541
    );
542

    
543
    if ( $result->{is_valid} ) {
544
        #print "Yes!";
545
        #exit();
546
    }
547
    else {
548
        print "Content-type: text/html\n\n";
549
        my $errorMessage = "The verification code is wrong. Please input again.";
550
        fullTemplate(['register'], { stage => "register",
551
                                     allParams => $allParams,
552
                                     errorMessage => $errorMessage });
553
        exit();
554
    }
555
    
556
    
557
    # Check that all required fields are provided and not null
558
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
559
                           'uid', 'userPassword', 'userPassword2');
560
    if (! paramsAreValid(@requiredParams)) {
561
        print "Content-type: text/html\n\n";
562
        my $errorMessage = "Required information is missing. " .
563
            "Please fill in all required fields and resubmit the form.";
564
        fullTemplate(['register'], { stage => "register",
565
                                     allParams => $allParams,
566
                                     errorMessage => $errorMessage });
567
        exit();
568
    } else {
569
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
570
            print "Content-type: text/html\n\n";
571
            my $errorMessage = "The passwords do not match. Try again.";
572
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
573
                                                            allParams => $allParams,
574
                                                            errorMessage => $errorMessage });
575
            exit();
576
        }
577
        my $o = $query->param('o');    
578
        $searchBase = $ldapConfig->{$o}{'base'};  
579
    }
580
    
581
    # Remove any expired temporary accounts for this subtree before continuing
582
    clearTemporaryAccounts();
583
    
584
    # Check if the uid was taken in the production space
585
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
586
    my $uidExists;
587
    my $uid=$query->param('uid');
588
    my $uidFilter = "uid=" . $uid;
589
    my $newSearchBase = $ldapConfig->{$query->param('o')}{'org'} . "," .  $searchBase;
590
    debug("the new search base is $newSearchBase");
591
    $uidExists = uidExists($ldapurl, $newSearchBase, $uidFilter, \@attrs);
592
    debug("the result of uidExists $uidExists");
593
    if($uidExists) {
594
         print "Content-type: text/html\n\n";
595
            my $errorMessage = $uidExists;
596
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
597
                                                            allParams => $allParams,
598
                                                            errorMessage => $errorMessage });
599
            exit();
600
    }
601

    
602
    # Search LDAP for matching entries that already exist
603
    # Some forms use a single text search box, whereas others search per
604
    # attribute.
605
    my $filter;
606
    if ($query->param('searchField')) {
607

    
608
      $filter = "(|" . 
609
                "(uid=" . $query->param('searchField') . ") " .
610
                "(mail=" . $query->param('searchField') . ")" .
611
                "(&(sn=" . $query->param('searchField') . ") " . 
612
                "(givenName=" . $query->param('searchField') . "))" . 
613
                ")";
614
    } else {
615
      $filter = "(|" . 
616
                "(uid=" . $query->param('uid') . ") " .
617
                "(mail=" . $query->param('mail') . ")" .
618
                "(&(sn=" . $query->param('sn') . ") " . 
619
                "(givenName=" . $query->param('givenName') . "))" . 
620
                ")";
621
    }
622

    
623
    
624
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
625

    
626
    # If entries match, send back a request to confirm new-user creation
627
    if ($found) {
628
      print "Content-type: text/html\n\n";
629
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
630
                                                     allParams => $allParams,
631
                                                     foundAccounts => $found });
632
    # Otherwise, create a new user in the LDAP directory
633
    } else {
634
        createTemporaryAccount($allParams);
635
    }
636

    
637
    exit();
638
}
639

    
640
#
641
# process input from the registerconfirmed stage, which occurs when
642
# a user chooses to create an account despite similarities to other
643
# existing accounts
644
#
645
sub handleRegisterConfirmed {
646
  
647
    my $allParams = { 'givenName' => $query->param('givenName'), 
648
                      'sn' => $query->param('sn'),
649
                      'o' => $query->param('o'), 
650
                      'mail' => $query->param('mail'), 
651
                      'uid' => $query->param('uid'), 
652
                      'userPassword' => $query->param('userPassword'), 
653
                      'userPassword2' => $query->param('userPassword2'), 
654
                      'title' => $query->param('title'), 
655
                      'telephoneNumber' => $query->param('telephoneNumber') };
656
    #print "Content-type: text/html\n\n";
657
    createTemporaryAccount($allParams);
658
    exit();
659
}
660

    
661
#
662
# change a user's password upon request
663
#
664
sub handleChangePassword {
665

    
666
    print "Content-type: text/html\n\n";
667

    
668
    my $allParams = { 'test' => "1", };
669
    if ($query->param('uid')) {
670
        $$allParams{'uid'} = $query->param('uid');
671
    }
672
    if ($query->param('o')) {
673
        $$allParams{'o'} = $query->param('o');
674
        my $o = $query->param('o');
675
        
676
        $searchBase = $ldapConfig->{$o}{'base'};
677
    }
678

    
679

    
680
    # Check that all required fields are provided and not null
681
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
682
                           'userPassword', 'userPassword2');
683
    if (! paramsAreValid(@requiredParams)) {
684
        my $errorMessage = "Required information is missing. " .
685
            "Please fill in all required fields and submit the form.";
686
        fullTemplate( ['changePass'], { stage => "changepass",
687
                                        allParams => $allParams,
688
                                        errorMessage => $errorMessage });
689
        exit();
690
    }
691

    
692
    # We have all of the info we need, so try to change the password
693
    if ($query->param('userPassword') eq $query->param('userPassword2')) {
694

    
695
        my $o = $query->param('o');
696
        $searchBase = $ldapConfig->{$o}{'base'};
697
        $ldapUsername = $ldapConfig->{$o}{'user'};
698
        $ldapPassword = $ldapConfig->{$o}{'password'};
699

    
700
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
701
        if ($query->param('o') =~ "LTER") {
702
            fullTemplate( ['registerLter'] );
703
        } else {
704
            my $errorMessage = changePassword(
705
                    $dn, $query->param('userPassword'), 
706
                    $dn, $query->param('oldpass'), $query->param('o'));
707
            if ($errorMessage) {
708
                fullTemplate( ['changePass'], { stage => "changepass",
709
                                                allParams => $allParams,
710
                                                errorMessage => $errorMessage });
711
                exit();
712
            } else {
713
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
714
                                                       allParams => $allParams });
715
                exit();
716
            }
717
        }
718
    } else {
719
        my $errorMessage = "The passwords do not match. Try again.";
720
        fullTemplate( ['changePass'], { stage => "changepass",
721
                                        allParams => $allParams,
722
                                        errorMessage => $errorMessage });
723
        exit();
724
    }
725
}
726

    
727
#
728
# change a user's password upon request - no input params
729
# only display chagepass template without any error
730
#
731
sub handleInitialChangePassword {
732
    print "Content-type: text/html\n\n";
733

    
734
    my $allParams = { 'test' => "1", };
735
    my $errorMessage = "";
736
    fullTemplate( ['changePass'], { stage => "changepass",
737
                                    errorMessage => $errorMessage });
738
    exit();
739
}
740

    
741
#
742
# reset a user's password upon request
743
#
744
sub handleResetPassword {
745

    
746
    print "Content-type: text/html\n\n";
747

    
748
    my $allParams = { 'test' => "1", };
749
    if ($query->param('uid')) {
750
        $$allParams{'uid'} = $query->param('uid');
751
    }
752
    if ($query->param('o')) {
753
        $$allParams{'o'} = $query->param('o');
754
        my $o = $query->param('o');
755
        
756
        $searchBase = $ldapConfig->{$o}{'base'};
757
        $ldapUsername = $ldapConfig->{$o}{'user'};
758
        $ldapPassword = $ldapConfig->{$o}{'password'};
759
    }
760

    
761
    # Check that all required fields are provided and not null
762
    my @requiredParams = ( 'uid', 'o' );
763
    if (! paramsAreValid(@requiredParams)) {
764
        my $errorMessage = "Required information is missing. " .
765
            "Please fill in all required fields and submit the form.";
766
        fullTemplate( ['resetPass'],  { stage => "resetpass",
767
                                        allParams => $allParams,
768
                                        errorMessage => $errorMessage });
769
        exit();
770
    }
771

    
772
    # We have all of the info we need, so try to change the password
773
    my $o = $query->param('o');
774
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
775
    debug("handleResetPassword: dn: $dn");
776
    if ($query->param('o') =~ "LTER") {
777
        fullTemplate( ['registerLter'] );
778
        exit();
779
    } else {
780
        my $errorMessage = "";
781
        my $recipient;
782
        my $userPass;
783
        my $entry = getLdapEntry($ldapurl, $searchBase, 
784
                $query->param('uid'), $query->param('o'));
785

    
786
        if ($entry) {
787
            $recipient = $entry->get_value('mail');
788
            $userPass = getRandomPassword();
789
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
790
        } else {
791
            $errorMessage = "User not found in database.  Please try again.";
792
        }
793

    
794
        if ($errorMessage) {
795
            fullTemplate( ['resetPass'], { stage => "resetpass",
796
                                           allParams => $allParams,
797
                                           errorMessage => $errorMessage });
798
            exit();
799
        } else {
800
            my $errorMessage = sendPasswordNotification($query->param('uid'),
801
                    $query->param('o'), $userPass, $recipient, $cfg);
802
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
803
                                                  allParams => $allParams,
804
                                                  errorMessage => $errorMessage });
805
            exit();
806
        }
807
    }
808
}
809

    
810
#
811
# reset a user's password upon request- no initial params
812
# only display resetpass template without any error
813
#
814
sub handleInitialResetPassword {
815
    print "Content-type: text/html\n\n";
816
    my $errorMessage = "";
817
    fullTemplate( ['resetPass'], { stage => "resetpass",
818
                                   errorMessage => $errorMessage });
819
    exit();
820
}
821

    
822
#
823
# Construct a random string to use for a newly reset password
824
#
825
sub getRandomPassword {
826
    my $length = shift;
827
    if (!$length) {
828
        $length = 8;
829
    }
830
    my $newPass = "";
831

    
832
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
833
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
834
    return $newPass;
835
}
836

    
837
#
838
# Change a password to a new value, binding as the provided user
839
#
840
sub changePassword {
841
    my $userDN = shift;
842
    my $userPass = shift;
843
    my $bindDN = shift;
844
    my $bindPass = shift;
845
    my $o = shift;
846

    
847
    my $searchBase = $ldapConfig->{$o}{'base'};
848

    
849
    my $errorMessage = 0;
850
    my $ldap;
851

    
852
    #if main ldap server is down, a html file containing warning message will be returned
853
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
854
    
855
    if ($ldap) {
856
        $ldap->start_tls( verify => 'require',
857
                      cafile => $ldapServerCACertFile);
858
        debug("changePassword: attempting to bind to $bindDN");
859
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
860
                                  password => $bindPass );
861
        if ($bindresult->code) {
862
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
863
                            "correct? Please correct and try again...";
864
            return $errorMessage;
865
        }
866

    
867
    	# Find the user here and change their entry
868
    	my $newpass = createSeededPassHash($userPass);
869
    	my $modifications = { userPassword => $newpass };
870
      debug("changePass: setting password for $userDN to $newpass");
871
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
872
    
873
    	if ($result->code()) {
874
            debug("changePass: error changing password: " . $result->error);
875
        	$errorMessage = "There was an error changing the password:" .
876
                           "<br />\n" . $result->error;
877
    	} 
878
    	$ldap->unbind;   # take down session
879
    }
880

    
881
    return $errorMessage;
882
}
883

    
884
#
885
# generate a Seeded SHA1 hash of a plaintext password
886
#
887
sub createSeededPassHash {
888
    my $secret = shift;
889

    
890
    my $salt = "";
891
    for (my $i=0; $i < 4; $i++) {
892
        $salt .= int(rand(10));
893
    }
894

    
895
    my $ctx = Digest::SHA1->new;
896
    $ctx->add($secret);
897
    $ctx->add($salt);
898
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
899

    
900
    return $hashedPasswd;
901
}
902

    
903
#
904
# Look up an ldap entry for a user
905
#
906
sub getLdapEntry {
907
    my $ldapurl = shift;
908
    my $base = shift;
909
    my $username = shift;
910
    my $org = shift;
911

    
912
    my $entry = "";
913
    my $mesg;
914
    my $ldap;
915
    debug("ldap server: $ldapurl");
916

    
917
    #if main ldap server is down, a html file containing warning message will be returned
918
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
919
    
920
    if ($ldap) {
921
        $ldap->start_tls( verify => 'none');
922
        #$ldap->start_tls( verify => 'require',
923
        #              cafile => $ldapServerCACertFile);
924
    	my $bindresult = $ldap->bind;
925
    	if ($bindresult->code) {
926
        	return $entry;
927
    	}
928

    
929
        $base = $ldapConfig->{$org}{'org'} . ',' . $base;
930
        debug("getLdapEntry, searching for $base, (uid=$username)");
931
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
932
    	#if($ldapConfig->{$org}{'filter'}){
933
            #debug("getLdapEntry: filter set, searching for base=$base, " .
934
                  #"(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
935
        	#$mesg = $ldap->search ( base   => $base,
936
                #filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
937
    	#} else {
938
            #debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
939
        	#$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
940
    	#}
941
    
942
    	if ($mesg->count > 0) {
943
        	$entry = $mesg->pop_entry;
944
        	$ldap->unbind;   # take down session
945
    	} else {
946
        	$ldap->unbind;   # take down session
947
        	# Follow references by recursive call to self
948
        	my @references = $mesg->references();
949
        	for (my $i = 0; $i <= $#references; $i++) {
950
            	my $uri = URI->new($references[$i]);
951
            	my $host = $uri->host();
952
            	my $path = $uri->path();
953
            	$path =~ s/^\///;
954
            	$entry = &getLdapEntry($host, $path, $username, $org);
955
            	if ($entry) {
956
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
957
                	return $entry;
958
            	}
959
        	}
960
    	}
961
    }
962
    return $entry;
963
}
964

    
965
# 
966
# send an email message notifying the user of the pw change
967
#
968
sub sendPasswordNotification {
969
    my $username = shift;
970
    my $org = shift;
971
    my $newPass = shift;
972
    my $recipient = shift;
973
    my $cfg = shift;
974

    
975
    my $errorMessage = "";
976
    if ($recipient) {
977
    
978
        my $mailhost = $properties->getProperty('email.mailhost');
979
        my $sender;
980
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
981
        # Send the email message to them
982
        my $smtp = Net::SMTP->new($mailhost);
983
        $smtp->mail($sender);
984
        $smtp->to($recipient);
985

    
986
        my $message = <<"        ENDOFMESSAGE";
987
        To: $recipient
988
        From: $sender
989
        Subject: Your Account Password Reset
990
        
991
        Somebody (hopefully you) requested that your account password be reset.  
992
        Your temporary password is below. Please change it as soon as possible 
993
        at: $contextUrl/style/skins/account/.
994

    
995
            Username: $username
996
        Organization: $org
997
        New Password: $newPass
998

    
999
        Thanks,
1000
            $sender
1001
            $contact
1002
    
1003
        ENDOFMESSAGE
1004
        $message =~ s/^[ \t\r\f]+//gm;
1005
    
1006
        $smtp->data($message);
1007
        $smtp->quit;
1008
    } else {
1009
        $errorMessage = "Failed to send password because I " .
1010
                        "couldn't find a valid email address.";
1011
    }
1012
    return $errorMessage;
1013
}
1014

    
1015
#
1016
# search the LDAP production space to see if a uid already exists
1017
#
1018
sub uidExists {
1019
    my $ldapurl = shift;
1020
    debug("the ldap ulr is $ldapurl");
1021
    my $base = shift;
1022
    debug("the base is $base");
1023
    my $filter = shift;
1024
    debug("the filter is $filter");
1025
    my $attref = shift;
1026
  
1027
    my $ldap;
1028
    my $mesg;
1029

    
1030
    my $foundAccounts = 0;
1031

    
1032
    #if main ldap server is down, a html file containing warning message will be returned
1033
    debug("uidExists: connecting to $ldapurl, $timeout");
1034
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1035
    if ($ldap) {
1036
        $ldap->start_tls( verify => 'none');
1037
        #$ldap->start_tls( verify => 'require',
1038
        #              cafile => $ldapServerCACertFile);
1039
        $ldap->bind( version => 3, anonymous => 1);
1040
        $mesg = $ldap->search (
1041
            base   => $base,
1042
            filter => $filter,
1043
            attrs => @$attref,
1044
        );
1045
        debug("the message count is " . $mesg->count());
1046
        if ($mesg->count() > 0) {
1047
            $foundAccounts = "The username has been taken already by another user. Please choose a different one.";
1048
           
1049
        }
1050
        $ldap->unbind;   # take down session
1051
    } else {
1052
        $foundAccounts = "The ldap server is not running";
1053
    }
1054
    return $foundAccounts;
1055
}
1056

    
1057
#
1058
# search the LDAP directory to see if a similar account already exists
1059
#
1060
sub findExistingAccounts {
1061
    my $ldapurl = shift;
1062
    my $base = shift;
1063
    my $filter = shift;
1064
    my $attref = shift;
1065
    my $notHtmlFormat = shift;
1066
    my $ldap;
1067
    my $mesg;
1068

    
1069
    my $foundAccounts = 0;
1070

    
1071
    #if main ldap server is down, a html file containing warning message will be returned
1072
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
1073
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1074
    if ($ldap) {
1075
    	$ldap->start_tls( verify => 'none');
1076
    	#$ldap->start_tls( verify => 'require',
1077
        #              cafile => $ldapServerCACertFile);
1078
    	$ldap->bind( version => 3, anonymous => 1);
1079
		$mesg = $ldap->search (
1080
			base   => $base,
1081
			filter => $filter,
1082
			attrs => @$attref,
1083
		);
1084

    
1085
	    if ($mesg->count() > 0) {
1086
			$foundAccounts = "";
1087
			my $entry;
1088
			foreach $entry ($mesg->all_entries) { 
1089
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
1090
                # this could be done directly with filters on the LDAP connection, instead.
1091
                #if ($entry->dn !~ /ou=Account/) {
1092
                    if($notHtmlFormat) {
1093
                        $foundAccounts .= "\nAccount: ";
1094
                    } else {
1095
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
1096
                    }
1097
                    $foundAccounts .= $entry->dn();
1098
                    if($notHtmlFormat) {
1099
                        $foundAccounts .= "\n";
1100
                    } else {
1101
                        $foundAccounts .= "</b><br />\n";
1102
                    }
1103
                    foreach my $attribute ($entry->attributes()) {
1104
                        my $value = $entry->get_value($attribute);
1105
                        $foundAccounts .= "$attribute: ";
1106
                        $foundAccounts .= $value;
1107
                         if($notHtmlFormat) {
1108
                            $foundAccounts .= "\n";
1109
                        } else {
1110
                            $foundAccounts .= "<br />\n";
1111
                        }
1112
                    }
1113
                    if($notHtmlFormat) {
1114
                        $foundAccounts .= "\n";
1115
                    } else {
1116
                        $foundAccounts .= "</p>\n";
1117
                    }
1118
                    
1119
                #}
1120
			}
1121
        }
1122
    	$ldap->unbind;   # take down session
1123

    
1124
    	# Follow references
1125
    	my @references = $mesg->references();
1126
    	for (my $i = 0; $i <= $#references; $i++) {
1127
        	my $uri = URI->new($references[$i]);
1128
        	my $host = $uri->host();
1129
        	my $path = $uri->path();
1130
        	$path =~ s/^\///;
1131
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
1132
        	if ($refFound) {
1133
            	$foundAccounts .= $refFound;
1134
        	}
1135
    	}
1136
    }
1137

    
1138
    #print "<p>Checking referrals...</p>\n";
1139
    #my @referrals = $mesg->referrals();
1140
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
1141
    #for (my $i = 0; $i <= $#referrals; $i++) {
1142
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
1143
    #}
1144

    
1145
    return $foundAccounts;
1146
}
1147

    
1148
#
1149
# Validate that we have the proper set of input parameters
1150
#
1151
sub paramsAreValid {
1152
    my @pnames = @_;
1153

    
1154
    my $allValid = 1;
1155
    foreach my $parameter (@pnames) {
1156
        if (!defined($query->param($parameter)) || 
1157
            ! $query->param($parameter) ||
1158
            $query->param($parameter) =~ /^\s+$/) {
1159
            $allValid = 0;
1160
        }
1161
    }
1162

    
1163
    return $allValid;
1164
}
1165

    
1166
#
1167
# Create a temporary account for a user and send an email with a link which can click for the
1168
# verification. This is used to protect the ldap server against spams.
1169
#
1170
sub createTemporaryAccount {
1171
    my $allParams = shift;
1172
    my $org = $query->param('o'); 
1173
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1174
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1175
    my $tmp = 1;
1176

    
1177
    ################## Search LDAP to see if the dc=tmp which stores the inactive accounts exist or not. If it doesn't exist, it will be generated
1178
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
1179
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
1180
    my $tmpFilter = "dc=tmp";
1181
    my @attributes=['dc'];
1182
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
1183
    if (!$foundTmp) {
1184
        my $dn = $tmpSearchBase;
1185
        my $additions = [ 
1186
                    'dc' => 'tmp',
1187
                    'o'  => 'tmp',
1188
                    'objectclass' => ['top', 'dcObject', 'organization']
1189
                    ];
1190
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1191
    } else {
1192
     debug("found the tmp space");
1193
    }
1194
    
1195
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1196
    my $filter = $ldapConfig->{$org}{'filter'};   
1197
    
1198
    debug("search filer " . $filter);
1199
    debug("ldap server ". $ldapurl);
1200
    debug("sesarch base " . $tmpSearchBase);
1201
    #print "Content-type: text/html\n\n";
1202
    my @attrs = ['o', 'ou' ];
1203
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1204

    
1205
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
1206
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
1207
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
1208
        
1209
    if(!$found) {
1210
        debug("generate the subtree in the dc=tmp===========================");
1211
        #need to generate the subtree o or ou
1212
        my $additions;
1213
            if($organization eq 'ou') {
1214
                $additions = [ 
1215
                    $organization   => $organizationName,
1216
                    'objectclass' => ['top', 'organizationalUnit']
1217
                    ];
1218
            
1219
            } else {
1220
                $additions = [ 
1221
                    $organization   => $organizationName,
1222
                    'objectclass' => ['top', 'organization']
1223
                    ];
1224
            
1225
            } 
1226
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1227
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1228
    } 
1229
    
1230
    ################create an account under tmp subtree 
1231
    
1232
     my $dn_store_next_uid=$properties->getProperty('ldap.nextuid.storing.dn');
1233
    my $attribute_name_store_next_uid = $properties->getProperty('ldap.nextuid.storing.attributename');
1234
    #get the next avaliable uid number. If it fails, the program will exist.
1235
    my $nextUidNumber = getNextUidNumber($ldapUsername, $ldapPassword);
1236
    if(!$nextUidNumber) {
1237
        print "Content-type: text/html\n\n";
1238
         my $sender;
1239
         my $contact;
1240
        $sender = $skinProperties->getProperty("email.recipient") or $sender = $properties->getProperty('email.recipient');
1241
        $contact = $skinProperties->getProperty("email.contact") or $contact = $properties->getProperty('email.contact');
1242
        my $errorMessage = "The Identity Service can't get the next avaliable uid number. Please try again.  If the issue persists, please contact the administrator - $contact.
1243
                           The possible reasons are: the dn - $dn_store_next_uid or its attribute - $attribute_name_store_next_uid don't exist; the value of the attribute - $attribute_name_store_next_uid
1244
                           is not a number; or lots of users were registering and you couldn't get a lock on the dn - $dn_store_next_uid.";
1245
        fullTemplate(['register'], { stage => "register",
1246
                                     allParams => $allParams,
1247
                                     errorMessage => $errorMessage });
1248
        exit(0);
1249
    }
1250
    my $cn = join(" ", $query->param('givenName'), $query->param('sn')); 
1251
    #generate a randomstr for matching the email.
1252
    my $randomStr = getRandomPassword(16);
1253
    # Create a hashed version of the password
1254
    my $shapass = createSeededPassHash($query->param('userPassword'));
1255
    my $additions = [ 
1256
                'uid'   => $query->param('uid'),
1257
                'cn'   => $cn,
1258
                'sn'   => $query->param('sn'),
1259
                'givenName'   => $query->param('givenName'),
1260
                'mail' => $query->param('mail'),
1261
                'userPassword' => $shapass,
1262
                'employeeNumber' => $randomStr,
1263
                'uidNumber' => $nextUidNumber,
1264
                'gidNumber' => $nextUidNumber,
1265
                'loginShell' => '/sbin/nologin',
1266
                'homeDirectory' => '/dev/null',
1267
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1268
                                'inetOrgPerson', 'posixAccount', 'shadowAccount' ],
1269
                $organization   => $organizationName
1270
                ];
1271
    my $gecos;
1272
    if (defined($query->param('telephoneNumber')) && 
1273
                $query->param('telephoneNumber') &&
1274
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1275
                $$additions[$#$additions + 1] = 'telephoneNumber';
1276
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1277
                $gecos = $cn . ',,'. $query->param('telephoneNumber'). ',';
1278
    } else {
1279
        $gecos = $cn . ',,,';
1280
    }
1281
    
1282
    $$additions[$#$additions + 1] = 'gecos';
1283
    $$additions[$#$additions + 1] = $gecos;
1284
    
1285
    if (defined($query->param('title')) && 
1286
                $query->param('title') &&
1287
                ! $query->param('title') =~ /^\s+$/) {
1288
                $$additions[$#$additions + 1] = 'title';
1289
                $$additions[$#$additions + 1] = $query->param('title');
1290
    }
1291

    
1292
    
1293
    #$$additions[$#$additions + 1] = 'o';
1294
    #$$additions[$#$additions + 1] = $org;
1295
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1296
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1297
    
1298
    
1299
    ####################send the verification email to the user
1300
    my $link = '/' . $context . '/cgi-bin/ldapweb.cgi?cfg=' . $skinName . '&' . 'stage=' . $emailVerification . '&' . 'dn=' . $dn . '&' . 'hash=' . $randomStr . '&o=' . $org . '&uid=' . $query->param('uid'); #even though we use o=something. The emailVerification will figure the real o= or ou=something.
1301
    
1302
    my $overrideURL;
1303
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1304
    debug("the overrideURL is $overrideURL");
1305
    if (defined($overrideURL) && !($overrideURL eq '')) {
1306
    	$link = $serverUrl . $overrideURL . $link;
1307
    } else {
1308
    	$link = $serverUrl . $link;
1309
    }
1310
    
1311
    my $mailhost = $properties->getProperty('email.mailhost');
1312
    my $sender;
1313
    my $contact;
1314
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1315
    $contact = $skinProperties->getProperty("email.contact") or $contact = $properties->getProperty('email.contact');
1316
    debug("the sender is " . $sender);
1317
    debug("the contact is :" . $contact);
1318
    my $recipient = $query->param('mail');
1319
    # Send the email message to them
1320
    my $smtp = Net::SMTP->new($mailhost) or do {  
1321
                                                  fullTemplate( ['registerFailed'], {errorMessage => "The temporary account " . $dn . " was created successfully. However, the vertification email can't be sent to you because the email server has some issues. Please contact " . 
1322
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1323
                                                  exit(0);
1324
                                               };
1325
    $smtp->mail($sender);
1326
    $smtp->to($recipient);
1327

    
1328
    my $message = <<"     ENDOFMESSAGE";
1329
    To: $recipient
1330
    From: $sender
1331
    Subject: New Account Activation
1332
        
1333
    Somebody (hopefully you) registered an account on $contextUrl/style/skins/account/.  
1334
    Please click the following link to activate your account.
1335
    If the link doesn't work, please copy the link to your browser:
1336
    
1337
    $link
1338

    
1339
    Thanks,
1340
        $sender
1341
        $contact
1342
    
1343
     ENDOFMESSAGE
1344
     $message =~ s/^[ \t\r\f]+//gm;
1345
    
1346
     $smtp->data($message);
1347
     $smtp->quit;
1348
    debug("the link is " . $link);
1349
    fullTemplate( ['success'] );
1350
    
1351
}
1352

    
1353
#
1354
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1355
# by the user
1356
#
1357
sub createItem {
1358
    my $dn = shift;
1359
    my $ldapUsername = shift;
1360
    my $ldapPassword = shift;
1361
    my $additions = shift;
1362
    my $temp = shift; #if it is for a temporary account.
1363
    my $allParams = shift;
1364
    
1365
    my @failureTemplate;
1366
    if($temp){
1367
        @failureTemplate = ['registerFailed', 'register'];
1368
    } else {
1369
        @failureTemplate = ['registerFailed'];
1370
    }
1371
    print "Content-type: text/html\n\n";
1372
    debug("the dn is " . $dn);
1373
    debug("LDAP connection to $ldapurl...");    
1374
    debug("the ldap ca certificate is " . $ldapServerCACertFile);
1375
    #if main ldap server is down, a html file containing warning message will be returned
1376
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1377
    if ($ldap) {
1378
            $ldap->start_tls( verify => 'require',
1379
                      cafile => $ldapServerCACertFile);
1380
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1381
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1382
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1383
            if ($result->code()) {
1384
                fullTemplate(@failureTemplate, { stage => "register",
1385
                                                            allParams => $allParams,
1386
                                                            errorMessage => $result->error });
1387
                exist(0);
1388
                # TODO SCW was included as separate errors, test this
1389
                #$templateVars    = setVars({ stage => "register",
1390
                #                     allParams => $allParams });
1391
                #$template->process( $templates->{'register'}, $templateVars);
1392
            } else {
1393
                #fullTemplate( ['success'] );
1394
            }
1395
            $ldap->unbind;   # take down session
1396
            
1397
    } else {   
1398
         fullTemplate(@failureTemplate, { stage => "register",
1399
                                                            allParams => $allParams,
1400
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1401
         exit(0);
1402
    }
1403
  
1404
}
1405

    
1406

    
1407

    
1408

    
1409

    
1410

    
1411
#
1412
# This subroutine will handle a email verification:
1413
# If the hash string matches the one store in the ldap, the account will be
1414
# copied from the temporary space to the permanent tree and the account in 
1415
# the temporary space will be removed.
1416
sub handleEmailVerification {
1417

    
1418
    my $cfg = $query->param('cfg');
1419
    my $dn = $query->param('dn');
1420
    my $hash = $query->param('hash');
1421
    my $org = $query->param('o');
1422
    my $uid = $query->param('uid');
1423
    
1424
    my $ldapUsername;
1425
    my $ldapPassword;
1426
    #my $orgAuthBase;
1427

    
1428
    $ldapUsername = $ldapConfig->{$org}{'user'};
1429
    $ldapPassword = $ldapConfig->{$org}{'password'};
1430
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1431
    
1432
    debug("LDAP connection to $ldapurl...");    
1433
    
1434

    
1435
   print "Content-type: text/html\n\n";
1436
   #if main ldap server is down, a html file containing warning message will be returned
1437
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1438
   if ($ldap) {
1439
        $ldap->start_tls( verify => 'require',
1440
                      cafile => $ldapServerCACertFile);
1441
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1442
        my $mesg = $ldap->search(base => $dn, scope => 'base', filter => '(objectClass=*)'); #This dn is with the dc=tmp. So it will find out the temporary account registered in registration step.
1443
        my $max = $mesg->count;
1444
        debug("the count is " . $max);
1445
        if($max < 1) {
1446
            $ldap->unbind;   # take down session
1447
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1448
            #handleLDAPBindFailure($ldapurl);
1449
            exit(0);
1450
        } else {
1451
            #check if the hash string match
1452
            my $entry = $mesg->entry (0);
1453
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1454
            if( $hashStrFromLdap eq $hash) {
1455
                #my $additions = [ ];
1456
                #foreach my $attr ( $entry->attributes ) {
1457
                    #if($attr ne 'employeeNumber') {
1458
                        #$$additions[$#$additions + 1] = $attr;
1459
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1460
                    #}
1461
                #}
1462

    
1463
                
1464
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1465
                $mesg = $ldap->moddn(
1466
                            dn => $dn,
1467
                            deleteoldrdn => 1,
1468
                            newrdn => "uid=" . $uid,
1469
                            newsuperior  =>  $orgDn);
1470
                $ldap->unbind;   # take down session
1471
                if($mesg->code()) {
1472
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1473
                    exit(0);
1474
                } else {
1475
                    fullTemplate( ['verificationSuccess'] );
1476
                }
1477
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1478
            } else {
1479
                $ldap->unbind;   # take down session
1480
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1481
                exit(0);
1482
            }
1483
            
1484
        }
1485
    } else {   
1486
        handleLDAPBindFailure($ldapurl);
1487
        exit(0);
1488
    }
1489

    
1490
}
1491

    
1492
sub handleResponseMessage {
1493

    
1494
  print "Content-type: text/html\n\n";
1495
  my $errorMessage = "You provided invalid input to the script. " .
1496
                     "Try again please.";
1497
  fullTemplate( [], { stage => $templates->{'stage'},
1498
                      errorMessage => $errorMessage });
1499
  exit();
1500
}
1501

    
1502
#
1503
# perform a simple search against the LDAP database using 
1504
# a small subset of attributes of each dn and return it
1505
# as a table to the calling browser.
1506
#
1507
sub handleSimpleSearch {
1508

    
1509
    my $o = $query->param('o');
1510

    
1511
    my $ldapurl = $ldapConfig->{$o}{'url'};
1512
    my $searchBase = $ldapConfig->{$o}{'base'};
1513

    
1514
    print "Content-type: text/html\n\n";
1515

    
1516
    my $allParams = { 
1517
                      'cn' => $query->param('cn'),
1518
                      'sn' => $query->param('sn'),
1519
                      'gn' => $query->param('gn'),
1520
                      'o'  => $query->param('o'),
1521
                      'facsimiletelephonenumber' 
1522
                      => $query->param('facsimiletelephonenumber'),
1523
                      'mail' => $query->param('cmail'),
1524
                      'telephonenumber' => $query->param('telephonenumber'),
1525
                      'title' => $query->param('title'),
1526
                      'uid' => $query->param('uid'),
1527
                      'ou' => $query->param('ou'),
1528
                    };
1529

    
1530
    # Search LDAP for matching entries that already exist
1531
    my $filter = "(" . 
1532
                 $query->param('searchField') . "=" .
1533
                 "*" .
1534
                 $query->param('searchValue') .
1535
                 "*" .
1536
                 ")";
1537

    
1538
    my @attrs = [ 'sn', 
1539
                  'gn', 
1540
                  'cn', 
1541
                  'o', 
1542
                  'facsimiletelephonenumber', 
1543
                  'mail', 
1544
                  'telephoneNumber', 
1545
                  'title', 
1546
                  'uid', 
1547
                  'labeledURI', 
1548
                  'ou' ];
1549

    
1550
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1551

    
1552
    # Send back the search results
1553
    if ($found) {
1554
      fullTemplate( ('searchResults'), { stage => "searchresults",
1555
                                         allParams => $allParams,
1556
                                         foundAccounts => $found });
1557
    } else {
1558
      $found = "No entries matched your criteria.  Please try again\n";
1559

    
1560
      fullTemplate( ('searchResults'), { stage => "searchresults",
1561
                                         allParams => $allParams,
1562
                                         foundAccounts => $found });
1563
    }
1564

    
1565
    exit();
1566
}
1567

    
1568
#
1569
# search the LDAP directory to see if a similar account already exists
1570
#
1571
sub searchDirectory {
1572
    my $ldapurl = shift;
1573
    my $base = shift;
1574
    my $filter = shift;
1575
    my $attref = shift;
1576

    
1577
	my $mesg;
1578
    my $foundAccounts = 0;
1579
    
1580
    #if ldap server is down, a html file containing warning message will be returned
1581
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1582
    
1583
    if ($ldap) {
1584
    	$ldap->start_tls( verify => 'require',
1585
                      cafile => $ldapServerCACertFile);
1586
    	$ldap->bind( version => 3, anonymous => 1);
1587
    	my $mesg = $ldap->search (
1588
        	base   => $base,
1589
        	filter => $filter,
1590
        	attrs => @$attref,
1591
    	);
1592

    
1593
    	if ($mesg->count() > 0) {
1594
        	$foundAccounts = "";
1595
        	my $entry;
1596
        	foreach $entry ($mesg->sorted(['sn'])) {
1597
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1598
          		$foundAccounts .= "<a href=\"" unless 
1599
                    (!$entry->get_value('labeledURI'));
1600
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1601
                    (!$entry->get_value('labeledURI'));
1602
          		$foundAccounts .= "\">\n" unless 
1603
                    (!$entry->get_value('labeledURI'));
1604
          		$foundAccounts .= $entry->get_value('givenName');
1605
          		$foundAccounts .= "</a>\n" unless 
1606
                    (!$entry->get_value('labeledURI'));
1607
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1608
          		$foundAccounts .= "<a href=\"" unless 
1609
                    (!$entry->get_value('labeledURI'));
1610
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1611
                    (!$entry->get_value('labeledURI'));
1612
          		$foundAccounts .= "\">\n" unless 
1613
                    (!$entry->get_value('labeledURI'));
1614
          		$foundAccounts .= $entry->get_value('sn');
1615
          		$foundAccounts .= "</a>\n";
1616
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1617
          		$foundAccounts .= $entry->get_value('mail');
1618
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1619
          		$foundAccounts .= $entry->get_value('telephonenumber');
1620
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1621
          		$foundAccounts .= $entry->get_value('title');
1622
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1623
          		$foundAccounts .= $entry->get_value('ou');
1624
          		$foundAccounts .= "\n</td>\n";
1625
          		$foundAccounts .= "</tr>\n";
1626
        	}
1627
    	}
1628
    	$ldap->unbind;   # take down session
1629
    }
1630
    return $foundAccounts;
1631
}
1632

    
1633
sub debug {
1634
    my $msg = shift;
1635
    
1636
    if ($debug) {
1637
        print STDERR "LDAPweb: $msg\n";
1638
    }
1639
}
1640

    
1641
sub handleLDAPBindFailure {
1642
    my $ldapAttemptUrl = shift;
1643
    my $primaryLdap =  $properties->getProperty('auth.url');
1644

    
1645
    if ($ldapAttemptUrl eq  $primaryLdap) {
1646
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1647
    } else {
1648
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1649
    }
1650
}
1651

    
1652
sub handleGeneralServerFailure {
1653
    my $errorMessage = shift;
1654
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1655
    exit(0);   
1656
   }
1657
    
1658
sub setVars {
1659
    my $paramVars = shift;
1660
    # initialize default parameters 
1661
    my $templateVars = { cfg => $cfg,
1662
                         styleSkinsPath => $contextUrl . "/style/skins",
1663
                         styleCommonPath => $contextUrl . "/style/common",
1664
                         contextUrl => $contextUrl,
1665
                         cgiPrefix => $cgiPrefix,
1666
                         orgList => \@validDisplayOrgList,
1667
                         config  => $config,
1668
    };
1669
    
1670
    # append customized params
1671
    while (my ($k, $v) = each (%$paramVars)) {
1672
        $templateVars->{$k} = $v;
1673
    }
1674
    
1675
    return $templateVars;
1676
} 
1677

    
1678
#Method to get the next avaliable uid number. We use the mechanism - http://www.rexconsulting.net/ldap-protocol-uidNumber.html
1679
sub getNextUidNumber {
1680

    
1681
    my $maxAttempt = $properties->getProperty('ldap.nextuid.maxattempt');
1682
    
1683
    my $ldapUsername = shift;
1684
    my $ldapPassword = shift;
1685
    
1686
    my $realUidNumber;
1687
    my $uidNumber;
1688
    my $entry;
1689
    my $mesg;
1690
    my $ldap;
1691
    
1692
    debug("ldap server: $ldapurl");
1693
    
1694
    #if main ldap server is down, a html file containing warning message will be returned
1695
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1696
    
1697
    if ($ldap) {
1698
    	my $existingHighUid=getExistingHighestUidNum($ldapUsername, $ldapPassword);
1699
        $ldap->start_tls( verify => 'require',
1700
                      cafile => $ldapServerCACertFile);
1701
        my $bindresult = $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword);
1702
        #read the uid value stored in uidObject class
1703
        for(my $index=0; $index<$maxAttempt; $index++) {
1704
            $mesg = $ldap->search(base  => $dn_store_next_uid, filter => '(objectClass=*)');
1705
            if ($mesg->count() > 0) {
1706
                debug("Find the cn - $dn_store_next_uid");
1707
                $entry = $mesg->pop_entry;
1708
                $uidNumber = $entry->get_value($attribute_name_store_next_uid);
1709
                if($uidNumber) {
1710
                    if (looks_like_number($uidNumber)) {
1711
                        debug("uid number is $uidNumber");
1712
                        #remove the uid attribute with the read value
1713
                        my $delMesg = $ldap->modify($dn_store_next_uid, delete => { $attribute_name_store_next_uid => $uidNumber});
1714
                        if($delMesg->is_error()) {
1715
                            my $error=$delMesg->error();
1716
                            my $errorName = $delMesg->error_name();
1717
                            debug("can't remove the attribute - $error");
1718
                            debug("can't remove the attribute and the error name - $errorName");
1719
                            #can't remove the attribute with the specified value - that means somebody modify the value in another route, so try it again
1720
                        } else {
1721
                            debug("Remove the attribute successfully and write a new increased value back");
1722
                            if($existingHighUid) {
1723
                            	debug("exiting high uid exists =======================================");
1724
                            	if($uidNumber <= $existingHighUid ) {
1725
                            		debug("The stored uidNumber $uidNumber is less than or equals the used uidNumber $existingHighUid, so we will use the new number which is $existingHighUid+1");
1726
                            		$uidNumber = $existingHighUid +1;
1727
                            	} 
1728
                            }                  
1729
                            my $newValue = $uidNumber +1;
1730
                            $delMesg = $ldap->modify($dn_store_next_uid, add => {$attribute_name_store_next_uid => $newValue});
1731
                            $realUidNumber = $uidNumber;
1732
                            last;
1733
                        }
1734
                    }
1735
                    
1736
               } else {
1737
                 debug("can't find the attribute - $attribute_name_store_next_uid in the $dn_store_next_uid and we will try again");
1738
               }
1739
            } 
1740
        }
1741
        $ldap->unbind;   # take down session
1742
    }
1743
    return $realUidNumber;
1744
}
1745

    
1746
#Method to get the existing high uidNumber in the account tree.
1747
sub getExistingHighestUidNum {
1748
    my $ldapUsername = shift;
1749
    my $ldapPassword = shift;
1750
   
1751
    my $high;
1752
    my $ldap;
1753
    my $storedUidNumber;
1754
    
1755
    
1756
    #if main ldap server is down, a html file containing warning message will be returned
1757
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1758
    if ($ldap) {
1759
        $ldap->start_tls( verify => 'require',
1760
                      cafile => $ldapServerCACertFile);
1761
        my $bindresult = $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword);
1762
        my $mesg = $ldap->search(base  => $dn_store_next_uid, filter => '(objectClass=*)');
1763
         if ($mesg->count() > 0) {
1764
                debug("Find the cn - $dn_store_next_uid");
1765
                my  $entry = $mesg->pop_entry;
1766
                $storedUidNumber = $entry->get_value($attribute_name_store_next_uid);
1767
        }
1768
        my $authBase = $properties->getProperty("auth.base");
1769
        my $uids = $ldap->search(
1770
                        base => $authBase,
1771
                        scope => "sub",
1772
                        filter => "uidNumber=*", 
1773
                        attrs   => [ 'uidNumber' ],
1774
                        );
1775
       return unless $uids->count;
1776
  	    my @uids;
1777
        if ($uids->count > 0) {
1778
                foreach my $uid ($uids->all_entries) {
1779
                		if($storedUidNumber) {
1780
                			if( $uid->get_value('uidNumber') >= $storedUidNumber) {
1781
                				push @uids, $uid->get_value('uidNumber');
1782
                			}
1783
                		} else {
1784
                        	push @uids, $uid->get_value('uidNumber');
1785
                        }
1786
                }
1787
        }       
1788
        
1789
        if(@uids) {
1790
        	@uids = sort { $b <=> $a } @uids;
1791
        	$high = $uids[0];   
1792
        }    
1793
        debug("the highest exiting uidnumber is $high");
1794
        $ldap->unbind;   # take down session
1795
    }
1796
    return $high;
1797

    
1798
}
1799

    
1800