Project

General

Profile

1
#!/usr/bin/perl -w
2
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California 
5
#
6
#   '$Author: tao $'
7
#     '$Date: 2014-08-01 09:20:56 -0700 (Fri, 01 Aug 2014) $'
8
# '$Revision: 8819 $' 
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 $ldapServerCACertFile = $workingDirectory. "/../" . $properties->getProperty('ldap.server.ca.certificate');
85

    
86
#recaptcha key information
87
my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');
88
my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');
89

    
90
my @errorMessages;
91
my $error = 0;
92

    
93
my $emailVerification= 'emailverification';
94

    
95
 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
# 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
    debug("No configuration set.");
109
    print "Content-type: text/html\n\n";
110
    print 'LDAPweb Error: The registry requires a skin name to continue.';
111
    exit();
112
}
113

    
114
# Metacat isn't initialized, the registry will fail in strange ways.
115
if (!($metacatUrl)) {
116
    debug("No Metacat.");
117
    print "Content-type: text/html\n\n";
118
    'Registry Error: Metacat is not initialized! Make sure' .
119
        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';
120
    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
# 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
my $searchBase;
159
my $ldapUsername;
160
my $ldapPassword;
161
# 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

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

    
168
# Get the CGI input variables
169
my $query = new CGI;
170
my $debug = 1;
171

    
172
#--------------------------------------------------------------------------80c->
173
# Set up the Template Toolkit to read html form templates
174

    
175
# templates hash, imported from ldap.templates tree in metacat.properties
176
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
177
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
178
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
179

    
180
# set some configuration options for the template object
181
my $ttConfig = {
182
             INCLUDE_PATH => $templatesDir,
183
             INTERPOLATE  => 0,
184
             POST_CHOMP   => 1,
185
             DEBUG        => 1, 
186
             };
187

    
188
# create an instance of the template
189
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
190

    
191
# custom LDAP properties hash
192
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
193

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

    
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
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
199
# pull out properties available e.g. 'name', 'base'
200
my @orgData = keys(%$orgProps);
201

    
202
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
while (my ($oKey, $oVal) = each(%$orgNames)) {
204
    push(@orgList, $oKey);
205
}
206

    
207
my $authBase = $properties->getProperty("auth.base");
208
my $ldapConfig;
209
foreach my $o (@orgList) {
210
    foreach my $d (@orgData) {
211
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
212
    }
213

    
214
    # 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
    # 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
            #$ldapConfig->{$o}{'filter'} = $filter;
236
            $ldapConfig->{$o}{'filter'} = $ldapConfig->{$o}{'org'};
237
        }
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
    } else {
243
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
244
    }
245
    
246
    # set LDAP administrator user account
247
    if (!$ldapConfig->{$o}{'user'}) {
248
        $ldapConfig->{$o}{'user'} = $ldapConfig->{'unaffiliated'}{'user'};
249
    }
250
    # 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

    
256
    if (!$ldapConfig->{$o}{'password'}) {
257
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
258
    }
259
}
260

    
261
### Determine the display organization list (such as NCEAS, Account ) in the ldap template files
262
my $displayOrgListStr;
263
$displayOrgListStr = $skinProperties->getProperty("ldap.templates.organizationList") or $displayOrgListStr = $properties->getProperty('ldap.templates.organizationList');
264
debug("the string of the org from properties : " . $displayOrgListStr);
265
my @displayOrgList = split(';', $displayOrgListStr);
266

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

    
269
my %orgNamesHash = %$orgNames;
270
foreach my $element (@displayOrgList) {
271
    if(exists $orgNamesHash{$element}) {
272
         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
         #if the name is found in the organization part of metacat.properties, put it into the valid array
277
         push(@validDisplayOrgList, \%displayHash);
278
    } 
279
    
280
}
281

    
282
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
#--------------------------------------------------------------------------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
my $stage = $query->param('stage') || $templates->{'stage'};
299

    
300
my $cfg = $query->param('cfg');
301
debug("started with stage $stage, cfg $cfg");
302

    
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
              'changepass'        => \&handleChangePassword,
314
              'initchangepass'    => \&handleInitialChangePassword,
315
              'resetpass'         => \&handleResetPassword,
316
              'initresetpass'     => \&handleInitialResetPassword,
317
              'emailverification' => \&handleEmailVerification,
