Project

General

Profile

1 2341 sgarg
#!/usr/bin/perl -w
2 4865 walbridge
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California
5
#
6
#   '$Author$'
7
#     '$Date$'
8
# '$Revision$'
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 2341 sgarg
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 4394 walbridge
30
use lib '../WEB-INF/lib';
31 4080 daigle
use strict;             # turn on strict syntax checking
32
use Template;           # load the template-toolkit module
33 4394 walbridge
use CGI qw/:standard :html3/; # load the CGI module
34 4080 daigle
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 8351 leinfelder
use DateTime;			# for parsing dates
42
use DateTime::Duration; # for substracting
43 8166 tao
use Captcha::reCAPTCHA; # for protection against spams
44 4394 walbridge
use Cwd 'abs_path';
45 8413 tao
use Scalar::Util qw(looks_like_number);
46 2341 sgarg
47 4080 daigle
# Global configuration paramters
48 4394 walbridge
# This entire block (including skin parsing) could be pushed out to a separate .pm file
49 4080 daigle
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 4394 walbridge
    print "Content-type: text/html\n\n";
55 4080 daigle
    print "Unable to locate Metacat properties. Working directory is set as " .
56
        $workingDirectory .", is this correct?";
57
    exit(0);
58
}
59 2341 sgarg
60 4080 daigle
$properties->load(*METACAT_PROPERTIES);
61 4010 tao
62 4394 walbridge
# 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 7199 leinfelder
my $protocol = 'http://';
70
if ( $properties->getProperty('server.httpPort') eq '443' ) {
71
	$protocol = 'https://';
72
}
73 8253 leinfelder
my $serverUrl = $protocol . $properties->getProperty('server.name');
74 4864 walbridge
if ($properties->getProperty('server.httpPort') ne '80') {
75 8253 leinfelder
        $serverUrl = $serverUrl . ':' . $properties->getProperty('server.httpPort');
76 4864 walbridge
}
77 8253 leinfelder
my $context = $properties->getProperty('application.context');
78
my $contextUrl = $serverUrl . '/' .  $context;
79 4394 walbridge
80
my $metacatUrl = $contextUrl . "/metacat";
81 8253 leinfelder
my $cgiPrefix = "/" . $context . "/cgi-bin";
82 4394 walbridge
my $styleSkinsPath = $contextUrl . "/style/skins";
83
my $styleCommonPath = $contextUrl . "/style/common";
84 8403 tao
my $ldapServerCACertFile = $workingDirectory. "/../" . $properties->getProperty('ldap.server.ca.certificate');
85 4394 walbridge
86 8169 tao
#recaptcha key information
87
my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');
88
my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');
89
90 4394 walbridge
my @errorMessages;
91
my $error = 0;
92
93 8181 tao
my $emailVerification= 'emailverification';
94
95 8413 tao
 my $dn_store_next_uid=$properties->getProperty('ldap.nextuid.storing.dn');
96
 my $attribute_name_store_next_uid = $properties->getProperty('ldap.nextuid.storing.attributename');
97
98 4394 walbridge
# Import all of the HTML form fields as variables
99
import_names('FORM');
100
101
# Must have a config to use Metacat
102
my $skinName = "";
103
if ($FORM::cfg) {
104
    $skinName = $FORM::cfg;
105
} elsif ($ARGV[0]) {
106
    $skinName = $ARGV[0];
107
} else {
108 4747 walbridge
    debug("No configuration set.");
109 4394 walbridge
    print "Content-type: text/html\n\n";
110 4749 walbridge
    print 'LDAPweb Error: The registry requires a skin name to continue.';
111 4394 walbridge
    exit();
112
}
113
114
# Metacat isn't initialized, the registry will fail in strange ways.
115
if (!($metacatUrl)) {
116 4747 walbridge
    debug("No Metacat.");
117 4394 walbridge
    print "Content-type: text/html\n\n";
118
    'Registry Error: Metacat is not initialized! Make sure' .
119 5214 walbridge
        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';
120 4394 walbridge
    exit();
121
}
122
123
my $skinProperties = new Config::Properties();
124
if (!($skinName)) {
125
    $error = "Application misconfigured.  Please contact the administrator.";
126
    push(@errorMessages, $error);
127
} else {
128
    my $skinProps = "$skinsDir/$skinName/$skinName.properties";
129
    unless (open (SKIN_PROPERTIES, $skinProps)) {
130
        print "Content-type: text/html\n\n";
131
        print "Unable to locate skin properties at $skinProps.  Is this path correct?";
132
        exit(0);
133
    }
134
    $skinProperties->load(*SKIN_PROPERTIES);
135
}
136
137
my $config = $skinProperties->splitToTree(qr/\./, 'registry.config');
138
139 4870 walbridge
# XXX HACK: this is a temporary fix to pull out the UCNRS password property from the
140
#           NRS skin instead of metacat.properties. The intent is to prevent editing
141
#           of our core properties file, which is manipulated purely through the web.
142
#           Once organizations are editable, this section should be removed as should
143
#           the properties within nrs/nrs.properties.
144
my $nrsProperties = new Config::Properties();
145
my $nrsProps = "$skinsDir/nrs/nrs.properties";
146
unless (open (NRS_PROPERTIES, $nrsProps)) {
147
    print "Content-type: text/html\n\n";
148
    print "Unable to locate skin properties at $nrsProps.  Is this path correct?";
149
    exit(0);
150
}
151
$nrsProperties->load(*NRS_PROPERTIES);
152
153
my $nrsConfig = $nrsProperties->splitToTree(qr/\./, 'registry.config');
154
155
# XXX END HACK
156
157
158 4394 walbridge
my $searchBase;
159
my $ldapUsername;
160
my $ldapPassword;
161 4728 walbridge
# TODO: when should we use surl instead? Is there a setting promoting one over the other?
162
# TODO: the default tree for accounts should be exposed somewhere, defaulting to unaffiliated
163
my $ldapurl = $properties->getProperty('auth.url');
164 4080 daigle
165
# Java uses miliseconds, Perl expects whole seconds
166 4728 walbridge
my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;
167 4080 daigle
168 2341 sgarg
# Get the CGI input variables
169
my $query = new CGI;
170 4747 walbridge
my $debug = 1;
171 2341 sgarg
172
#--------------------------------------------------------------------------80c->
173
# Set up the Template Toolkit to read html form templates
174
175 4080 daigle
# templates hash, imported from ldap.templates tree in metacat.properties
176
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
177 4394 walbridge
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
178
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
179 2341 sgarg
180
# set some configuration options for the template object
181 4394 walbridge
my $ttConfig = {
182
             INCLUDE_PATH => $templatesDir,
183
             INTERPOLATE  => 0,
184
             POST_CHOMP   => 1,
185
             DEBUG        => 1,
186 2341 sgarg
             };
187
188
# create an instance of the template
189 4394 walbridge
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
190 2341 sgarg
191 4080 daigle
# custom LDAP properties hash
192
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
193 2341 sgarg
194 8201 tao
# This is a hash which has the keys of the organization's properties 'name', 'base', 'organization'.
195 4394 walbridge
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
196 8201 tao
197
#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.
198 4394 walbridge
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
199
# pull out properties available e.g. 'name', 'base'
200
my @orgData = keys(%$orgProps);
201 4870 walbridge
202 8201 tao
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.
203 4394 walbridge
while (my ($oKey, $oVal) = each(%$orgNames)) {
204
    push(@orgList, $oKey);
205
}
206
207 4866 walbridge
my $authBase = $properties->getProperty("auth.base");
208 4080 daigle
my $ldapConfig;
209
foreach my $o (@orgList) {
210 4394 walbridge
    foreach my $d (@orgData) {
211
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
212 4080 daigle
    }
213 4866 walbridge
214 4870 walbridge
    # XXX hack, remove after 1.9
215
    if ($o eq 'UCNRS') {
216
        $ldapConfig->{'UCNRS'}{'base'} = $nrsConfig->{'base'};
217
        $ldapConfig->{'UCNRS'}{'user'} = $nrsConfig->{'username'};
218
        $ldapConfig->{'UCNRS'}{'password'} = $nrsConfig->{'password'};
219
    }
220
221 4866 walbridge
    # set default base
222
    if (!$ldapConfig->{$o}{'base'}) {
223
        $ldapConfig->{$o}{'base'} = $authBase;
224
    }
225
226
    # include filter information. By default, our filters are 'o=$name', e.g. 'o=NAPIER'
227
    # these can be overridden by specifying them in metacat.properties. Non-default configs
228
    # such as UCNRS must specify all LDAP properties.
229
    if ($ldapConfig->{$o}{'base'} eq $authBase) {
230
        my $filter = "o=$o";
231
        if (!$ldapConfig->{$o}{'org'}) {
232
            $ldapConfig->{$o}{'org'} = $filter;
233
        }
234
        if (!$ldapConfig->{$o}{'filter'}) {
235 8201 tao
            #$ldapConfig->{$o}{'filter'} = $filter;
236
            $ldapConfig->{$o}{'filter'} = $ldapConfig->{$o}{'org'};
237 4866 walbridge
        }
238
        # also include DN, which is just org + base
239
        if ($ldapConfig->{$o}{'org'}) {
240
            $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'org'} . "," . $ldapConfig->{$o}{'base'};
241
        }
242 4394 walbridge
    } else {
243
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
244
    }
