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-01-14 18:06:33 -0800 (Tue, 14 Jan 2014) $'
8
# '$Revision: 8501 $' 
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
         debug("push the organization " . $element . " into the dispaly array");
273
         #if the name is found in the organization part of metacat.properties, put it into the valid array
274
         push(@validDisplayOrgList, $element);
275
    } 
276
    
277
}
278

    
279
if(!@validDisplayOrgList) {
280
     my $sender;
281
     $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
282
    print "Content-type: text/html\n\n";
283
    print "The value of property ldap.templates.organizationList in " 
284
     . $skinName . ".properties file or metacat.properties file (if the property doesn't exist in the " 
285
     . $skinName . ".properties file) is invalid. Please send the information to ". $sender;
286
    exit(0);
287
}
288

    
289

    
290
#--------------------------------------------------------------------------80c->
291
# Define the main program logic that calls subroutines to do the work
292
#--------------------------------------------------------------------------80c->
293

    
294
# The processing step we are handling
295
my $stage = $query->param('stage') || $templates->{'stage'};
296

    
297
my $cfg = $query->param('cfg');
298
debug("started with stage $stage, cfg $cfg");
299

    
300
# define the possible stages
301
my %stages = (
302
              'initregister'      => \&handleInitRegister,
303
              'register'          => \&handleRegister,
304
              'registerconfirmed' => \&handleRegisterConfirmed,
305
              'simplesearch'      => \&handleSimpleSearch,
306
              'initaddentry'      => \&handleInitAddEntry,
307
              'addentry'          => \&handleAddEntry,
308
              'initmodifyentry'   => \&handleInitModifyEntry,
309
              'modifyentry'       => \&handleModifyEntry,
310
              'changepass'        => \&handleChangePassword,
311
              'initchangepass'    => \&handleInitialChangePassword,
312
              'resetpass'         => \&handleResetPassword,
313
              'initresetpass'     => \&handleInitialResetPassword,
314
              'emailverification' => \&handleEmailVerification,
315
              'lookupname'        => \&handleLookupName,
316
              'searchnamesbyemail'=> \&handleSearchNameByEmail,
317
              #'getnextuid'        => \&getNextUidNumber,
318
             );
319

    
320
# call the appropriate routine based on the stage
321
if ( $stages{$stage} ) {
322
  $stages{$stage}->();
323
} else {
324
  &handleResponseMessage();
325
}
326

    
327
#--------------------------------------------------------------------------80c->
328
# Define the subroutines to do the work
329
#--------------------------------------------------------------------------80c->
330

    
331
sub clearTemporaryAccounts {
332
	
333
    #search accounts that have expired
334
	my $org = $query->param('o'); 
335
    my $ldapUsername = $ldapConfig->{$org}{'user'};
336
    my $ldapPassword = $ldapConfig->{$org}{'password'};
337
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
338
    my $orgExpiration = $ldapConfig->{$org}{'expiration'};
339
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
340
	
341
	my $dt = DateTime->now;
342
	$dt->subtract( hours => $orgExpiration );
343
	my $expirationDate = $dt->ymd("") . $dt->hms("") . "Z";
344
    my $filter = "(&(objectClass=inetOrgPerson)(createTimestamp<=" . $expirationDate . "))";
345
    debug("Clearing expired accounts with filter: " . $filter . ", base: " . $tmpSearchBase);    
346
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
347

    
348
    my $ldap;
349
    my $mesg;
350
    
351
    my $dn;
352

    
353
    #if main ldap server is down, a html file containing warning message will be returned
354
    debug("clearTemporaryAccounts: connecting to $ldapurl, $timeout");
355
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
356
    if ($ldap) {
357
    	$ldap->start_tls( verify => 'require',
358
                      cafile => $ldapServerCACertFile);
359
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
360
		$mesg = $ldap->search (
361
			base   => $tmpSearchBase,
362
			filter => $filter,
363
			attrs => \@attrs,
364
		);
365
	    if ($mesg->count() > 0) {
366
			my $entry;
367
			foreach $entry ($mesg->all_entries) { 
368
            	$dn = $entry->dn();
369
            	# remove the entry
370
   				debug("Removing expired account: " . $dn);
371
            	$ldap->delete($dn);
372
			}
373
        }
374
    	$ldap->unbind;   # take down session
375
    }
376

    
377
    return 0;
378
}
379

    
380
sub fullTemplate {
381
    my $templateList = shift;
382
    my $templateVars = setVars(shift);
383
    my $c = Captcha::reCAPTCHA->new;
384
    my $captcha = 'captcha';
385
    #my $error=null;
386
    my $use_ssl= 1;
387
    #my $options=null;
388
    # use the AJAX style, only need to provide the public key to the template
389
    $templateVars->{'recaptchaPublicKey'} = $recaptchaPublicKey;
390
    #$templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
391
    $template->process( $templates->{'header'}, $templateVars );
392
    foreach my $tmpl (@{$templateList}) {
393
        $template->process( $templates->{$tmpl}, $templateVars );
394
    }
395
    $template->process( $templates->{'footer'}, $templateVars );
396
}
397

    
398

    
399
#
400
# Initialize a form for a user to request the account name associated with an email address
401
#
402
sub handleLookupName {
403
    
404
    print "Content-type: text/html\n\n";
405
    # process the template files:
406
    fullTemplate(['lookupName']); 
407
    exit();
408
}
409

    
410
#
411
# Handle the user's request to look up account names with a specified email address.
412
# This relates to "Forget your user name"
413
#
414
sub handleSearchNameByEmail{
415

    
416
    print "Content-type: text/html\n\n";
417
   
418
    my $allParams = {'mail' => $query->param('mail')};
419
    my @requiredParams = ('mail');
420
    if (! paramsAreValid(@requiredParams)) {
421
        my $errorMessage = "Required information is missing. " .
422
            "Please fill in all required fields and resubmit the form.";
423
        fullTemplate(['lookupName'], { allParams => $allParams,
424
                                     errorMessage => $errorMessage });
425
        exit();
426
    }
427
    my $mail = $query->param('mail');
428
    
429
    #search accounts with the specified emails 
430
    $searchBase = $authBase; 
431
    my $filter = "(mail=" . $mail . ")";
432
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
433
    my $notHtmlFormat = 1;
434
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs, $notHtmlFormat);
435
    my $accountInfo;