318
              'lookupname'        => \&handleLookupName,
319
              'searchnamesbyemail'=> \&handleSearchNameByEmail,
320
              #'getnextuid'        => \&getExistingHighestUidNum,
321
             );
322

    
323
# 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
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
	my $expirationDate = $dt->ymd("") . $dt->hms("") . "Z";
347
    my $filter = "(&(objectClass=inetOrgPerson)(createTimestamp<=" . $expirationDate . "))";
348
    debug("Clearing expired accounts with filter: " . $filter . ", base: " . $tmpSearchBase);    
349
    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
    debug("clearTemporaryAccounts: connecting to $ldapurl, $timeout");
358
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
359
    if ($ldap) {
360
    	$ldap->start_tls( verify => 'require',
361
                      cafile => $ldapServerCACertFile);
362
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
363
		$mesg = $ldap->search (
364
			base   => $tmpSearchBase,
365
			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
   				debug("Removing expired account: " . $dn);
374
            	$ldap->delete($dn);
375
			}
376
        }
377
    	$ldap->unbind;   # take down session
378
    }
379

    
380
    return 0;
381
}
382

    
383
sub fullTemplate {
384
    my $templateList = shift;
385
    my $templateVars = setVars(shift);
386
    my $c = Captcha::reCAPTCHA->new;
387
    my $captcha = 'captcha';
388
    #my $error=null;
389
    my $use_ssl= 1;
390
    #my $options=null;
391
    # 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
    $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

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

    
413
#
414
# 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
sub handleSearchNameByEmail{
418

    
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
        fullTemplate(['lookupName'], { allParams => $allParams,
427
                                     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
    if ($found) {
440
        $accountInfo = $found;
441
    } else {
442
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n";
443
    }
444

    
445
    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
                                                  fullTemplate( ['lookupName'], {allParams => $allParams, 
453
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " . 
454
                                                                $skinProperties->getProperty("email.recipient") . "." });  
455
                                                  exit(0);
456
                                               };
457
    $smtp->mail($sender);
458
    $smtp->to($recipient);
459

    
460
    my $message = <<"     ENDOFMESSAGE";
461
    To: $recipient
462
    From: $sender
463
    Subject: Your Account Information
464
        
465
    Somebody (hopefully you) looked up the account information associated with the email address.  
466
    Here is the account information:
467
    
468
    $accountInfo
469

    
470
    Thanks,
471
        $sender
472
    
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
# 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
  fullTemplate(['register'], {stage => "register"}); 
491
  exit();
492
}
493

    
494

    
495

    
496
#
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
    #print "Content-type: text/html\n\n";
503
    if ($query->param('o') =~ "LTER") {
504
      print "Content-type: text/html\n\n";
505
      fullTemplate( ['registerLter'] );
506
      exit(0);
507
    } 
508
    
509
    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
    
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
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
526
        $challenge, $response
527
    );
528

    
529
    if ( $result->{is_valid} ) {
530
        #print "Yes!";
531
        #exit();
532
    }
533
    else {
534
        print "Content-type: text/html\n\n";
535
        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
    # 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
        print "Content-type: text/html\n\n";
548
        my $errorMessage = "Required information is missing. " .
549
            "Please fill in all required fields and resubmit the form.";
550
        fullTemplate(['register'], { stage => "register",
551
                                     allParams => $allParams,
552
                                     errorMessage => $errorMessage });
553
        exit();
554
    } else {
555
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
556
            print "Content-type: text/html\n\n";
557
            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
        my $o = $query->param('o');    
564
        $searchBase = $ldapConfig->{$o}{'base'};  
565
    }
566
    
567
    # Remove any expired temporary accounts for this subtree before continuing
568
    clearTemporaryAccounts();
569

    
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
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
592
    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
      print "Content-type: text/html\n\n";
597
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
598
                                                     allParams => $allParams,
599
                                                     foundAccounts => $found });
600
    # Otherwise, create a new user in the LDAP directory
601
    } else {
602
        createTemporaryAccount($allParams);
603
    }
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
                      'o' => $query->param('o'), 
618
                      '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
    #print "Content-type: text/html\n\n";
625
    createTemporaryAccount($allParams);
626
    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
        my $o = $query->param('o');
643
        
644
        $searchBase = $ldapConfig->{$o}{'base'};
