Project

General

Profile

1
#!/usr/bin/perl -w
2
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California 
5
#
6
#   '$Author: cjones $'
7
#     '$Date: 2016-12-21 11:25:39 -0800 (Wed, 21 Dec 2016) $'
8
# '$Revision: 10143 $' 
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
        my $contact;
981
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
982
        # Send the email message to them
983
        my $smtp = Net::SMTP->new($mailhost);
984
        $smtp->mail($sender);
985
        $smtp->to($recipient);
986

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

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

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

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

    
1031
    my $foundAccounts = 0;
1032

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

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

    
1070
    my $foundAccounts = 0;
1071

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

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

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

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

    
1146
    return $foundAccounts;
1147
}
1148

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

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

    
1164
    return $allValid;
1165
}
1166

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

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

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

    
1293
    
1294
    #$$additions[$#$additions + 1] = 'o';
1295
    #$$additions[$#$additions + 1] = $org;
1296
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1297
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1298
    
1299
    
1300
    ####################send the verification email to the user
1301
    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.
1302
    
1303
    my $overrideURL;
1304
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1305
    debug("the overrideURL is $overrideURL");
1306
    if (defined($overrideURL) && !($overrideURL eq '')) {
1307
    	$link = $serverUrl . $overrideURL . $link;
1308
    } else {
1309
    	$link = $serverUrl . $link;
1310
    }
1311
    
1312
    my $mailhost = $properties->getProperty('email.mailhost');
1313
    my $sender;
1314
    my $contact;
1315
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1316
    $contact = $skinProperties->getProperty("email.contact") or $contact = $properties->getProperty('email.contact');
1317
    debug("the sender is " . $sender);
1318
    debug("the contact is :" . $contact);
1319
    my $recipient = $query->param('mail');
1320
    # Send the email message to them
1321
    my $smtp = Net::SMTP->new($mailhost) or do {  
1322
                                                  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 " . 
1323
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1324
                                                  exit(0);
1325
                                               };
1326
    $smtp->mail($sender);
1327
    $smtp->to($recipient);
1328

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

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

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

    
1407

    
1408

    
1409

    
1410

    
1411

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

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

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

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

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

    
1491
}
1492

    
1493
sub handleResponseMessage {
1494

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

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

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

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

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

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

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

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

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

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

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

    
1566
    exit();
1567
}
1568

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

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

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

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

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

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

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

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

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

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

    
1799
}
1800

    
1801

    
(10-10/14)