436
    if ($found) {
437
        $accountInfo = $found;
438
    } else {
439
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n";
440
    }
441

    
442
    my $mailhost = $properties->getProperty('email.mailhost');
443
    my $sender;
444
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
445
    debug("the sender is " . $sender);
446
    my $recipient = $query->param('mail');
447
    # Send the email message to them
448
    my $smtp = Net::SMTP->new($mailhost) or do {  
449
                                                  fullTemplate( ['lookupName'], {allParams => $allParams, 
450
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " . 
451
                                                                $skinProperties->getProperty("email.recipient") . "." });  
452
                                                  exit(0);
453
                                               };
454
    $smtp->mail($sender);
455
    $smtp->to($recipient);
456

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

    
467
    Thanks,
468
        $sender
469
    
470
     ENDOFMESSAGE
471
     $message =~ s/^[ \t\r\f]+//gm;
472
    
473
     $smtp->data($message);
474
     $smtp->quit;
475
     fullTemplate( ['lookupNameSuccess'] );
476
    
477
}
478

    
479

    
480
#
481
# create the initial registration form 
482
#
483
sub handleInitRegister {
484
  my $vars = shift;
485
  print "Content-type: text/html\n\n";
486
  # process the template files:
487
  fullTemplate(['register'], {stage => "register"}); 
488
  exit();
489
}
490

    
491

    
492

    
493
#
494
# process input from the register stage, which occurs when
495
# a user submits form data to create a new account
496
#
497
sub handleRegister {
498
    
499
    #print "Content-type: text/html\n\n";
500
    if ($query->param('o') =~ "LTER") {
501
      print "Content-type: text/html\n\n";
502
      fullTemplate( ['registerLter'] );
503
      exit(0);
504
    } 
505
    
506
    my $allParams = { 'givenName' => $query->param('givenName'), 
507
                      'sn' => $query->param('sn'),
508
                      'o' => $query->param('o'), 
509
                      'mail' => $query->param('mail'), 
510
                      'uid' => $query->param('uid'), 
511
                      'userPassword' => $query->param('userPassword'), 
512
                      'userPassword2' => $query->param('userPassword2'), 
513
                      'title' => $query->param('title'), 
514
                      'telephoneNumber' => $query->param('telephoneNumber') };
515
    
516
    # Check the recaptcha
517
    my $c = Captcha::reCAPTCHA->new;
518
    my $challenge = $query->param('recaptcha_challenge_field');
519
    my $response = $query->param('recaptcha_response_field');
520
    # Verify submission
521
    my $result = $c->check_answer(
522
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
523
        $challenge, $response
524
    );
525

    
526
    if ( $result->{is_valid} ) {
527
        #print "Yes!";
528
        #exit();
529
    }
530
    else {
531
        print "Content-type: text/html\n\n";
532
        my $errorMessage = "The verification code is wrong. Please input again.";
533
        fullTemplate(['register'], { stage => "register",
534
                                     allParams => $allParams,
535
                                     errorMessage => $errorMessage });
536
        exit();
537
    }
538
    
539
    
540
    # Check that all required fields are provided and not null
541
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
542
                           'uid', 'userPassword', 'userPassword2');
543
    if (! paramsAreValid(@requiredParams)) {
544
        print "Content-type: text/html\n\n";
545
        my $errorMessage = "Required information is missing. " .
546
            "Please fill in all required fields and resubmit the form.";
547
        fullTemplate(['register'], { stage => "register",
548
                                     allParams => $allParams,
549
                                     errorMessage => $errorMessage });
550
        exit();
551
    } else {
552
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
553
            print "Content-type: text/html\n\n";
554
            my $errorMessage = "The passwords do not match. Try again.";
555
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
556
                                                            allParams => $allParams,
557
                                                            errorMessage => $errorMessage });
558
            exit();
559
        }
560
        my $o = $query->param('o');    
561
        $searchBase = $ldapConfig->{$o}{'base'};  
562
    }
563
    
564
    # Remove any expired temporary accounts for this subtree before continuing
565
    clearTemporaryAccounts();
566

    
567
    # Search LDAP for matching entries that already exist
568
    # Some forms use a single text search box, whereas others search per
569
    # attribute.
570
    my $filter;