645
    }
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
        fullTemplate( ['changePass'], { stage => "changepass",
655
                                        allParams => $allParams,
656
                                        errorMessage => $errorMessage });
657
        exit();
658
    }
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
        my $o = $query->param('o');
664
        $searchBase = $ldapConfig->{$o}{'base'};
665
        $ldapUsername = $ldapConfig->{$o}{'user'};
666
        $ldapPassword = $ldapConfig->{$o}{'password'};
667

    
668
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
669
        if ($query->param('o') =~ "LTER") {
670
            fullTemplate( ['registerLter'] );
671
        } else {
672
            my $errorMessage = changePassword(
673
                    $dn, $query->param('userPassword'), 
674
                    $dn, $query->param('oldpass'), $query->param('o'));
675
            if ($errorMessage) {
676
                fullTemplate( ['changePass'], { stage => "changepass",
677
                                                allParams => $allParams,
678
                                                errorMessage => $errorMessage });
679
                exit();
680
            } else {
681
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
682
                                                       allParams => $allParams });
683
                exit();
684
            }
685
        }
686
    } else {
687
        my $errorMessage = "The passwords do not match. Try again.";
688
        fullTemplate( ['changePass'], { stage => "changepass",
689
                                        allParams => $allParams,
690
                                        errorMessage => $errorMessage });
691
        exit();
692
    }
693
}
694

    
695
#
696
# 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
    fullTemplate( ['changePass'], { stage => "changepass",
705
                                    errorMessage => $errorMessage });
706
    exit();
707
}
708

    
709
#
710
# 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
        my $o = $query->param('o');
723
        
724
        $searchBase = $ldapConfig->{$o}{'base'};
725
        $ldapUsername = $ldapConfig->{$o}{'user'};
726
        $ldapPassword = $ldapConfig->{$o}{'password'};
727
    }
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
        fullTemplate( ['resetPass'],  { stage => "resetpass",
735
                                        allParams => $allParams,
736
                                        errorMessage => $errorMessage });
737
        exit();
738
    }
739

    
740
    # We have all of the info we need, so try to change the password
741
    my $o = $query->param('o');
742
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
743
    debug("handleResetPassword: dn: $dn");
744
    if ($query->param('o') =~ "LTER") {
745
        fullTemplate( ['registerLter'] );
746
        exit();
747
    } 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
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
758
        } else {
759
            $errorMessage = "User not found in database.  Please try again.";
760
        }
761

    
762
        if ($errorMessage) {
763
            fullTemplate( ['resetPass'], { stage => "resetpass",
764
                                           allParams => $allParams,
765
                                           errorMessage => $errorMessage });
766
            exit();
767
        } else {
768
            my $errorMessage = sendPasswordNotification($query->param('uid'),
769
                    $query->param('o'), $userPass, $recipient, $cfg);
770
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
771
                                                  allParams => $allParams,
772
                                                  errorMessage => $errorMessage });
773
            exit();
774
        }
775
    }
776
}
777

    
778
#
779
# 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
    fullTemplate( ['resetPass'], { stage => "resetpass",
786
                                   errorMessage => $errorMessage });
787
    exit();
788
}
789

    
790
#
791
# 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
    my $searchBase = $ldapConfig->{$o}{'base'};
816

    
817
    my $errorMessage = 0;
818
    my $ldap;
819

    
820
    #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
    
823
    if ($ldap) {
824
        $ldap->start_tls( verify => 'require',
825
                      cafile => $ldapServerCACertFile);
826
        debug("changePassword: attempting to bind to $bindDN");
827
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
828
                                  password => $bindPass );
829
        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

    
835
    	# Find the user here and change their entry
836
    	my $newpass = createSeededPassHash($userPass);
837
    	my $modifications = { userPassword => $newpass };
838
      debug("changePass: setting password for $userDN to $newpass");
839
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
840
    
841
    	if ($result->code()) {
842
            debug("changePass: error changing password: " . $result->error);
843
        	$errorMessage = "There was an error changing the password:" .
844
                           "<br />\n" . $result->error;
845
    	} 
846
    	$ldap->unbind;   # take down session
847
    }
848

    
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
    my $ldap;
883
    debug("ldap server: $ldapurl");
884

    
885
    #if main ldap server is down, a html file containing warning message will be returned
886
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
887
    