245 4868 walbridge
246
    # set LDAP administrator user account
247 4866 walbridge
    if (!$ldapConfig->{$o}{'user'}) {
248
        $ldapConfig->{$o}{'user'} = $ldapConfig->{'unaffiliated'}{'user'};
249 4865 walbridge
    }
250 4868 walbridge
    # check for a fully qualified LDAP name. If it doesn't exist, append base.
251
    my @userParts = split(',', $ldapConfig->{$o}{'user'});
252
    if (scalar(@userParts) == 1) {
253
        $ldapConfig->{$o}{'user'} = $ldapConfig->{$o}{'user'} . "," . $ldapConfig->{$o}{'base'};
254
    }
255 4866 walbridge
256
    if (!$ldapConfig->{$o}{'password'}) {
257
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
258
    }
259 2341 sgarg
}
260
261 8201 tao
### Determine the display organization list (such as NCEAS, Account ) in the ldap template files
262 8206 tao
my $displayOrgListStr;
263
$displayOrgListStr = $skinProperties->getProperty("ldap.templates.organizationList") or $displayOrgListStr = $properties->getProperty('ldap.templates.organizationList');
264 8207 tao
debug("the string of the org from properties : " . $displayOrgListStr);
265
my @displayOrgList = split(';', $displayOrgListStr);
266
267 8206 tao
my @validDisplayOrgList; #this array contains the org list which will be shown in the templates files.
268 8201 tao
269 8206 tao
my %orgNamesHash = %$orgNames;
270
foreach my $element (@displayOrgList) {
271
    if(exists $orgNamesHash{$element}) {
272 8540 tao
         my $label = $ldapConfig->{$element}{'label'};
273
         my %displayHash;
274
         $displayHash{$element} = $label;
275
         debug("push a hash containing the key " . $element . "with the value label" . $label . " into the display array");
276 8206 tao
         #if the name is found in the organization part of metacat.properties, put it into the valid array
277 8540 tao
         push(@validDisplayOrgList, \%displayHash);
278 8206 tao
    }
279
280
}
281 8201 tao
282 8206 tao
if(!@validDisplayOrgList) {
283
     my $sender;
284
     $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
285
    print "Content-type: text/html\n\n";
286
    print "The value of property ldap.templates.organizationList in "
287
     . $skinName . ".properties file or metacat.properties file (if the property doesn't exist in the "
288
     . $skinName . ".properties file) is invalid. Please send the information to ". $sender;
289
    exit(0);
290
}
291
292
293 2341 sgarg
#--------------------------------------------------------------------------80c->
294
# Define the main program logic that calls subroutines to do the work
295
#--------------------------------------------------------------------------80c->
296
297
# The processing step we are handling
298 4080 daigle
my $stage = $query->param('stage') || $templates->{'stage'};
299 2341 sgarg
300
my $cfg = $query->param('cfg');
301 4767 walbridge
debug("started with stage $stage, cfg $cfg");
302 2341 sgarg
303
# define the possible stages
304
my %stages = (
305
              'initregister'      => \&handleInitRegister,
306
              'register'          => \&handleRegister,
307
              'registerconfirmed' => \&handleRegisterConfirmed,
308
              'simplesearch'      => \&handleSimpleSearch,
309
              'initaddentry'      => \&handleInitAddEntry,
310
              'addentry'          => \&handleAddEntry,
311
              'initmodifyentry'   => \&handleInitModifyEntry,
312
              'modifyentry'       => \&handleModifyEntry,
313 2972 jones
              'changepass'        => \&handleChangePassword,
314
              'initchangepass'    => \&handleInitialChangePassword,
315 2341 sgarg
              'resetpass'         => \&handleResetPassword,
316 2414 sgarg
              'initresetpass'     => \&handleInitialResetPassword,
317 8185 tao
              'emailverification' => \&handleEmailVerification,
318 8229 tao
              'lookupname'        => \&handleLookupName,
319
              'searchnamesbyemail'=> \&handleSearchNameByEmail,
320 8818 tao
              #'getnextuid'        => \&getExistingHighestUidNum,
321 2341 sgarg
             );
322 4394 walbridge
323 2341 sgarg
# call the appropriate routine based on the stage
324
if ( $stages{$stage} ) {
325
  $stages{$stage}->();
326
} else {
327
  &handleResponseMessage();
328
}
329
330
#--------------------------------------------------------------------------80c->
331
# Define the subroutines to do the work
332
#--------------------------------------------------------------------------80c->
333
334 8351 leinfelder
sub clearTemporaryAccounts {
335
336
    #search accounts that have expired
337
	my $org = $query->param('o');
338
    my $ldapUsername = $ldapConfig->{$org}{'user'};
339
    my $ldapPassword = $ldapConfig->{$org}{'password'};
340
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
341
    my $orgExpiration = $ldapConfig->{$org}{'expiration'};
342
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase;
343
344
	my $dt = DateTime->now;
345
	$dt->subtract( hours => $orgExpiration );
346 8354 leinfelder
	my $expirationDate = $dt->ymd("") . $dt->hms("") . "Z";
347 8356 leinfelder
    my $filter = "(&(objectClass=inetOrgPerson)(createTimestamp<=" . $expirationDate . "))";
348
    debug("Clearing expired accounts with filter: " . $filter . ", base: " . $tmpSearchBase);
349 8351 leinfelder
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
350
351
    my $ldap;
352
    my $mesg;
353
354
    my $dn;
355
356
    #if main ldap server is down, a html file containing warning message will be returned
357 8356 leinfelder
    debug("clearTemporaryAccounts: connecting to $ldapurl, $timeout");
358 8351 leinfelder
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
359
    if ($ldap) {
360 8403 tao
    	$ldap->start_tls( verify => 'require',
361
                      cafile => $ldapServerCACertFile);
362 8351 leinfelder
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
363
		$mesg = $ldap->search (
364 8356 leinfelder
			base   => $tmpSearchBase,
365 8351 leinfelder
			filter => $filter,
366
			attrs => \@attrs,
367
		);
368
	    if ($mesg->count() > 0) {
369
			my $entry;
370
			foreach $entry ($mesg->all_entries) {
371
            	$dn = $entry->dn();
372
            	# remove the entry
373 8357 leinfelder
   				debug("Removing expired account: " . $dn);
374
            	$ldap->delete($dn);
375 8351 leinfelder
			}
376
        }
377
    	$ldap->unbind;   # take down session
378
    }
379
380 8354 leinfelder
    return 0;
381 8351 leinfelder
}
382
383 4728 walbridge
sub fullTemplate {
384
    my $templateList = shift;
385
    my $templateVars = setVars(shift);
386 8166 tao
    my $c = Captcha::reCAPTCHA->new;
387
    my $captcha = 'captcha';
388
    #my $error=null;
389
    my $use_ssl= 1;
390
    #my $options=null;
391 8250 leinfelder
    # use the AJAX style, only need to provide the public key to the template
392
    $templateVars->{'recaptchaPublicKey'} = $recaptchaPublicKey;
393
    #$templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
394 4728 walbridge
    $template->process( $templates->{'header'}, $templateVars );
395
    foreach my $tmpl (@{$templateList}) {
396
        $template->process( $templates->{$tmpl}, $templateVars );
397
    }
398
    $template->process( $templates->{'footer'}, $templateVars );
399
}
400
401 8221 tao
402 8229 tao
#
403
# Initialize a form for a user to request the account name associated with an email address
404
#
405
sub handleLookupName {
406
407
    print "Content-type: text/html\n\n";
408
    # process the template files:
409
    fullTemplate(['lookupName']);
410
    exit();
411
}
412 8221 tao
413 2341 sgarg
#
414 8221 tao
# Handle the user's request to look up account names with a specified email address.
415
# This relates to "Forget your user name"
416
#
417 8229 tao
sub handleSearchNameByEmail{
418 8221 tao
419
    print "Content-type: text/html\n\n";
420
421
    my $allParams = {'mail' => $query->param('mail')};
422
    my @requiredParams = ('mail');
423
    if (! paramsAreValid(@requiredParams)) {
424
        my $errorMessage = "Required information is missing. " .
425
            "Please fill in all required fields and resubmit the form.";
426 8229 tao
        fullTemplate(['lookupName'], { allParams => $allParams,
427 8221 tao
                                     errorMessage => $errorMessage });
428
        exit();
429
    }
430
    my $mail = $query->param('mail');
431
432
    #search accounts with the specified emails
433
    $searchBase = $authBase;
434
    my $filter = "(mail=" . $mail . ")";
435
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
436
    my $notHtmlFormat = 1;
437
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs, $notHtmlFormat);
438
    my $accountInfo;