571
    if ($query->param('searchField')) {
572

    
573
      $filter = "(|" . 
574
                "(uid=" . $query->param('searchField') . ") " .
575
                "(mail=" . $query->param('searchField') . ")" .
576
                "(&(sn=" . $query->param('searchField') . ") " . 
577
                "(givenName=" . $query->param('searchField') . "))" . 
578
                ")";
579
    } else {
580
      $filter = "(|" . 
581
                "(uid=" . $query->param('uid') . ") " .
582
                "(mail=" . $query->param('mail') . ")" .
583
                "(&(sn=" . $query->param('sn') . ") " . 
584
                "(givenName=" . $query->param('givenName') . "))" . 
585
                ")";
586
    }
587

    
588
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
589
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
590

    
591
    # If entries match, send back a request to confirm new-user creation
592
    if ($found) {
593
      print "Content-type: text/html\n\n";
594
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
595
                                                     allParams => $allParams,
596
                                                     foundAccounts => $found });
597
    # Otherwise, create a new user in the LDAP directory
598
    } else {
599
        createTemporaryAccount($allParams);
600
    }
601

    
602
    exit();
603
}
604

    
605
#
606
# process input from the registerconfirmed stage, which occurs when
607
# a user chooses to create an account despite similarities to other
608
# existing accounts
609
#
610
sub handleRegisterConfirmed {
611
  
612
    my $allParams = { 'givenName' => $query->param('givenName'), 
613
                      'sn' => $query->param('sn'),
614
                      'o' => $query->param('o'), 
615
                      'mail' => $query->param('mail'), 
616
                      'uid' => $query->param('uid'), 
617
                      'userPassword' => $query->param('userPassword'), 
618
                      'userPassword2' => $query->param('userPassword2'), 
619
                      'title' => $query->param('title'), 
620
                      'telephoneNumber' => $query->param('telephoneNumber') };
621
    #print "Content-type: text/html\n\n";
622
    createTemporaryAccount($allParams);
623
    exit();
624
}
625

    
626
#
627
# change a user's password upon request
628
#
629
sub handleChangePassword {
630

    
631
    print "Content-type: text/html\n\n";
632

    
633
    my $allParams = { 'test' => "1", };
634
    if ($query->param('uid')) {
635
        $$allParams{'uid'} = $query->param('uid');
636
    }
637
    if ($query->param('o')) {
638
        $$allParams{'o'} = $query->param('o');
639
        my $o = $query->param('o');
640
        
641
        $searchBase = $ldapConfig->{$o}{'base'};
642
    }
643

    
644

    
645
    # Check that all required fields are provided and not null
646
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
647
                           'userPassword', 'userPassword2');
648
    if (! paramsAreValid(@requiredParams)) {
649
        my $errorMessage = "Required information is missing. " .
650
            "Please fill in all required fields and submit the form.";
651
        fullTemplate( ['changePass'], { stage => "changepass",
652
                                        allParams => $allParams,
653
                                        errorMessage => $errorMessage });
654
        exit();
655
    }
656

    
657
    # We have all of the info we need, so try to change the password