888
    if ($ldap) {
889
        $ldap->start_tls( verify => 'none');
890
        #$ldap->start_tls( verify => 'require',
891
        #              cafile => $ldapServerCACertFile);
892
    	my $bindresult = $ldap->bind;
893
    	if ($bindresult->code) {
894
        	return $entry;
895
    	}
896

    
897
        $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
    
910
    	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
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
925
                	return $entry;
926
            	}
927
        	}
928
    	}
929
    }
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
    my $cfg = shift;
942

    
943
    my $errorMessage = "";
944
    if ($recipient) {
945
    
946
        my $mailhost = $properties->getProperty('email.mailhost');
947
        my $sender;
948
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
949
        # 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
        Subject: Your Account Password Reset
958
        
959
        Somebody (hopefully you) requested that your account password be reset.  
960
        Your temporary password is below. Please change it as soon as possible 
961
        at: $contextUrl/style/skins/account/.
962

    
963
            Username: $username
964
        Organization: $org
965
        New Password: $newPass
966

    
967
        Thanks,
968
            $sender
969
    
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
    my $notHtmlFormat = shift;
991
    my $ldap;
992
    my $mesg;
993

    
994
    my $foundAccounts = 0;
995

    
996
    #if main ldap server is down, a html file containing warning message will be returned
997
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
998
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
999
    if ($ldap) {
1000
    	$ldap->start_tls( verify => 'none');
1001
    	#$ldap->start_tls( verify => 'require',
1002
        #              cafile => $ldapServerCACertFile);
1003
    	$ldap->bind( version => 3, anonymous => 1);
1004
		$mesg = $ldap->search (
1005
			base   => $base,
1006
			filter => $filter,
1007
			attrs => @$attref,
1008
		);
1009

    
1010
	    if ($mesg->count() > 0) {
1011
			$foundAccounts = "";
1012
			my $entry;
1013
			foreach $entry ($mesg->all_entries) { 
1014
                # 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
                #if ($entry->dn !~ /ou=Account/) {
1017
                    if($notHtmlFormat) {
1018
                        $foundAccounts .= "\nAccount: ";
1019
                    } else {
1020
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
1021
                    }
1022
                    $foundAccounts .= $entry->dn();
1023
                    if($notHtmlFormat) {
1024
                        $foundAccounts .= "\n";
1025
                    } else {
1026
                        $foundAccounts .= "</b><br />\n";
1027
                    }
1028
                    foreach my $attribute ($entry->attributes()) {
1029
                        my $value = $entry->get_value($attribute);
1030
                        $foundAccounts .= "$attribute: ";
1031
                        $foundAccounts .= $value;
1032
                         if($notHtmlFormat) {
1033
                            $foundAccounts .= "\n";
1034
                        } else {
1035
                            $foundAccounts .= "<br />\n";
1036
                        }
1037
                    }
1038
                    if($notHtmlFormat) {
1039
                        $foundAccounts .= "\n";
1040
                    } else {
1041
                        $foundAccounts .= "</p>\n";
1042
                    }
1043
                    
1044
                #}
1045
			}
1046
        }
1047
    	$ldap->unbind;   # take down session
1048

    
1049
    	# 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
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
1057
        	if ($refFound) {
1058
            	$foundAccounts .= $refFound;
1059
        	}
1060
    	}
1061
    }
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
# 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
    my $org = $query->param('o'); 
1098
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1099
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1100
    my $tmp = 1;
1101

    
1102
    ################## 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
    
1120
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1121
    my $filter = $ldapConfig->{$org}{'filter'};   
1122
    
1123
    debug("search filer " . $filter);
1124
    debug("ldap server ". $ldapurl);
1125
    debug("sesarch base " . $tmpSearchBase);
1126
    #print "Content-type: text/html\n\n";
1127
    my @attrs = ['o', 'ou' ];
1128
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1129

    
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
        
1134
    if(!$found) {
1135
        debug("generate the subtree in the dc=tmp===========================");
1136
        #need to generate the subtree o or ou
1137
        my $additions;
1138
            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
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1152
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1153
    } 
1154
    
1155
    ################create an account under tmp subtree 
1156
    
1157
     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
    #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
        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
        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
    #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
                'cn'   => $cn,
1181
                'sn'   => $query->param('sn'),
1182
                'givenName'   => $query->param('givenName'),
1183
                'mail' => $query->param('mail'),