439 8254 leinfelder
    if ($found) {
440 8221 tao
        $accountInfo = $found;
441
    } else {
442 8254 leinfelder
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n";
443 8221 tao
    }
444 8254 leinfelder
445 8221 tao
    my $mailhost = $properties->getProperty('email.mailhost');
446
    my $sender;
447
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
448
    debug("the sender is " . $sender);
449
    my $recipient = $query->param('mail');
450
    # Send the email message to them
451
    my $smtp = Net::SMTP->new($mailhost) or do {
452 8229 tao
                                                  fullTemplate( ['lookupName'], {allParams => $allParams,
453
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " .
454
                                                                $skinProperties->getProperty("email.recipient") . "." });
455 8221 tao
                                                  exit(0);
456
                                               };
457
    $smtp->mail($sender);
458
    $smtp->to($recipient);
459
460
    my $message = <<"     ENDOFMESSAGE";
461
    To: $recipient
462
    From: $sender
463 8234 tao
    Subject: Your Account Information
464 8221 tao
465 8234 tao
    Somebody (hopefully you) looked up the account information associated with the email address.
466
    Here is the account information:
467 8221 tao
468
    $accountInfo
469
470
    Thanks,
471 8234 tao
        $sender
472 8221 tao
473
     ENDOFMESSAGE
474
     $message =~ s/^[ \t\r\f]+//gm;
475
476
     $smtp->data($message);
477
     $smtp->quit;
478
     fullTemplate( ['lookupNameSuccess'] );
479
480
}
481
482
483
#
484 2341 sgarg
# create the initial registration form
485
#
486
sub handleInitRegister {
487
  my $vars = shift;
488
  print "Content-type: text/html\n\n";
489
  # process the template files:
490 4080 daigle
  fullTemplate(['register'], {stage => "register"});
491 2341 sgarg
  exit();
492
}
493
494 8221 tao
495
496 2341 sgarg
#
497
# process input from the register stage, which occurs when
498
# a user submits form data to create a new account
499
#
500
sub handleRegister {
501
502 8258 tao
    #print "Content-type: text/html\n\n";
503 8220 tao
    if ($query->param('o') =~ "LTER") {
504 8258 tao
      print "Content-type: text/html\n\n";
505 8220 tao
      fullTemplate( ['registerLter'] );
506
      exit(0);
507
    }
508 8166 tao
509 2341 sgarg
    my $allParams = { 'givenName' => $query->param('givenName'),
510
                      'sn' => $query->param('sn'),
511
                      'o' => $query->param('o'),
512
                      'mail' => $query->param('mail'),
513
                      'uid' => $query->param('uid'),
514
                      'userPassword' => $query->param('userPassword'),
515
                      'userPassword2' => $query->param('userPassword2'),
516
                      'title' => $query->param('title'),
517
                      'telephoneNumber' => $query->param('telephoneNumber') };
518 8166 tao
519
    # Check the recaptcha
520
    my $c = Captcha::reCAPTCHA->new;
521
    my $challenge = $query->param('recaptcha_challenge_field');
522
    my $response = $query->param('recaptcha_response_field');
523
    # Verify submission
524
    my $result = $c->check_answer(
525 8169 tao
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
526 8166 tao
        $challenge, $response
527
    );
528
529
    if ( $result->{is_valid} ) {
530
        #print "Yes!";
531
        #exit();
532
    }
533
    else {
534 8258 tao
        print "Content-type: text/html\n\n";
535 8166 tao
        my $errorMessage = "The verification code is wrong. Please input again.";
536
        fullTemplate(['register'], { stage => "register",
537
                                     allParams => $allParams,
538
                                     errorMessage => $errorMessage });
539
        exit();
540
    }
541
542
543 2341 sgarg
    # Check that all required fields are provided and not null
544
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail',
545
                           'uid', 'userPassword', 'userPassword2');
546
    if (! paramsAreValid(@requiredParams)) {
547 8258 tao
        print "Content-type: text/html\n\n";
548 2341 sgarg
        my $errorMessage = "Required information is missing. " .
549
            "Please fill in all required fields and resubmit the form.";
550 4080 daigle
        fullTemplate(['register'], { stage => "register",
551
                                     allParams => $allParams,
552
                                     errorMessage => $errorMessage });
553
        exit();
554 2341 sgarg
    } else {
555 8186 tao
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
556 8258 tao
            print "Content-type: text/html\n\n";
557 8186 tao
            my $errorMessage = "The passwords do not match. Try again.";
558
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
559
                                                            allParams => $allParams,
560
                                                            errorMessage => $errorMessage });
561
            exit();
562
        }
563 2972 jones
        my $o = $query->param('o');
564 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
565 2341 sgarg
    }
566 8351 leinfelder
567
    # Remove any expired temporary accounts for this subtree before continuing
568
    clearTemporaryAccounts();
569 2341 sgarg
570
    # Search LDAP for matching entries that already exist
571
    # Some forms use a single text search box, whereas others search per
572
    # attribute.
573
    my $filter;
574
    if ($query->param('searchField')) {
575
576
      $filter = "(|" .
577
                "(uid=" . $query->param('searchField') . ") " .
578
                "(mail=" . $query->param('searchField') . ")" .
579
                "(&(sn=" . $query->param('searchField') . ") " .
580
                "(givenName=" . $query->param('searchField') . "))" .
581
                ")";
582
    } else {
583
      $filter = "(|" .
584
                "(uid=" . $query->param('uid') . ") " .
585
                "(mail=" . $query->param('mail') . ")" .
586
                "(&(sn=" . $query->param('sn') . ") " .
587
                "(givenName=" . $query->param('givenName') . "))" .
588
                ")";
589
    }
590
591 8217 tao
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
592 2341 sgarg
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
593
594
    # If entries match, send back a request to confirm new-user creation
595
    if ($found) {
596 8261 tao
      print "Content-type: text/html\n\n";
597 4080 daigle
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
598
                                                     allParams => $allParams,
599
                                                     foundAccounts => $found });
600 2341 sgarg
    # Otherwise, create a new user in the LDAP directory
601
    } else {
602 8180 tao
        createTemporaryAccount($allParams);
603 2341 sgarg
    }
604
605
    exit();