658
    if ($query->param('userPassword') =~ $query->param('userPassword2')) {
659

    
660
        my $o = $query->param('o');
661
        $searchBase = $ldapConfig->{$o}{'base'};
662
        $ldapUsername = $ldapConfig->{$o}{'user'};
663
        $ldapPassword = $ldapConfig->{$o}{'password'};
664

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

    
692
#
693
# change a user's password upon request - no input params
694
# only display chagepass template without any error
695
#
696
sub handleInitialChangePassword {
697
    print "Content-type: text/html\n\n";
698

    
699
    my $allParams = { 'test' => "1", };
700
    my $errorMessage = "";
701
    fullTemplate( ['changePass'], { stage => "changepass",
702
                                    errorMessage => $errorMessage });
703
    exit();
704
}
705

    
706
#
707
# reset a user's password upon request
708
#
709
sub handleResetPassword {
710

    
711
    print "Content-type: text/html\n\n";
712

    
713
    my $allParams = { 'test' => "1", };
714
    if ($query->param('uid')) {
715
        $$allParams{'uid'} = $query->param('uid');
716
    }
717
    if ($query->param('o')) {
718
        $$allParams{'o'} = $query->param('o');
719
        my $o = $query->param('o');
720
        
721
        $searchBase = $ldapConfig->{$o}{'base'};
722
        $ldapUsername = $ldapConfig->{$o}{'user'};
723
        $ldapPassword = $ldapConfig->{$o}{'password'};
724
    }
725

    
726
    # Check that all required fields are provided and not null
727
    my @requiredParams = ( 'uid', 'o' );
728
    if (! paramsAreValid(@requiredParams)) {
729
        my $errorMessage = "Required information is missing. " .
730
            "Please fill in all required fields and submit the form.";
731
        fullTemplate( ['resetPass'],  { stage => "resetpass",
732
                                        allParams => $allParams,
733
                                        errorMessage => $errorMessage });
734
        exit();
735
    }
736

    
737
    # We have all of the info we need, so try to change the password
738
    my $o = $query->param('o');
739
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
740
    debug("handleResetPassword: dn: $dn");
741
    if ($query->param('o') =~ "LTER") {
742
        fullTemplate( ['registerLter'] );
743
        exit();
744
    } else {
745
        my $errorMessage = "";
746
        my $recipient;
747
        my $userPass;
748
        my $entry = getLdapEntry($ldapurl, $searchBase, 
749
                $query->param('uid'), $query->param('o'));
750

    
751
        if ($entry) {
752
            $recipient = $entry->get_value('mail');
753
            $userPass = getRandomPassword();
754
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
755
        } else {
756
            $errorMessage = "User not found in database.  Please try again.";
757
        }
758

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

    
775
#
776
# reset a user's password upon request- no initial params
777
# only display resetpass template without any error
778
#
779
sub handleInitialResetPassword {
780
    print "Content-type: text/html\n\n";
781
    my $errorMessage = "";
782
    fullTemplate( ['resetPass'], { stage => "resetpass",
783
                                   errorMessage => $errorMessage });
784
    exit();
785
}
786

    
787
#
788
# Construct a random string to use for a newly reset password
789
#
790
sub getRandomPassword {
791
    my $length = shift;
792
    if (!$length) {
793
        $length = 8;
794
    }
795
    my $newPass = "";
796

    
797
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
798
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
799
    return $newPass;
800
}
801

    
802
#
803
# Change a password to a new value, binding as the provided user
804
#
805
sub changePassword {
806
    my $userDN = shift;
807
    my $userPass = shift;
808
    my $bindDN = shift;
809
    my $bindPass = shift;
810
    my $o = shift;
811

    
812
    my $searchBase = $ldapConfig->{$o}{'base'};
813

    
814
    my $errorMessage = 0;
815
    my $ldap;
816

    
817
    #if main ldap server is down, a html file containing warning message will be returned
818
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
819
    
820
    if ($ldap) {
821
        $ldap->start_tls( verify => 'require',
822
                      cafile => $ldapServerCACertFile);
823
        debug("changePassword: attempting to bind to $bindDN");
824
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
825
                                  password => $bindPass );
826
        if ($bindresult->code) {
827
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
828
                            "correct? Please correct and try again...";
829
            return $errorMessage;
830
        }
831

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

    
846
    return $errorMessage;
847
}
848

    
849
#
850
# generate a Seeded SHA1 hash of a plaintext password
851
#
852
sub createSeededPassHash {
853
    my $secret = shift;
854

    
855
    my $salt = "";
856
    for (my $i=0; $i < 4; $i++) {
857
        $salt .= int(rand(10));
858
    }
859

    
860
    my $ctx = Digest::SHA1->new;
861
    $ctx->add($secret);
862
    $ctx->add($salt);
863
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
864

    
865
    return $hashedPasswd;
866
}
867

    
868
#
869
# Look up an ldap entry for a user
870
#
871
sub getLdapEntry {
872
    my $ldapurl = shift;
873
    my $base = shift;
874
    my $username = shift;
875
    my $org = shift;
876

    
877
    my $entry = "";
878
    my $mesg;
879
    my $ldap;
880
    debug("ldap server: $ldapurl");
881

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

    
894
        $base = $ldapConfig->{$org}{'org'} . ',' . $base;
895
        debug("getLdapEntry, searching for $base, (uid=$username)");
896
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
897
    	#if($ldapConfig->{$org}{'filter'}){
898
            #debug("getLdapEntry: filter set, searching for base=$base, " .
899
                  #"(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
900
        	#$mesg = $ldap->search ( base   => $base,
901
                #filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
902
    	#} else {
903
            #debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
904
        	#$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
905
    	#}
906
    
907
    	if ($mesg->count > 0) {
908
        	$entry = $mesg->pop_entry;
909
        	$ldap->unbind;   # take down session
910
    	} else {
911
        	$ldap->unbind;   # take down session
912
        	# Follow references by recursive call to self
913
        	my @references = $mesg->references();
914
        	for (my $i = 0; $i <= $#references; $i++) {
915
            	my $uri = URI->new($references[$i]);
916
            	my $host = $uri->host();
917
            	my $path = $uri->path();
918
            	$path =~ s/^\///;
919
            	$entry = &getLdapEntry($host, $path, $username, $org);
920
            	if ($entry) {
921
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
922
                	return $entry;
923
            	}
924
        	}
925
    	}
926
    }
927
    return $entry;
928
}
929

    
930
# 
931
# send an email message notifying the user of the pw change
932
#
933
sub sendPasswordNotification {
934
    my $username = shift;
935
    my $org = shift;
936
    my $newPass = shift;
937
    my $recipient = shift;
938
    my $cfg = shift;
939

    
940
    my $errorMessage = "";
941
    if ($recipient) {
942
    
943
        my $mailhost = $properties->getProperty('email.mailhost');
944
        my $sender;
945
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
946
        # Send the email message to them
947
        my $smtp = Net::SMTP->new($mailhost);
948
        $smtp->mail($sender);
949
        $smtp->to($recipient);
950

    
951
        my $message = <<"        ENDOFMESSAGE";
952
        To: $recipient
953
        From: $sender
954
        Subject: Your Account Password Reset
955
        
956
        Somebody (hopefully you) requested that your account password be reset.  
957
        Your temporary password is below. Please change it as soon as possible 
958
        at: $contextUrl/style/skins/account/.
959

    
960
            Username: $username
961
        Organization: $org
962
        New Password: $newPass
963

    
964
        Thanks,
965
            $sender
966
    
967
        ENDOFMESSAGE
968
        $message =~ s/^[ \t\r\f]+//gm;
969
    
970
        $smtp->data($message);
971
        $smtp->quit;
972
    } else {
973
        $errorMessage = "Failed to send password because I " .
974
                        "couldn't find a valid email address.";
975
    }
976
    return $errorMessage;
977
}
978

    
979
#
980
# search the LDAP directory to see if a similar account already exists
981
#
982
sub findExistingAccounts {
983
    my $ldapurl = shift;
984
    my $base = shift;
985
    my $filter = shift;
986
    my $attref = shift;
987
    my $notHtmlFormat = shift;
988
    my $ldap;
989
    my $mesg;
990

    
991
    my $foundAccounts = 0;
992

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

    
1007
	    if ($mesg->count() > 0) {
1008
			$foundAccounts = "";
1009
			my $entry;
1010
			foreach $entry ($mesg->all_entries) { 
1011
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
1012
                # this could be done directly with filters on the LDAP connection, instead.
1013
                #if ($entry->dn !~ /ou=Account/) {
1014
                    if($notHtmlFormat) {
1015
                        $foundAccounts .= "\nAccount: ";
1016
                    } else {
1017
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
1018
                    }
1019
                    $foundAccounts .= $entry->dn();
1020
                    if($notHtmlFormat) {
1021
                        $foundAccounts .= "\n";
1022
                    } else {
1023
                        $foundAccounts .= "</b><br />\n";
1024
                    }
1025
                    foreach my $attribute ($entry->attributes()) {
1026
                        my $value = $entry->get_value($attribute);
1027
                        $foundAccounts .= "$attribute: ";
1028
                        $foundAccounts .= $value;
1029
                         if($notHtmlFormat) {
1030
                            $foundAccounts .= "\n";
1031
                        } else {
1032
                            $foundAccounts .= "<br />\n";
1033
                        }
1034
                    }
1035
                    if($notHtmlFormat) {
1036
                        $foundAccounts .= "\n";
1037
                    } else {
1038
                        $foundAccounts .= "</p>\n";
1039
                    }
1040
                    
1041
                #}
1042
			}
1043
        }
1044
    	$ldap->unbind;   # take down session
1045

    
1046
    	# Follow references
1047
    	my @references = $mesg->references();
1048
    	for (my $i = 0; $i <= $#references; $i++) {
1049
        	my $uri = URI->new($references[$i]);
1050
        	my $host = $uri->host();
1051
        	my $path = $uri->path();
1052
        	$path =~ s/^\///;
1053
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
1054
        	if ($refFound) {
1055
            	$foundAccounts .= $refFound;
1056
        	}
1057
    	}
1058
    }
1059

    
1060
    #print "<p>Checking referrals...</p>\n";
1061
    #my @referrals = $mesg->referrals();
1062
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
1063
    #for (my $i = 0; $i <= $#referrals; $i++) {
1064
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
1065
    #}
1066

    
1067
    return $foundAccounts;
1068
}
1069

    
1070
#
1071
# Validate that we have the proper set of input parameters
1072
#
1073
sub paramsAreValid {
1074
    my @pnames = @_;
1075

    
1076
    my $allValid = 1;
1077
    foreach my $parameter (@pnames) {
1078
        if (!defined($query->param($parameter)) || 
1079
            ! $query->param($parameter) ||
1080
            $query->param($parameter) =~ /^\s+$/) {
1081
            $allValid = 0;
1082
        }
1083
    }
1084

    
1085
    return $allValid;
1086
}
1087

    
1088
#
1089
# Create a temporary account for a user and send an email with a link which can click for the
1090
# verification. This is used to protect the ldap server against spams.
1091
#
1092
sub createTemporaryAccount {
1093
    my $allParams = shift;
1094
    my $org = $query->param('o'); 
1095
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1096
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1097
    my $tmp = 1;
1098

    
1099
    ################## 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
1100
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
1101
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
1102
    my $tmpFilter = "dc=tmp";
1103
    my @attributes=['dc'];
1104
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
1105
    if (!$foundTmp) {
1106
        my $dn = $tmpSearchBase;
1107
        my $additions = [ 
1108
                    'dc' => 'tmp',
1109
                    'o'  => 'tmp',
1110
                    'objectclass' => ['top', 'dcObject', 'organization']
1111
                    ];
1112
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1113
    } else {
1114
     debug("found the tmp space");
1115
    }
1116
    
1117
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1118
    my $filter = $ldapConfig->{$org}{'filter'};   
1119
    
1120
    debug("search filer " . $filter);
1121
    debug("ldap server ". $ldapurl);
1122
    debug("sesarch base " . $tmpSearchBase);
1123
    #print "Content-type: text/html\n\n";
1124
    my @attrs = ['o', 'ou' ];
1125
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1126

    
1127
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
1128
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
1129
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
1130
        
1131
    if(!$found) {
1132
        debug("generate the subtree in the dc=tmp===========================");
1133
        #need to generate the subtree o or ou
1134
        my $additions;
1135
            if($organization eq 'ou') {
1136
                $additions = [ 
1137
                    $organization   => $organizationName,
1138
                    'objectclass' => ['top', 'organizationalUnit']
1139
                    ];
1140
            
1141
            } else {
1142
                $additions = [ 
1143
                    $organization   => $organizationName,
1144
                    'objectclass' => ['top', 'organization']
1145
                    ];
1146
            
1147
            } 
1148
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1149
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1150
    } 
1151
    
1152
    ################create an account under tmp subtree 
1153
    
1154
     my $dn_store_next_uid=$properties->getProperty('ldap.nextuid.storing.dn');
1155
    my $attribute_name_store_next_uid = $properties->getProperty('ldap.nextuid.storing.attributename');
1156
    #get the next avaliable uid number. If it fails, the program will exist.
1157
    my $nextUidNumber = getNextUidNumber($ldapUsername, $ldapPassword);
1158
    if(!$nextUidNumber) {
1159
        print "Content-type: text/html\n\n";
1160
         my $sender;
1161
        $sender = $skinProperties->getProperty("email.recipient") or $sender = $properties->getProperty('email.recipient');
1162
        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.
1163
                           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
1164
                           is not a number; or lots of users were registering and you couldn't get a lock on the dn - $dn_store_next_uid.";
1165
        fullTemplate(['register'], { stage => "register",
1166
                                     allParams => $allParams,
1167
                                     errorMessage => $errorMessage });
1168
        exit(0);
1169
    }
1170
    my $cn = join(" ", $query->param('givenName'), $query->param('sn')); 
1171
    #generate a randomstr for matching the email.
1172
    my $randomStr = getRandomPassword(16);
1173
    # Create a hashed version of the password
1174
    my $shapass = createSeededPassHash($query->param('userPassword'));
1175
    my $additions = [ 
1176
                'uid'   => $query->param('uid'),
1177
                'cn'   => $cn,
1178
                'sn'   => $query->param('sn'),
1179
                'givenName'   => $query->param('givenName'),
1180
                'mail' => $query->param('mail'),
1181
                'userPassword' => $shapass,
1182
                'employeeNumber' => $randomStr,
1183
                'uidNumber' => $nextUidNumber,
1184
                'gidNumber' => $nextUidNumber,
1185
                'loginShell' => '/sbin/nologin',
1186
                'homeDirectory' => '/dev/null',
1187
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1188
                                'inetOrgPerson', 'posixAccount', 'shadowAccount' ],
1189
                $organization   => $organizationName
1190
                ];
1191
    my $gecos;
1192
    if (defined($query->param('telephoneNumber')) && 
1193
                $query->param('telephoneNumber') &&
1194
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1195
                $$additions[$#$additions + 1] = 'telephoneNumber';
1196
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1197
                $gecos = $cn . ',,'. $query->param('telephoneNumber'). ',';
1198
    } else {
1199
        $gecos = $cn . ',,,';
1200
    }
1201
    
1202
    $$additions[$#$additions + 1] = 'gecos';
1203
    $$additions[$#$additions + 1] = $gecos;
1204
    
1205
    if (defined($query->param('title')) && 
1206
                $query->param('title') &&
1207
                ! $query->param('title') =~ /^\s+$/) {
1208
                $$additions[$#$additions + 1] = 'title';
1209
                $$additions[$#$additions + 1] = $query->param('title');
1210
    }
1211

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

    
1245
    my $message = <<"     ENDOFMESSAGE";
1246
    To: $recipient
1247
    From: $sender
1248
    Subject: New Account Activation
1249
        
1250
    Somebody (hopefully you) registered an account on $contextUrl/style/skins/account/.  
1251
    Please click the following link to activate your account.
1252
    If the link doesn't work, please copy the link to your browser:
1253
    
1254
    $link
1255

    
1256
    Thanks,
1257
        $sender
1258
    
1259
     ENDOFMESSAGE
1260
     $message =~ s/^[ \t\r\f]+//gm;
1261
    
1262
     $smtp->data($message);
1263
     $smtp->quit;
1264
    debug("the link is " . $link);
1265
    fullTemplate( ['success'] );
1266
    
1267
}
1268

    
1269
#
1270
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1271
# by the user
1272
#
1273
sub createItem {
1274
    my $dn = shift;
1275
    my $ldapUsername = shift;
1276
    my $ldapPassword = shift;
1277
    my $additions = shift;
1278
    my $temp = shift; #if it is for a temporary account.
1279
    my $allParams = shift;
1280
    
1281
    my @failureTemplate;
1282
    if($temp){
1283
        @failureTemplate = ['registerFailed', 'register'];
1284
    } else {
1285
        @failureTemplate = ['registerFailed'];
1286
    }
1287
    print "Content-type: text/html\n\n";
1288
    debug("the dn is " . $dn);
1289
    debug("LDAP connection to $ldapurl...");    
1290
    #if main ldap server is down, a html file containing warning message will be returned
1291
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1292
    if ($ldap) {
1293
            $ldap->start_tls( verify => 'require',
1294
                      cafile => $ldapServerCACertFile);
1295
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1296
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1297
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1298
            if ($result->code()) {
1299
                fullTemplate(@failureTemplate, { stage => "register",
1300
                                                            allParams => $allParams,
1301
                                                            errorMessage => $result->error });
1302
                exist(0);
1303
                # TODO SCW was included as separate errors, test this
1304
                #$templateVars    = setVars({ stage => "register",
1305
                #                     allParams => $allParams });
1306
                #$template->process( $templates->{'register'}, $templateVars);
1307
            } else {
1308
                #fullTemplate( ['success'] );
1309
            }
1310
            $ldap->unbind;   # take down session
1311
            
1312
    } else {   
1313
         fullTemplate(@failureTemplate, { stage => "register",
1314
                                                            allParams => $allParams,
1315
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1316
         exit(0);
1317
    }
1318
  
1319
}
1320

    
1321

    
1322

    
1323

    
1324

    
1325

    
1326
#
1327
# This subroutine will handle a email verification:
1328
# If the hash string matches the one store in the ldap, the account will be
1329
# copied from the temporary space to the permanent tree and the account in 
1330
# the temporary space will be removed.
1331
sub handleEmailVerification {
1332

    
1333
    my $cfg = $query->param('cfg');
1334
    my $dn = $query->param('dn');
1335
    my $hash = $query->param('hash');
1336
    my $org = $query->param('o');
1337
    my $uid = $query->param('uid');
1338
    
1339
    my $ldapUsername;
1340
    my $ldapPassword;
1341
    #my $orgAuthBase;
1342

    
1343
    $ldapUsername = $ldapConfig->{$org}{'user'};
1344
    $ldapPassword = $ldapConfig->{$org}{'password'};
1345
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1346
    
1347
    debug("LDAP connection to $ldapurl...");    
1348
    
1349

    
1350
   print "Content-type: text/html\n\n";
1351
   #if main ldap server is down, a html file containing warning message will be returned
1352
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1353
   if ($ldap) {
1354
        $ldap->start_tls( verify => 'require',
1355
                      cafile => $ldapServerCACertFile);
1356
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1357
        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.
1358
        my $max = $mesg->count;
1359
        debug("the count is " . $max);
1360
        if($max < 1) {
1361
            $ldap->unbind;   # take down session
1362
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1363
            #handleLDAPBindFailure($ldapurl);
1364
            exit(0);
1365
        } else {
1366
            #check if the hash string match
1367
            my $entry = $mesg->entry (0);
1368
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1369
            if( $hashStrFromLdap eq $hash) {
1370
                #my $additions = [ ];
1371
                #foreach my $attr ( $entry->attributes ) {
1372
                    #if($attr ne 'employeeNumber') {
1373
                        #$$additions[$#$additions + 1] = $attr;
1374
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1375
                    #}
1376
                #}
1377

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

    
1405
}
1406

    
1407
sub handleResponseMessage {
1408

    
1409
  print "Content-type: text/html\n\n";
1410
  my $errorMessage = "You provided invalid input to the script. " .
1411
                     "Try again please.";
1412
  fullTemplate( [], { stage => $templates->{'stage'},
1413
                      errorMessage => $errorMessage });
1414
  exit();
1415
}
1416

    
1417
#
1418
# perform a simple search against the LDAP database using 
1419
# a small subset of attributes of each dn and return it
1420
# as a table to the calling browser.
1421
#
1422
sub handleSimpleSearch {
1423

    
1424
    my $o = $query->param('o');
1425

    
1426
    my $ldapurl = $ldapConfig->{$o}{'url'};
1427
    my $searchBase = $ldapConfig->{$o}{'base'};
1428

    
1429
    print "Content-type: text/html\n\n";
1430

    
1431
    my $allParams = { 
1432
                      'cn' => $query->param('cn'),
1433
                      'sn' => $query->param('sn'),
1434
                      'gn' => $query->param('gn'),
1435
                      'o'  => $query->param('o'),
1436
                      'facsimiletelephonenumber' 
1437
                      => $query->param('facsimiletelephonenumber'),
1438
                      'mail' => $query->param('cmail'),
1439
                      'telephonenumber' => $query->param('telephonenumber'),
1440
                      'title' => $query->param('title'),
1441
                      'uid' => $query->param('uid'),
1442
                      'ou' => $query->param('ou'),
1443
                    };
1444

    
1445
    # Search LDAP for matching entries that already exist
1446
    my $filter = "(" . 
1447
                 $query->param('searchField') . "=" .
1448
                 "*" .
1449
                 $query->param('searchValue') .
1450
                 "*" .
1451
                 ")";
1452

    
1453
    my @attrs = [ 'sn', 
1454
                  'gn', 
1455
                  'cn', 
1456
                  'o', 
1457
                  'facsimiletelephonenumber', 
1458
                  'mail', 
1459
                  'telephoneNumber', 
1460
                  'title', 
1461
                  'uid', 
1462
                  'labeledURI', 
1463
                  'ou' ];
1464

    
1465
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1466

    
1467
    # Send back the search results
1468
    if ($found) {
1469
      fullTemplate( ('searchResults'), { stage => "searchresults",
1470
                                         allParams => $allParams,
1471
                                         foundAccounts => $found });
1472
    } else {
1473
      $found = "No entries matched your criteria.  Please try again\n";
1474

    
1475
      fullTemplate( ('searchResults'), { stage => "searchresults",
1476
                                         allParams => $allParams,
1477
                                         foundAccounts => $found });
1478
    }
1479

    
1480
    exit();
1481
}
1482

    
1483
#
1484
# search the LDAP directory to see if a similar account already exists
1485
#
1486
sub searchDirectory {
1487
    my $ldapurl = shift;
1488
    my $base = shift;
1489
    my $filter = shift;
1490
    my $attref = shift;
1491

    
1492
	my $mesg;
1493
    my $foundAccounts = 0;
1494
    
1495
    #if ldap server is down, a html file containing warning message will be returned
1496
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1497
    
1498
    if ($ldap) {
1499
    	$ldap->start_tls( verify => 'require',
1500
                      cafile => $ldapServerCACertFile);
1501
    	$ldap->bind( version => 3, anonymous => 1);
1502
    	my $mesg = $ldap->search (
1503
        	base   => $base,
1504
        	filter => $filter,
1505
        	attrs => @$attref,
1506
    	);
1507

    
1508
    	if ($mesg->count() > 0) {
1509
        	$foundAccounts = "";
1510
        	my $entry;
1511
        	foreach $entry ($mesg->sorted(['sn'])) {
1512
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1513
          		$foundAccounts .= "<a href=\"" unless 
1514
                    (!$entry->get_value('labeledURI'));
1515
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1516
                    (!$entry->get_value('labeledURI'));
1517
          		$foundAccounts .= "\">\n" unless 
1518
                    (!$entry->get_value('labeledURI'));
1519
          		$foundAccounts .= $entry->get_value('givenName');
1520
          		$foundAccounts .= "</a>\n" unless 
1521
                    (!$entry->get_value('labeledURI'));
1522
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1523
          		$foundAccounts .= "<a href=\"" unless 
1524
                    (!$entry->get_value('labeledURI'));
1525
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1526
                    (!$entry->get_value('labeledURI'));
1527
          		$foundAccounts .= "\">\n" unless 
1528
                    (!$entry->get_value('labeledURI'));
1529
          		$foundAccounts .= $entry->get_value('sn');
1530
          		$foundAccounts .= "</a>\n";
1531
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1532
          		$foundAccounts .= $entry->get_value('mail');
1533
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1534
          		$foundAccounts .= $entry->get_value('telephonenumber');
1535
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1536
          		$foundAccounts .= $entry->get_value('title');
1537
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1538
          		$foundAccounts .= $entry->get_value('ou');
1539
          		$foundAccounts .= "\n</td>\n";
1540
          		$foundAccounts .= "</tr>\n";
1541
        	}
1542
    	}
1543
    	$ldap->unbind;   # take down session
1544
    }
1545
    return $foundAccounts;
1546
}
1547

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

    
1556
sub handleLDAPBindFailure {
1557
    my $ldapAttemptUrl = shift;
1558
    my $primaryLdap =  $properties->getProperty('auth.url');
1559

    
1560
    if ($ldapAttemptUrl eq  $primaryLdap) {
1561
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1562
    } else {
1563
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1564
    }
1565
}
1566

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

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

    
1596
    my $maxAttempt = $properties->getProperty('ldap.nextuid.maxattempt');
1597
    
1598
    my $ldapUsername = shift;
1599
    my $ldapPassword = shift;
1600
    
1601
    my $realUidNumber;
1602
    my $uidNumber;
1603
    my $entry;
1604
    my $mesg;
1605
    my $ldap;
1606
    
1607
    debug("ldap server: $ldapurl");
1608
    
1609
    #if main ldap server is down, a html file containing warning message will be returned
1610
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1611
    
1612
    if ($ldap) {
1613
        $ldap->start_tls( verify => 'require',
1614
                      cafile => $ldapServerCACertFile);
1615
        my $bindresult = $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword);
1616
        #read the uid value stored in uidObject class
1617
        for(my $index=0; $index<$maxAttempt; $index++) {
1618
            $mesg = $ldap->search(base  => $dn_store_next_uid, filter => '(objectClass=*)');
1619
            if ($mesg->count() > 0) {
1620
                debug("Find the cn - $dn_store_next_uid");
1621
                $entry = $mesg->pop_entry;
1622
                $uidNumber = $entry->get_value($attribute_name_store_next_uid);
1623
                if($uidNumber) {
1624
                    if (looks_like_number($uidNumber)) {
1625
                        debug("uid number is $uidNumber");
1626
                        #remove the uid attribute with the read value
1627
                        my $delMesg = $ldap->modify($dn_store_next_uid, delete => { $attribute_name_store_next_uid => $uidNumber});
1628
                        if($delMesg->is_error()) {
1629
                            my $error=$delMesg->error();
1630
                            my $errorName = $delMesg->error_name();
1631
                            debug("can't remove the attribute - $error");
1632
                            debug("can't remove the attribute and the error name - $errorName");
1633
                            #can't remove the attribute with the specified value - that means somebody modify the value in another route, so try it again
1634
                        } else {
1635
                            debug("Remove the attribute successfully and write a new increased value back");
1636
                            my $newValue = $uidNumber +1;
1637
                            $delMesg = $ldap->modify($dn_store_next_uid, add => {$attribute_name_store_next_uid => $newValue});
1638
                            $realUidNumber = $uidNumber;
1639
                            last;
1640
                        }
1641
                    }
1642
                    
1643
               } else {
1644
                 debug("can't find the attribute - $attribute_name_store_next_uid in the $dn_store_next_uid and we will try again");
1645
               }
1646
            } 
1647
        }
1648
        $ldap->unbind;   # take down session
1649
    }
1650
    return $realUidNumber;
1651
}
1652

    
1653

    
(10-10/14)