1184
                'userPassword' => $shapass,
1185
                'employeeNumber' => $randomStr,
1186
                'uidNumber' => $nextUidNumber,
1187
                'gidNumber' => $nextUidNumber,
1188
                'loginShell' => '/sbin/nologin',
1189
                'homeDirectory' => '/dev/null',
1190
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1191
                                'inetOrgPerson', 'posixAccount', 'shadowAccount' ],
1192
                $organization   => $organizationName
1193
                ];
1194
    my $gecos;
1195
    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
                $gecos = $cn . ',,'. $query->param('telephoneNumber'). ',';
1201
    } else {
1202
        $gecos = $cn . ',,,';
1203
    }
1204
    
1205
    $$additions[$#$additions + 1] = 'gecos';
1206
    $$additions[$#$additions + 1] = $gecos;
1207
    
1208
    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

    
1215
    
1216
    #$$additions[$#$additions + 1] = 'o';
1217
    #$$additions[$#$additions + 1] = $org;
1218
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1219
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1220
    
1221
    
1222
    ####################send the verification email to the user
1223
    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
    
1225
    my $overrideURL;
1226
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1227
    debug("the overrideURL is $overrideURL");
1228
    if (defined($overrideURL) && !($overrideURL eq '')) {
1229
    	$link = $serverUrl . $overrideURL . $link;
1230
    } else {
1231
    	$link = $serverUrl . $link;
1232
    }
1233
    
1234
    my $mailhost = $properties->getProperty('email.mailhost');
1235
    my $sender;
1236
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1237
    debug("the sender is " . $sender);
1238
    my $recipient = $query->param('mail');
1239
    # Send the email message to them
1240
    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
    $smtp->mail($sender);
1246
    $smtp->to($recipient);
1247

    
1248
    my $message = <<"     ENDOFMESSAGE";
1249
    To: $recipient
1250
    From: $sender
1251
    Subject: New Account Activation
1252
        
1253
    Somebody (hopefully you) registered an account on $contextUrl/style/skins/account/.  
1254
    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
        $sender
1261
    
1262
     ENDOFMESSAGE
1263
     $message =~ s/^[ \t\r\f]+//gm;
1264
    
1265
     $smtp->data($message);
1266
     $smtp->quit;
1267
    debug("the link is " . $link);
1268
    fullTemplate( ['success'] );
1269
    
1270
}
1271

    
1272
#
1273
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1274
# by the user
1275
#
1276
sub createItem {
1277
    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
            $ldap->start_tls( verify => 'require',
1297
                      cafile => $ldapServerCACertFile);
1298
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1299
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1300
            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
                exist(0);
1306
                # 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
                #fullTemplate( ['success'] );
1312
            }
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

    
1325

    
1326

    
1327

    
1328

    
1329
#
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
    #my $orgAuthBase;
1345

    
1346
    $ldapUsername = $ldapConfig->{$org}{'user'};
1347
    $ldapPassword = $ldapConfig->{$org}{'password'};
1348
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1349
    
1350
    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
        $ldap->start_tls( verify => 'require',
1358
                      cafile => $ldapServerCACertFile);
1359
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1360
        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
        my $max = $mesg->count;
1362
        debug("the count is " . $max);
1363
        if($max < 1) {
1364
            $ldap->unbind;   # take down session
1365
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1366
            #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

    
1381
                
1382
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1383
                $mesg = $ldap->moddn(
1384
                            dn => $dn,
1385
                            deleteoldrdn => 1,
1386
                            newrdn => "uid=" . $uid,
1387
                            newsuperior  =>  $orgDn);
1388
                $ldap->unbind;   # take down session
1389
                if($mesg->code()) {
1390
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1391
                    exit(0);
1392
                } else {
1393
                    fullTemplate( ['verificationSuccess'] );
1394
                }
1395
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1396
            } else {
1397
                $ldap->unbind;   # take down session
1398
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1399
                exit(0);
1400
            }
1401
            
1402
        }
1403
    } else {   
1404
        handleLDAPBindFailure($ldapurl);
1405
        exit(0);
1406
    }
1407

    
1408
}
1409

    
1410
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
  fullTemplate( [], { stage => $templates->{'stage'},
1416
                      errorMessage => $errorMessage });
1417
  exit();
1418
}
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
    my $ldapurl = $ldapConfig->{$o}{'url'};