606
}
607
608
#
609
# process input from the registerconfirmed stage, which occurs when
610
# a user chooses to create an account despite similarities to other
611
# existing accounts
612
#
613
sub handleRegisterConfirmed {
614
615
    my $allParams = { 'givenName' => $query->param('givenName'),
616
                      'sn' => $query->param('sn'),
617 8207 tao
                      'o' => $query->param('o'),
618 2341 sgarg
                      'mail' => $query->param('mail'),
619
                      'uid' => $query->param('uid'),
620
                      'userPassword' => $query->param('userPassword'),
621
                      'userPassword2' => $query->param('userPassword2'),
622
                      'title' => $query->param('title'),
623
                      'telephoneNumber' => $query->param('telephoneNumber') };
624 8258 tao
    #print "Content-type: text/html\n\n";
625 8180 tao
    createTemporaryAccount($allParams);
626 2341 sgarg
    exit();
627
}
628
629
#
630
# change a user's password upon request
631
#
632
sub handleChangePassword {
633
634
    print "Content-type: text/html\n\n";
635
636
    my $allParams = { 'test' => "1", };
637
    if ($query->param('uid')) {
638
        $$allParams{'uid'} = $query->param('uid');
639
    }
640
    if ($query->param('o')) {
641
        $$allParams{'o'} = $query->param('o');
642 2972 jones
        my $o = $query->param('o');
643
644 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
645 2341 sgarg
    }
646
647
648
    # Check that all required fields are provided and not null
649
    my @requiredParams = ( 'uid', 'o', 'oldpass',
650
                           'userPassword', 'userPassword2');
651
    if (! paramsAreValid(@requiredParams)) {
652
        my $errorMessage = "Required information is missing. " .
653
            "Please fill in all required fields and submit the form.";
654 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
655
                                        allParams => $allParams,
656
                                        errorMessage => $errorMessage });
657
        exit();
658 2341 sgarg
    }
659
660
    # We have all of the info we need, so try to change the password
661
    if ($query->param('userPassword') =~ $query->param('userPassword2')) {
662
663 2972 jones
        my $o = $query->param('o');
664 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
665
        $ldapUsername = $ldapConfig->{$o}{'user'};
666
        $ldapPassword = $ldapConfig->{$o}{'password'};
667 2341 sgarg
668 4080 daigle
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
669 2341 sgarg
        if ($query->param('o') =~ "LTER") {
670 4080 daigle
            fullTemplate( ['registerLter'] );
671 2341 sgarg
        } else {
672
            my $errorMessage = changePassword(
673
                    $dn, $query->param('userPassword'),
674
                    $dn, $query->param('oldpass'), $query->param('o'));
675 2972 jones
            if ($errorMessage) {
676 4080 daigle
                fullTemplate( ['changePass'], { stage => "changepass",
677
                                                allParams => $allParams,
678
                                                errorMessage => $errorMessage });
679
                exit();
680 2341 sgarg
            } else {
681 4080 daigle
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
682
                                                       allParams => $allParams });
683
                exit();
684 2341 sgarg
            }
685
        }
686
    } else {
687
        my $errorMessage = "The passwords do not match. Try again.";
688 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
689
                                        allParams => $allParams,
690
                                        errorMessage => $errorMessage });
691
        exit();
692 2341 sgarg
    }
693
}
694
695
#
696 2414 sgarg
# change a user's password upon request - no input params
697
# only display chagepass template without any error
698
#
699
sub handleInitialChangePassword {
700
    print "Content-type: text/html\n\n";
701
702
    my $allParams = { 'test' => "1", };
703
    my $errorMessage = "";
704 4080 daigle
    fullTemplate( ['changePass'], { stage => "changepass",
705
                                    errorMessage => $errorMessage });
706
    exit();
707 2414 sgarg
}
708
709
#
710 2341 sgarg
# reset a user's password upon request
711
#
712
sub handleResetPassword {
713
714
    print "Content-type: text/html\n\n";
715
716
    my $allParams = { 'test' => "1", };
717
    if ($query->param('uid')) {
718
        $$allParams{'uid'} = $query->param('uid');
719
    }
720
    if ($query->param('o')) {
721
        $$allParams{'o'} = $query->param('o');
722 2972 jones
        my $o = $query->param('o');
723
724 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
725 4868 walbridge
        $ldapUsername = $ldapConfig->{$o}{'user'};
726 4080 daigle
        $ldapPassword = $ldapConfig->{$o}{'password'};
727 2341 sgarg
    }
728
729
    # Check that all required fields are provided and not null
730
    my @requiredParams = ( 'uid', 'o' );
731
    if (! paramsAreValid(@requiredParams)) {
732
        my $errorMessage = "Required information is missing. " .
733
            "Please fill in all required fields and submit the form.";
734 4080 daigle
        fullTemplate( ['resetPass'],  { stage => "resetpass",
735
                                        allParams => $allParams,
736
                                        errorMessage => $errorMessage });
737
        exit();
738 2341 sgarg
    }
739
740
    # We have all of the info we need, so try to change the password
741
    my $o = $query->param('o');
742 4080 daigle
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
743 4866 walbridge
    debug("handleResetPassword: dn: $dn");
744 2341 sgarg
    if ($query->param('o') =~ "LTER") {
745 4080 daigle
        fullTemplate( ['registerLter'] );
746
        exit();
747 2341 sgarg
    } else {
748
        my $errorMessage = "";
749
        my $recipient;
750
        my $userPass;
751
        my $entry = getLdapEntry($ldapurl, $searchBase,
752
                $query->param('uid'), $query->param('o'));
753
754
        if ($entry) {
755
            $recipient = $entry->get_value('mail');
756
            $userPass = getRandomPassword();
757 4080 daigle
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
758 2341 sgarg
        } else {
759
            $errorMessage = "User not found in database.  Please try again.";
760
        }
761
762
        if ($errorMessage) {
763 4080 daigle
            fullTemplate( ['resetPass'], { stage => "resetpass",
764
                                           allParams => $allParams,
765
                                           errorMessage => $errorMessage });
766
            exit();
767 2341 sgarg
        } else {
768
            my $errorMessage = sendPasswordNotification($query->param('uid'),
769 2972 jones
                    $query->param('o'), $userPass, $recipient, $cfg);
770 4080 daigle
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
771
                                                  allParams => $allParams,
772
                                                  errorMessage => $errorMessage });
773
            exit();
774 2341 sgarg
        }
775
    }
776
}
777
778
#
779 2414 sgarg
# reset a user's password upon request- no initial params
780
# only display resetpass template without any error
781
#
782
sub handleInitialResetPassword {
783
    print "Content-type: text/html\n\n";
784
    my $errorMessage = "";
785 4080 daigle
    fullTemplate( ['resetPass'], { stage => "resetpass",
786
                                   errorMessage => $errorMessage });
787
    exit();
788 2414 sgarg
}
789
790
#
791 2341 sgarg
# Construct a random string to use for a newly reset password
792
#
793
sub getRandomPassword {
794
    my $length = shift;
795
    if (!$length) {
796
        $length = 8;
797
    }
798
    my $newPass = "";
799
800
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
801
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
802
    return $newPass;
803
}
804
805
#
806
# Change a password to a new value, binding as the provided user
807
#
808
sub changePassword {
809
    my $userDN = shift;
810
    my $userPass = shift;
811
    my $bindDN = shift;
812
    my $bindPass = shift;
813
    my $o = shift;
814
815 4080 daigle
    my $searchBase = $ldapConfig->{$o}{'base'};
816 4868 walbridge
817 2341 sgarg
    my $errorMessage = 0;
818 3177 tao
    my $ldap;
819 4868 walbridge
820 4771 walbridge
    #if main ldap server is down, a html file containing warning message will be returned
821
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
822 4394 walbridge
823 4849 daigle
    if ($ldap) {
824 8403 tao
        $ldap->start_tls( verify => 'require',
825
                      cafile => $ldapServerCACertFile);
826 4868 walbridge
        debug("changePassword: attempting to bind to $bindDN");
827
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN,
828 2341 sgarg
                                  password => $bindPass );
829 4868 walbridge
        if ($bindresult->code) {
830
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
831
                            "correct? Please correct and try again...";
832
            return $errorMessage;
833
        }
834 2341 sgarg
835 4849 daigle
    	# Find the user here and change their entry
836
    	my $newpass = createSeededPassHash($userPass);
837
    	my $modifications = { userPassword => $newpass };
838 4868 walbridge
      debug("changePass: setting password for $userDN to $newpass");
839 4849 daigle
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
840 2341 sgarg
841 4849 daigle
    	if ($result->code()) {
842 4866 walbridge
            debug("changePass: error changing password: " . $result->error);
843
        	$errorMessage = "There was an error changing the password:" .
844 2341 sgarg
                           "<br />\n" . $result->error;
845 4849 daigle
    	}
846
    	$ldap->unbind;   # take down session
847
    }
848 2341 sgarg
849
    return $errorMessage;
850
}
851
852
#
853
# generate a Seeded SHA1 hash of a plaintext password
854
#
855
sub createSeededPassHash {
856
    my $secret = shift;
857
858
    my $salt = "";
859
    for (my $i=0; $i < 4; $i++) {
860
        $salt .= int(rand(10));
861
    }
862
863
    my $ctx = Digest::SHA1->new;
864
    $ctx->add($secret);
865
    $ctx->add($salt);
866
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
867
868
    return $hashedPasswd;
869
}
870
871
#
872
# Look up an ldap entry for a user
873
#
874
sub getLdapEntry {
875
    my $ldapurl = shift;
876
    my $base = shift;
877
    my $username = shift;
878
    my $org = shift;
879
880
    my $entry = "";
881
    my $mesg;
882 3177 tao
    my $ldap;
883 4749 walbridge
    debug("ldap server: $ldapurl");
884 4394 walbridge
885
    #if main ldap server is down, a html file containing warning message will be returned
886 4771 walbridge
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
887 4849 daigle
888
    if ($ldap) {
889 8501 tao
        $ldap->start_tls( verify => 'none');
890
        #$ldap->start_tls( verify => 'require',
891
        #              cafile => $ldapServerCACertFile);
892 4849 daigle
    	my $bindresult = $ldap->bind;
893
    	if ($bindresult->code) {
894
        	return $entry;
895
    	}
896 2341 sgarg
897 8415 tao
        $base = $ldapConfig->{$org}{'org'} . ',' . $base;
898
        debug("getLdapEntry, searching for $base, (uid=$username)");
899
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
900
    	#if($ldapConfig->{$org}{'filter'}){
901
            #debug("getLdapEntry: filter set, searching for base=$base, " .
902
                  #"(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
903
        	#$mesg = $ldap->search ( base   => $base,
904
                #filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
905
    	#} else {
906
            #debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
907
        	#$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
908
    	#}
909 3177 tao
910 4849 daigle
    	if ($mesg->count > 0) {
911
        	$entry = $mesg->pop_entry;
912
        	$ldap->unbind;   # take down session
913
    	} else {
914
        	$ldap->unbind;   # take down session
915
        	# Follow references by recursive call to self
916
        	my @references = $mesg->references();
917
        	for (my $i = 0; $i <= $#references; $i++) {
918
            	my $uri = URI->new($references[$i]);
919
            	my $host = $uri->host();
920
            	my $path = $uri->path();
921
            	$path =~ s/^\///;
922
            	$entry = &getLdapEntry($host, $path, $username, $org);
923
            	if ($entry) {
924 4865 walbridge
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
925 4849 daigle
                	return $entry;
926
            	}
927
        	}
928
    	}
929 2341 sgarg
    }
930
    return $entry;
931
}
932
933
#
934
# send an email message notifying the user of the pw change
935
#
936
sub sendPasswordNotification {
937
    my $username = shift;
938
    my $org = shift;
939
    my $newPass = shift;
940
    my $recipient = shift;
941 2972 jones
    my $cfg = shift;
942 2341 sgarg
943
    my $errorMessage = "";
944
    if ($recipient) {
945 8254 leinfelder
946 4771 walbridge
        my $mailhost = $properties->getProperty('email.mailhost');
947 8197 tao
        my $sender;
948
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
949 2341 sgarg
        # Send the email message to them
950
        my $smtp = Net::SMTP->new($mailhost);
951
        $smtp->mail($sender);
952
        $smtp->to($recipient);
953
954
        my $message = <<"        ENDOFMESSAGE";
955
        To: $recipient
956
        From: $sender
957 8234 tao
        Subject: Your Account Password Reset
958 2341 sgarg
959 8234 tao
        Somebody (hopefully you) requested that your account password be reset.
960 8259 leinfelder
        Your temporary password is below. Please change it as soon as possible
961 8413 tao
        at: $contextUrl/style/skins/account/.
962 2341 sgarg
963
            Username: $username
964
        Organization: $org
965
        New Password: $newPass
966
967
        Thanks,
968 8234 tao
            $sender
969 2341 sgarg
970
        ENDOFMESSAGE
971
        $message =~ s/^[ \t\r\f]+//gm;
972
973
        $smtp->data($message);
974
        $smtp->quit;
975
    } else {
976
        $errorMessage = "Failed to send password because I " .
977
                        "couldn't find a valid email address.";
978
    }
979
    return $errorMessage;
980
}
981
982
#
983
# search the LDAP directory to see if a similar account already exists
984
#
985
sub findExistingAccounts {
986
    my $ldapurl = shift;
987
    my $base = shift;
988
    my $filter = shift;
989
    my $attref = shift;
990 8221 tao
    my $notHtmlFormat = shift;
991 3175 tao
    my $ldap;
992 4847 daigle
    my $mesg;
993 2341 sgarg
994
    my $foundAccounts = 0;
995 4749 walbridge
996 4394 walbridge
    #if main ldap server is down, a html file containing warning message will be returned
997 4868 walbridge
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
998 4771 walbridge
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
999 4845 daigle
    if ($ldap) {
1000 8501 tao
    	$ldap->start_tls( verify => 'none');
1001
    	#$ldap->start_tls( verify => 'require',
1002
        #              cafile => $ldapServerCACertFile);
1003 4845 daigle
    	$ldap->bind( version => 3, anonymous => 1);
1004 4848 daigle
		$mesg = $ldap->search (
1005 4845 daigle
			base   => $base,
1006
			filter => $filter,
1007
			attrs => @$attref,
1008
		);
1009 2341 sgarg
1010 4845 daigle
	    if ($mesg->count() > 0) {
1011
			$foundAccounts = "";
1012
			my $entry;
1013
			foreach $entry ($mesg->all_entries) {
1014 5650 walbridge
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
1015
                # this could be done directly with filters on the LDAP connection, instead.
1016 8217 tao
                #if ($entry->dn !~ /ou=Account/) {
1017 8221 tao
                    if($notHtmlFormat) {
1018
                        $foundAccounts .= "\nAccount: ";
1019
                    } else {
1020
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
1021
                    }
1022 5650 walbridge
                    $foundAccounts .= $entry->dn();
1023 8221 tao
                    if($notHtmlFormat) {
1024
                        $foundAccounts .= "\n";
1025
                    } else {
1026
                        $foundAccounts .= "</b><br />\n";
1027
                    }
1028 5650 walbridge
                    foreach my $attribute ($entry->attributes()) {
1029
                        my $value = $entry->get_value($attribute);
1030
                        $foundAccounts .= "$attribute: ";
1031
                        $foundAccounts .= $value;
1032 8221 tao
                         if($notHtmlFormat) {
1033
                            $foundAccounts .= "\n";
1034
                        } else {
1035
                            $foundAccounts .= "<br />\n";
1036
                        }
1037 5650 walbridge
                    }
1038 8221 tao
                    if($notHtmlFormat) {
1039
                        $foundAccounts .= "\n";
1040
                    } else {
1041
                        $foundAccounts .= "</p>\n";
1042
                    }
1043
1044 8217 tao
                #}
1045 4845 daigle
			}
1046 2341 sgarg
        }
1047 4845 daigle
    	$ldap->unbind;   # take down session
1048 2341 sgarg
1049 4848 daigle
    	# Follow references
1050
    	my @references = $mesg->references();
1051
    	for (my $i = 0; $i <= $#references; $i++) {
1052
        	my $uri = URI->new($references[$i]);
1053
        	my $host = $uri->host();
1054
        	my $path = $uri->path();
1055
        	$path =~ s/^\///;
1056 8254 leinfelder
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
1057 4848 daigle
        	if ($refFound) {
1058
            	$foundAccounts .= $refFound;
1059
        	}
1060
    	}
1061 2341 sgarg
    }
1062
1063
    #print "<p>Checking referrals...</p>\n";
1064
    #my @referrals = $mesg->referrals();
1065
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
1066
    #for (my $i = 0; $i <= $#referrals; $i++) {
1067
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
1068
    #}
1069
1070
    return $foundAccounts;
1071
}
1072
1073
#
1074
# Validate that we have the proper set of input parameters
1075
#
1076
sub paramsAreValid {
1077
    my @pnames = @_;
1078
1079
    my $allValid = 1;
1080
    foreach my $parameter (@pnames) {
1081
        if (!defined($query->param($parameter)) ||
1082
            ! $query->param($parameter) ||
1083
            $query->param($parameter) =~ /^\s+$/) {
1084
            $allValid = 0;
1085
        }
1086
    }
1087
1088
    return $allValid;
1089
}
1090
1091
#
1092 8175 tao
# Create a temporary account for a user and send an email with a link which can click for the
1093
# verification. This is used to protect the ldap server against spams.
1094
#
1095
sub createTemporaryAccount {
1096
    my $allParams = shift;
1097 8180 tao
    my $org = $query->param('o');
1098 8220 tao
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1099
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1100
    my $tmp = 1;
1101 8185 tao
1102 8220 tao
    ################## 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
1103
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
1104
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase;
1105
    my $tmpFilter = "dc=tmp";
1106
    my @attributes=['dc'];
1107
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
1108
    if (!$foundTmp) {
1109
        my $dn = $tmpSearchBase;
1110
        my $additions = [
1111
                    'dc' => 'tmp',
1112
                    'o'  => 'tmp',
1113
                    'objectclass' => ['top', 'dcObject', 'organization']
1114
                    ];
1115
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1116
    } else {
1117
     debug("found the tmp space");
1118
    }
1119 8175 tao
1120 8220 tao
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1121 8201 tao
    my $filter = $ldapConfig->{$org}{'filter'};
1122 8220 tao
1123 8176 tao
    debug("search filer " . $filter);
1124
    debug("ldap server ". $ldapurl);
1125
    debug("sesarch base " . $tmpSearchBase);
1126 8262 tao
    #print "Content-type: text/html\n\n";
1127 8175 tao
    my @attrs = ['o', 'ou' ];
1128
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1129 8220 tao
1130
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
1131
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
1132
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
1133 8180 tao
1134 8176 tao
    if(!$found) {
1135 8180 tao
        debug("generate the subtree in the dc=tmp===========================");
1136 8176 tao
        #need to generate the subtree o or ou
1137 8220 tao
        my $additions;
1138 8207 tao
            if($organization eq 'ou') {
1139
                $additions = [
1140
                    $organization   => $organizationName,
1141
                    'objectclass' => ['top', 'organizationalUnit']
1142
                    ];
1143
1144
            } else {
1145
                $additions = [
1146
                    $organization   => $organizationName,
1147
                    'objectclass' => ['top', 'organization']
1148
                    ];
1149
1150
            }
1151 8220 tao
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1152
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1153 8176 tao
    }
1154 8175 tao
1155 8180 tao
    ################create an account under tmp subtree
1156 8176 tao
1157 8413 tao
     my $dn_store_next_uid=$properties->getProperty('ldap.nextuid.storing.dn');
1158
    my $attribute_name_store_next_uid = $properties->getProperty('ldap.nextuid.storing.attributename');
1159 8411 tao
    #get the next avaliable uid number. If it fails, the program will exist.
1160
    my $nextUidNumber = getNextUidNumber($ldapUsername, $ldapPassword);
1161
    if(!$nextUidNumber) {
1162
        print "Content-type: text/html\n\n";
1163
         my $sender;
1164
        $sender = $skinProperties->getProperty("email.recipient") or $sender = $properties->getProperty('email.recipient');
1165 8413 tao
        my $errorMessage = "The Identity Service can't get the next avaliable uid number. Please try again.  If the issue persists, please contact the administrator - $sender.
1166
                           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
1167
                           is not a number; or lots of users were registering and you couldn't get a lock on the dn - $dn_store_next_uid.";
1168 8411 tao
        fullTemplate(['register'], { stage => "register",
1169
                                     allParams => $allParams,
1170
                                     errorMessage => $errorMessage });
1171
        exit(0);
1172
    }
1173
    my $cn = join(" ", $query->param('givenName'), $query->param('sn'));
1174 8180 tao
    #generate a randomstr for matching the email.
1175
    my $randomStr = getRandomPassword(16);
1176
    # Create a hashed version of the password
1177
    my $shapass = createSeededPassHash($query->param('userPassword'));
1178
    my $additions = [
1179
                'uid'   => $query->param('uid'),
1180 8411 tao
                'cn'   => $cn,
1181 8180 tao
                'sn'   => $query->param('sn'),
1182
                'givenName'   => $query->param('givenName'),
1183
                'mail' => $query->param('mail'),
1184
                'userPassword' => $shapass,
1185
                'employeeNumber' => $randomStr,
1186 8411 tao
                'uidNumber' => $nextUidNumber,
1187
                'gidNumber' => $nextUidNumber,
1188
                'loginShell' => '/sbin/nologin',
1189
                'homeDirectory' => '/dev/null',
1190 8180 tao
                'objectclass' => ['top', 'person', 'organizationalPerson',
1191 8411 tao
                                'inetOrgPerson', 'posixAccount', 'shadowAccount' ],
1192 8201 tao
                $organization   => $organizationName
1193 8180 tao
                ];
1194 8411 tao
    my $gecos;
1195 8180 tao
    if (defined($query->param('telephoneNumber')) &&
1196
                $query->param('telephoneNumber') &&
1197
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1198
                $$additions[$#$additions + 1] = 'telephoneNumber';
1199
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1200 8411 tao
                $gecos = $cn . ',,'. $query->param('telephoneNumber'). ',';
1201
    } else {
1202
        $gecos = $cn . ',,,';
1203 8180 tao
    }
1204 8411 tao
1205
    $$additions[$#$additions + 1] = 'gecos';
1206
    $$additions[$#$additions + 1] = $gecos;
1207
1208 8180 tao
    if (defined($query->param('title')) &&
1209
                $query->param('title') &&
1210
                ! $query->param('title') =~ /^\s+$/) {
1211
                $$additions[$#$additions + 1] = 'title';
1212
                $$additions[$#$additions + 1] = $query->param('title');
1213
    }
1214 8201 tao
1215
1216
    #$$additions[$#$additions + 1] = 'o';
1217
    #$$additions[$#$additions + 1] = $org;
1218
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1219 8220 tao
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1220 8176 tao
1221 8180 tao
1222
    ####################send the verification email to the user
1223 8253 leinfelder
    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.
1224 8180 tao
1225 8253 leinfelder
    my $overrideURL;
1226
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1227 8411 tao
    debug("the overrideURL is $overrideURL");
1228 8253 leinfelder
    if (defined($overrideURL) && !($overrideURL eq '')) {
1229
    	$link = $serverUrl . $overrideURL . $link;
1230
    } else {
1231
    	$link = $serverUrl . $link;
1232
    }
1233
1234 8181 tao
    my $mailhost = $properties->getProperty('email.mailhost');
1235 8197 tao
    my $sender;
1236
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1237
    debug("the sender is " . $sender);
1238 8181 tao
    my $recipient = $query->param('mail');
1239
    # Send the email message to them
1240 8191 tao
    my $smtp = Net::SMTP->new($mailhost) or do {
1241
                                                  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 " .
1242
                                                  $skinProperties->getProperty("email.recipient") . "." });
1243
                                                  exit(0);
1244
                                               };
1245 8181 tao
    $smtp->mail($sender);
1246
    $smtp->to($recipient);
1247
1248
    my $message = <<"     ENDOFMESSAGE";
1249
    To: $recipient
1250
    From: $sender
1251 8239 leinfelder
    Subject: New Account Activation
1252 8181 tao
1253 8413 tao
    Somebody (hopefully you) registered an account on $contextUrl/style/skins/account/.
1254 8181 tao
    Please click the following link to activate your account.
1255
    If the link doesn't work, please copy the link to your browser:
1256
1257
    $link
1258
1259
    Thanks,
1260 8234 tao
        $sender
1261 8181 tao
1262
     ENDOFMESSAGE
1263
     $message =~ s/^[ \t\r\f]+//gm;
1264
1265
     $smtp->data($message);
1266
     $smtp->quit;
1267 8182 tao
    debug("the link is " . $link);
1268 8181 tao
    fullTemplate( ['success'] );
1269
1270 8175 tao
}
1271
1272
#
1273 8220 tao
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1274 2341 sgarg
# by the user
1275
#
1276 8220 tao
sub createItem {
1277 8180 tao
    my $dn = shift;
1278
    my $ldapUsername = shift;
1279
    my $ldapPassword = shift;
1280
    my $additions = shift;
1281
    my $temp = shift; #if it is for a temporary account.
1282
    my $allParams = shift;
1283
1284
    my @failureTemplate;
1285
    if($temp){
1286
        @failureTemplate = ['registerFailed', 'register'];
1287
    } else {
1288
        @failureTemplate = ['registerFailed'];
1289
    }
1290
    print "Content-type: text/html\n\n";
1291
    debug("the dn is " . $dn);
1292
    debug("LDAP connection to $ldapurl...");
1293
    #if main ldap server is down, a html file containing warning message will be returned
1294
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1295
    if ($ldap) {
1296 8403 tao
            $ldap->start_tls( verify => 'require',
1297
                      cafile => $ldapServerCACertFile);
1298 8180 tao
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1299 8185 tao
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1300 8180 tao
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1301
            if ($result->code()) {
1302
                fullTemplate(@failureTemplate, { stage => "register",
1303
                                                            allParams => $allParams,
1304
                                                            errorMessage => $result->error });
1305 8220 tao
                exist(0);
1306 8180 tao
                # TODO SCW was included as separate errors, test this
1307
                #$templateVars    = setVars({ stage => "register",
1308
                #                     allParams => $allParams });
1309
                #$template->process( $templates->{'register'}, $templateVars);
1310
            } else {
1311 8181 tao
                #fullTemplate( ['success'] );
1312 8180 tao
            }
1313
            $ldap->unbind;   # take down session
1314
1315
    } else {
1316
         fullTemplate(@failureTemplate, { stage => "register",
1317
                                                            allParams => $allParams,
1318
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1319
         exit(0);
1320
    }
1321
1322
}
1323
1324 2341 sgarg
1325
1326
1327
1328
1329 8185 tao
#
1330
# This subroutine will handle a email verification:
1331
# If the hash string matches the one store in the ldap, the account will be
1332
# copied from the temporary space to the permanent tree and the account in
1333
# the temporary space will be removed.
1334
sub handleEmailVerification {
1335
1336
    my $cfg = $query->param('cfg');
1337
    my $dn = $query->param('dn');
1338
    my $hash = $query->param('hash');
1339
    my $org = $query->param('o');
1340
    my $uid = $query->param('uid');
1341
1342
    my $ldapUsername;
1343
    my $ldapPassword;
1344 8211 tao
    #my $orgAuthBase;
1345
1346
    $ldapUsername = $ldapConfig->{$org}{'user'};
1347
    $ldapPassword = $ldapConfig->{$org}{'password'};
1348
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1349
1350 8185 tao
    debug("LDAP connection to $ldapurl...");
1351
1352
1353
   print "Content-type: text/html\n\n";
1354
   #if main ldap server is down, a html file containing warning message will be returned
1355
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1356
   if ($ldap) {
1357 8403 tao
        $ldap->start_tls( verify => 'require',
1358
                      cafile => $ldapServerCACertFile);
1359 8185 tao
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1360 8211 tao
        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.
1361 8185 tao
        my $max = $mesg->count;
1362
        debug("the count is " . $max);
1363
        if($max < 1) {
1364
            $ldap->unbind;   # take down session
1365 8216 tao
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1366 8185 tao
            #handleLDAPBindFailure($ldapurl);
1367
            exit(0);
1368
        } else {
1369
            #check if the hash string match
1370
            my $entry = $mesg->entry (0);
1371
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1372
            if( $hashStrFromLdap eq $hash) {
1373
                #my $additions = [ ];
1374
                #foreach my $attr ( $entry->attributes ) {
1375
                    #if($attr ne 'employeeNumber') {
1376
                        #$$additions[$#$additions + 1] = $attr;
1377
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1378
                    #}
1379
                #}
1380 8211 tao
1381
1382
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1383 8185 tao
                $mesg = $ldap->moddn(
1384
                            dn => $dn,
1385
                            deleteoldrdn => 1,
1386
                            newrdn => "uid=" . $uid,
1387 8211 tao
                            newsuperior  =>  $orgDn);
1388 8185 tao
                $ldap->unbind;   # take down session
1389 8186 tao
                if($mesg->code()) {
1390 8216 tao
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1391 8185 tao
                    exit(0);
1392
                } else {
1393 8216 tao
                    fullTemplate( ['verificationSuccess'] );
1394 8185 tao
                }
1395
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1396
            } else {
1397
                $ldap->unbind;   # take down session
1398 8216 tao
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1399 8185 tao
                exit(0);
1400
            }
1401
1402
        }
1403
    } else {
1404
        handleLDAPBindFailure($ldapurl);
1405
        exit(0);
1406
    }
1407
1408
}
1409
1410 2341 sgarg
sub handleResponseMessage {
1411
1412
  print "Content-type: text/html\n\n";
1413
  my $errorMessage = "You provided invalid input to the script. " .
1414
                     "Try again please.";
1415 4080 daigle
  fullTemplate( [], { stage => $templates->{'stage'},
1416
                      errorMessage => $errorMessage });
1417
  exit();
1418 2341 sgarg
}
1419
1420
#
1421
# perform a simple search against the LDAP database using
1422
# a small subset of attributes of each dn and return it
1423
# as a table to the calling browser.
1424
#
1425
sub handleSimpleSearch {
1426
1427
    my $o = $query->param('o');
1428
1429 4080 daigle
    my $ldapurl = $ldapConfig->{$o}{'url'};
1430
    my $searchBase = $ldapConfig->{$o}{'base'};
1431 2341 sgarg
1432
    print "Content-type: text/html\n\n";
1433
1434
    my $allParams = {
1435
                      'cn' => $query->param('cn'),
1436
                      'sn' => $query->param('sn'),
1437
                      'gn' => $query->param('gn'),
1438
                      'o'  => $query->param('o'),
1439
                      'facsimiletelephonenumber'
1440
                      => $query->param('facsimiletelephonenumber'),
1441
                      'mail' => $query->param('cmail'),
1442
                      'telephonenumber' => $query->param('telephonenumber'),
1443
                      'title' => $query->param('title'),
1444
                      'uid' => $query->param('uid'),
1445
                      'ou' => $query->param('ou'),
1446
                    };
1447
1448
    # Search LDAP for matching entries that already exist
1449
    my $filter = "(" .
1450
                 $query->param('searchField') . "=" .
1451
                 "*" .
1452
                 $query->param('searchValue') .
1453
                 "*" .
1454
                 ")";
1455
1456
    my @attrs = [ 'sn',
1457
                  'gn',
1458
                  'cn',
1459
                  'o',
1460
                  'facsimiletelephonenumber',
1461
                  'mail',
1462
                  'telephoneNumber',
1463
                  'title',
1464
                  'uid',
1465
                  'labeledURI',
1466
                  'ou' ];
1467
1468
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1469
1470
    # Send back the search results
1471
    if ($found) {
1472 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
1473
                                         allParams => $allParams,
1474
                                         foundAccounts => $found });
1475 2341 sgarg
    } else {
1476
      $found = "No entries matched your criteria.  Please try again\n";
1477
1478 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
1479
                                         allParams => $allParams,
1480
                                         foundAccounts => $found });
1481 2341 sgarg
    }
1482
1483
    exit();
1484
}
1485
1486
#
1487
# search the LDAP directory to see if a similar account already exists
1488
#
1489
sub searchDirectory {
1490
    my $ldapurl = shift;
1491
    my $base = shift;
1492
    my $filter = shift;
1493
    my $attref = shift;
1494
1495 4849 daigle
	my $mesg;
1496 2341 sgarg
    my $foundAccounts = 0;
1497 3177 tao
1498
    #if ldap server is down, a html file containing warning message will be returned
1499 4771 walbridge
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1500 3177 tao
1501 4849 daigle
    if ($ldap) {
1502 8403 tao
    	$ldap->start_tls( verify => 'require',
1503
                      cafile => $ldapServerCACertFile);
1504 4849 daigle
    	$ldap->bind( version => 3, anonymous => 1);
1505
    	my $mesg = $ldap->search (
1506
        	base   => $base,
1507
        	filter => $filter,
1508
        	attrs => @$attref,
1509
    	);
1510 2341 sgarg
1511 4849 daigle
    	if ($mesg->count() > 0) {
1512
        	$foundAccounts = "";
1513
        	my $entry;
1514
        	foreach $entry ($mesg->sorted(['sn'])) {
1515
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1516
          		$foundAccounts .= "<a href=\"" unless
1517 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1518 4849 daigle
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1519 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1520 4849 daigle
          		$foundAccounts .= "\">\n" unless
1521 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1522 4849 daigle
          		$foundAccounts .= $entry->get_value('givenName');
1523
          		$foundAccounts .= "</a>\n" unless
1524 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1525 4849 daigle
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1526
          		$foundAccounts .= "<a href=\"" unless
1527 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1528 4849 daigle
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1529 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1530 4849 daigle
          		$foundAccounts .= "\">\n" unless
1531 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1532 4849 daigle
          		$foundAccounts .= $entry->get_value('sn');
1533
          		$foundAccounts .= "</a>\n";
1534
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1535
          		$foundAccounts .= $entry->get_value('mail');
1536
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1537
          		$foundAccounts .= $entry->get_value('telephonenumber');
1538
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1539
          		$foundAccounts .= $entry->get_value('title');
1540
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1541
          		$foundAccounts .= $entry->get_value('ou');
1542
          		$foundAccounts .= "\n</td>\n";
1543
          		$foundAccounts .= "</tr>\n";
1544
        	}
1545
    	}
1546
    	$ldap->unbind;   # take down session
1547 2341 sgarg
    }
1548
    return $foundAccounts;
1549
}
1550
1551
sub debug {
1552
    my $msg = shift;
1553
1554
    if ($debug) {
1555 4747 walbridge
        print STDERR "LDAPweb: $msg\n";
1556 2341 sgarg
    }
1557
}
1558 3175 tao
1559 4771 walbridge
sub handleLDAPBindFailure {
1560
    my $ldapAttemptUrl = shift;
1561
    my $primaryLdap =  $properties->getProperty('auth.url');
1562
1563
    if ($ldapAttemptUrl eq  $primaryLdap) {
1564
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1565
    } else {
1566
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1567
    }
1568
}
1569
1570 3177 tao
sub handleGeneralServerFailure {
1571
    my $errorMessage = shift;
1572 4728 walbridge
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1573 3175 tao
    exit(0);
1574
   }
1575
1576 4080 daigle
sub setVars {
1577
    my $paramVars = shift;
1578
    # initialize default parameters
1579
    my $templateVars = { cfg => $cfg,
1580 4394 walbridge
                         styleSkinsPath => $contextUrl . "/style/skins",
1581
                         styleCommonPath => $contextUrl . "/style/common",
1582
                         contextUrl => $contextUrl,
1583 4770 daigle
                         cgiPrefix => $cgiPrefix,
1584 8206 tao
                         orgList => \@validDisplayOrgList,
1585 4394 walbridge
                         config  => $config,
1586 4080 daigle
    };
1587
1588
    # append customized params
1589
    while (my ($k, $v) = each (%$paramVars)) {
1590
        $templateVars->{$k} = $v;
1591
    }
1592
1593
    return $templateVars;
1594
}
1595 8180 tao
1596 8408 tao
#Method to get the next avaliable uid number. We use the mechanism - http://www.rexconsulting.net/ldap-protocol-uidNumber.html
1597
sub getNextUidNumber {
1598 8413 tao
1599 8410 tao
    my $maxAttempt = $properties->getProperty('ldap.nextuid.maxattempt');
1600 8408 tao
1601 8411 tao
    my $ldapUsername = shift;
1602
    my $ldapPassword = shift;
1603 8408 tao
1604 8411 tao
    my $realUidNumber;
1605
    my $uidNumber;
1606 8408 tao
    my $entry;
1607
    my $mesg;
1608
    my $ldap;
1609
1610
    debug("ldap server: $ldapurl");
1611
1612
    #if main ldap server is down, a html file containing warning message will be returned
1613
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1614
1615
    if ($ldap) {
1616 8818 tao
    	my $existingHighUid=getExistingHighestUidNum($ldapUsername, $ldapPassword);
1617 8408 tao
        $ldap->start_tls( verify => 'require',
1618
                      cafile => $ldapServerCACertFile);
1619
        my $bindresult = $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword);
1620
        #read the uid value stored in uidObject class
1621
        for(my $index=0; $index<$maxAttempt; $index++) {
1622 8413 tao
            $mesg = $ldap->search(base  => $dn_store_next_uid, filter => '(objectClass=*)');
1623 8408 tao
            if ($mesg->count() > 0) {
1624 8413 tao
                debug("Find the cn - $dn_store_next_uid");
1625 8408 tao
                $entry = $mesg->pop_entry;
1626 8413 tao
                $uidNumber = $entry->get_value($attribute_name_store_next_uid);
1627 8408 tao
                if($uidNumber) {
1628 8413 tao
                    if (looks_like_number($uidNumber)) {
1629
                        debug("uid number is $uidNumber");
1630
                        #remove the uid attribute with the read value
1631
                        my $delMesg = $ldap->modify($dn_store_next_uid, delete => { $attribute_name_store_next_uid => $uidNumber});
1632
                        if($delMesg->is_error()) {
1633
                            my $error=$delMesg->error();
1634
                            my $errorName = $delMesg->error_name();
1635
                            debug("can't remove the attribute - $error");
1636
                            debug("can't remove the attribute and the error name - $errorName");
1637
                            #can't remove the attribute with the specified value - that means somebody modify the value in another route, so try it again
1638
                        } else {
1639
                            debug("Remove the attribute successfully and write a new increased value back");
1640 8819 tao
                            if($existingHighUid) {
1641
                            	if($uidNumber <= $existingHighUid ) {
1642
                            		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");
1643
                            		$uidNumber = $existingHighUid +1;
1644
                            	}
1645
                            }
1646 8413 tao
                            my $newValue = $uidNumber +1;
1647
                            $delMesg = $ldap->modify($dn_store_next_uid, add => {$attribute_name_store_next_uid => $newValue});
1648
                            $realUidNumber = $uidNumber;
1649
                            last;
1650
                        }
1651 8408 tao
                    }
1652 8413 tao
1653 8408 tao
               } else {
1654 8413 tao
                 debug("can't find the attribute - $attribute_name_store_next_uid in the $dn_store_next_uid and we will try again");
1655 8408 tao
               }
1656
            }
1657
        }
1658
        $ldap->unbind;   # take down session
1659
    }
1660
    return $realUidNumber;
1661
}
1662
1663 8818 tao
#Method to get the existing high uidNumber in the account tree.
1664
sub getExistingHighestUidNum {
1665
    my $ldapUsername = shift;
1666
    my $ldapPassword = shift;
1667
1668
    my $high;
1669
    my $ldap;
1670
1671 8819 tao
1672 8818 tao
    #if main ldap server is down, a html file containing warning message will be returned
1673
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1674
    if ($ldap) {
1675
        $ldap->start_tls( verify => 'require',
1676
                      cafile => $ldapServerCACertFile);
1677
        my $bindresult = $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword);
1678
        my $uids = $ldap->search(
1679
                        base => "dc=ecoinformatics,dc=org",
1680
                        scope => "sub",
1681
                        filter => "uidNumber=*",
1682
                        attrs   => [ 'uidNumber' ],
1683
                        );
1684
       return unless $uids->count;
1685
  	    my @uids;
1686
        if ($uids->count > 0) {
1687
                foreach my $uid ($uids->all_entries) {
1688
                        push @uids, $uid->get_value('uidNumber');
1689
                }
1690
        }
1691
1692
        @uids = sort { $b <=> $a } @uids;
1693
        $high = $uids[0];
1694
        debug("the highest exiting uidnumber is $high");
1695
        $ldap->unbind;   # take down session
1696
    }
1697
    return $high;
1698 8408 tao
1699 8818 tao
}
1700