1430
    my $searchBase = $ldapConfig->{$o}{'base'};
1431

    
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
      fullTemplate( ('searchResults'), { stage => "searchresults",
1473
                                         allParams => $allParams,
1474
                                         foundAccounts => $found });
1475
    } else {
1476
      $found = "No entries matched your criteria.  Please try again\n";
1477

    
1478
      fullTemplate( ('searchResults'), { stage => "searchresults",
1479
                                         allParams => $allParams,
1480
                                         foundAccounts => $found });
1481
    }
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
	my $mesg;
1496
    my $foundAccounts = 0;
1497
    
1498
    #if ldap server is down, a html file containing warning message will be returned
1499
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1500
    
1501
    if ($ldap) {
1502
    	$ldap->start_tls( verify => 'require',
1503
                      cafile => $ldapServerCACertFile);
1504
    	$ldap->bind( version => 3, anonymous => 1);
1505
    	my $mesg = $ldap->search (
1506
        	base   => $base,
1507
        	filter => $filter,
1508
        	attrs => @$attref,
1509
    	);
1510

    
1511
    	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
                    (!$entry->get_value('labeledURI'));
1518
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1519
                    (!$entry->get_value('labeledURI'));
1520
          		$foundAccounts .= "\">\n" unless 
1521
                    (!$entry->get_value('labeledURI'));
1522
          		$foundAccounts .= $entry->get_value('givenName');
1523
          		$foundAccounts .= "</a>\n" unless 
1524
                    (!$entry->get_value('labeledURI'));
1525
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1526
          		$foundAccounts .= "<a href=\"" unless 
1527
                    (!$entry->get_value('labeledURI'));
1528
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1529
                    (!$entry->get_value('labeledURI'));
1530
          		$foundAccounts .= "\">\n" unless 
1531
                    (!$entry->get_value('labeledURI'));
1532
          		$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
    }
1548
    return $foundAccounts;
1549
}
1550

    
1551
sub debug {
1552
    my $msg = shift;
1553
    
1554
    if ($debug) {
1555
        print STDERR "LDAPweb: $msg\n";
1556
    }
1557
}
1558

    
1559
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
sub handleGeneralServerFailure {
1571
    my $errorMessage = shift;
1572
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1573
    exit(0);   
1574
   }
1575
    
1576
sub setVars {
1577
    my $paramVars = shift;
1578
    # initialize default parameters 
1579
    my $templateVars = { cfg => $cfg,
1580
                         styleSkinsPath => $contextUrl . "/style/skins",
1581
                         styleCommonPath => $contextUrl . "/style/common",
1582
                         contextUrl => $contextUrl,
1583
                         cgiPrefix => $cgiPrefix,
1584
                         orgList => \@validDisplayOrgList,
1585
                         config  => $config,
1586
    };
1587
    
1588
    # append customized params
1589
    while (my ($k, $v) = each (%$paramVars)) {
1590
        $templateVars->{$k} = $v;
1591
    }
1592
    
1593
    return $templateVars;
1594
} 
1595

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

    
1599
    my $maxAttempt = $properties->getProperty('ldap.nextuid.maxattempt');
1600
    
1601
    my $ldapUsername = shift;
1602
    my $ldapPassword = shift;
1603
    
1604
    my $realUidNumber;
1605
    my $uidNumber;
1606
    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
    	my $existingHighUid=getExistingHighestUidNum($ldapUsername, $ldapPassword);
1617
        $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
            $mesg = $ldap->search(base  => $dn_store_next_uid, filter => '(objectClass=*)');
1623
            if ($mesg->count() > 0) {
1624
                debug("Find the cn - $dn_store_next_uid");
1625
                $entry = $mesg->pop_entry;
1626
                $uidNumber = $entry->get_value($attribute_name_store_next_uid);
1627
                if($uidNumber) {
1628
                    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
                            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
                            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
                    }
1652
                    
1653
               } else {
1654
                 debug("can't find the attribute - $attribute_name_store_next_uid in the $dn_store_next_uid and we will try again");
1655
               }
1656
            } 
1657
        }
1658
        $ldap->unbind;   # take down session
1659
    }
1660
    return $realUidNumber;
1661
}
1662

    
1663
#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
    
1672
    #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

    
1699
}
1700

    
1701

    
(10-10/14)