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: 2013-11-21 09:55:07 -0800 (Thu, 21 Nov 2013) $'
8
# '$Revision: 8410 $' 
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

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

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

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

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

    
79
my $metacatUrl = $contextUrl . "/metacat";
80
my $cgiPrefix = "/" . $context . "/cgi-bin";
81
my $styleSkinsPath = $contextUrl . "/style/skins";
82
my $styleCommonPath = $contextUrl . "/style/common";
83
my $ldapServerCACertFile = $workingDirectory. "/../" . $properties->getProperty('ldap.server.ca.certificate');
84

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

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

    
92
my $emailVerification= 'emailverification';
93

    
94
# Import all of the HTML form fields as variables
95
import_names('FORM');
96

    
97
# Must have a config to use Metacat
98
my $skinName = "";
99
if ($FORM::cfg) {
100
    $skinName = $FORM::cfg;
101
} elsif ($ARGV[0]) {
102
    $skinName = $ARGV[0];
103
} else {
104
    debug("No configuration set.");
105
    print "Content-type: text/html\n\n";
106
    print 'LDAPweb Error: The registry requires a skin name to continue.';
107
    exit();
108
}
109

    
110
# Metacat isn't initialized, the registry will fail in strange ways.
111
if (!($metacatUrl)) {
112
    debug("No Metacat.");
113
    print "Content-type: text/html\n\n";
114
    'Registry Error: Metacat is not initialized! Make sure' .
115
        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';
116
    exit();
117
}
118

    
119
my $skinProperties = new Config::Properties();
120
if (!($skinName)) {
121
    $error = "Application misconfigured.  Please contact the administrator.";
122
    push(@errorMessages, $error);
123
} else {
124
    my $skinProps = "$skinsDir/$skinName/$skinName.properties";
125
    unless (open (SKIN_PROPERTIES, $skinProps)) {
126
        print "Content-type: text/html\n\n";
127
        print "Unable to locate skin properties at $skinProps.  Is this path correct?";
128
        exit(0);
129
    }
130
    $skinProperties->load(*SKIN_PROPERTIES);
131
}
132

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

    
135
# XXX HACK: this is a temporary fix to pull out the UCNRS password property from the
136
#           NRS skin instead of metacat.properties. The intent is to prevent editing
137
#           of our core properties file, which is manipulated purely through the web.
138
#           Once organizations are editable, this section should be removed as should
139
#           the properties within nrs/nrs.properties.
140
my $nrsProperties = new Config::Properties();
141
my $nrsProps = "$skinsDir/nrs/nrs.properties";
142
unless (open (NRS_PROPERTIES, $nrsProps)) {
143
    print "Content-type: text/html\n\n";
144
    print "Unable to locate skin properties at $nrsProps.  Is this path correct?";
145
    exit(0);
146
}
147
$nrsProperties->load(*NRS_PROPERTIES);
148

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

    
151
# XXX END HACK
152

    
153

    
154
my $searchBase;
155
my $ldapUsername;
156
my $ldapPassword;
157
# TODO: when should we use surl instead? Is there a setting promoting one over the other?
158
# TODO: the default tree for accounts should be exposed somewhere, defaulting to unaffiliated
159
my $ldapurl = $properties->getProperty('auth.url');
160

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

    
164
# Get the CGI input variables
165
my $query = new CGI;
166
my $debug = 1;
167

    
168
#--------------------------------------------------------------------------80c->
169
# Set up the Template Toolkit to read html form templates
170

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

    
176
# set some configuration options for the template object
177
my $ttConfig = {
178
             INCLUDE_PATH => $templatesDir,
179
             INTERPOLATE  => 0,
180
             POST_CHOMP   => 1,
181
             DEBUG        => 1, 
182
             };
183

    
184
# create an instance of the template
185
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
186

    
187
# custom LDAP properties hash
188
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
189

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

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

    
198
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. 
199
while (my ($oKey, $oVal) = each(%$orgNames)) {
200
    push(@orgList, $oKey);
201
}
202

    
203
my $authBase = $properties->getProperty("auth.base");
204
my $ldapConfig;
205
foreach my $o (@orgList) {
206
    foreach my $d (@orgData) {
207
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
208
    }
209

    
210
    # XXX hack, remove after 1.9
211
    if ($o eq 'UCNRS') {
212
        $ldapConfig->{'UCNRS'}{'base'} = $nrsConfig->{'base'};
213
        $ldapConfig->{'UCNRS'}{'user'} = $nrsConfig->{'username'};
214
        $ldapConfig->{'UCNRS'}{'password'} = $nrsConfig->{'password'};
215
    }
216

    
217
    # set default base
218
    if (!$ldapConfig->{$o}{'base'}) {
219
        $ldapConfig->{$o}{'base'} = $authBase;
220
    }
221

    
222
    # include filter information. By default, our filters are 'o=$name', e.g. 'o=NAPIER'
223
    # these can be overridden by specifying them in metacat.properties. Non-default configs
224
    # such as UCNRS must specify all LDAP properties.
225
    if ($ldapConfig->{$o}{'base'} eq $authBase) {
226
        my $filter = "o=$o";
227
        if (!$ldapConfig->{$o}{'org'}) {
228
            $ldapConfig->{$o}{'org'} = $filter;
229
        }
230
        if (!$ldapConfig->{$o}{'filter'}) {
231
            #$ldapConfig->{$o}{'filter'} = $filter;
232
            $ldapConfig->{$o}{'filter'} = $ldapConfig->{$o}{'org'};
233
        }
234
        # also include DN, which is just org + base
235
        if ($ldapConfig->{$o}{'org'}) {
236
            $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'org'} . "," . $ldapConfig->{$o}{'base'};
237
        }
238
    } else {
239
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
240
    }
241
    
242
    # set LDAP administrator user account
243
    if (!$ldapConfig->{$o}{'user'}) {
244
        $ldapConfig->{$o}{'user'} = $ldapConfig->{'unaffiliated'}{'user'};
245
    }
246
    # check for a fully qualified LDAP name. If it doesn't exist, append base.
247
    my @userParts = split(',', $ldapConfig->{$o}{'user'});
248
    if (scalar(@userParts) == 1) {
249
        $ldapConfig->{$o}{'user'} = $ldapConfig->{$o}{'user'} . "," . $ldapConfig->{$o}{'base'};
250
    }
251

    
252
    if (!$ldapConfig->{$o}{'password'}) {
253
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
254
    }
255
}
256

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

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

    
265
my %orgNamesHash = %$orgNames;
266
foreach my $element (@displayOrgList) {
267
    if(exists $orgNamesHash{$element}) {
268
         debug("push the organization " . $element . " into the dispaly array");
269
         #if the name is found in the organization part of metacat.properties, put it into the valid array
270
         push(@validDisplayOrgList, $element);
271
    } 
272
    
273
}
274

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

    
285

    
286
#--------------------------------------------------------------------------80c->
287
# Define the main program logic that calls subroutines to do the work
288
#--------------------------------------------------------------------------80c->
289

    
290
# The processing step we are handling
291
my $stage = $query->param('stage') || $templates->{'stage'};
292

    
293
my $cfg = $query->param('cfg');
294
debug("started with stage $stage, cfg $cfg");
295

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

    
316
# call the appropriate routine based on the stage
317
if ( $stages{$stage} ) {
318
  $stages{$stage}->();
319
} else {
320
  &handleResponseMessage();
321
}
322

    
323
#--------------------------------------------------------------------------80c->
324
# Define the subroutines to do the work
325
#--------------------------------------------------------------------------80c->
326

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

    
344
    my $ldap;
345
    my $mesg;
346
    
347
    my $dn;
348

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

    
373
    return 0;
374
}
375

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

    
394

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

    
406
#
407
# Handle the user's request to look up account names with a specified email address.
408
# This relates to "Forget your user name"
409
#
410
sub handleSearchNameByEmail{
411

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

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

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

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

    
475

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

    
487

    
488

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

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

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

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

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

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

    
598
    exit();
599
}
600

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

    
622
#
623
# change a user's password upon request
624
#
625
sub handleChangePassword {
626

    
627
    print "Content-type: text/html\n\n";
628

    
629
    my $allParams = { 'test' => "1", };
630
    if ($query->param('uid')) {
631
        $$allParams{'uid'} = $query->param('uid');
632
    }
633
    if ($query->param('o')) {
634
        $$allParams{'o'} = $query->param('o');
635
        my $o = $query->param('o');
636
        
637
        $searchBase = $ldapConfig->{$o}{'base'};
638
    }
639

    
640

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

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

    
656
        my $o = $query->param('o');
657
        $searchBase = $ldapConfig->{$o}{'base'};
658
        $ldapUsername = $ldapConfig->{$o}{'user'};
659
        $ldapPassword = $ldapConfig->{$o}{'password'};
660

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

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

    
695
    my $allParams = { 'test' => "1", };
696
    my $errorMessage = "";
697
    fullTemplate( ['changePass'], { stage => "changepass",
698
                                    errorMessage => $errorMessage });
699
    exit();
700
}
701

    
702
#
703
# reset a user's password upon request
704
#
705
sub handleResetPassword {
706

    
707
    print "Content-type: text/html\n\n";
708

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

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

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

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

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

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

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

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

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

    
808
    my $searchBase = $ldapConfig->{$o}{'base'};
809

    
810
    my $errorMessage = 0;
811
    my $ldap;
812

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

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

    
842
    return $errorMessage;
843
}
844

    
845
#
846
# generate a Seeded SHA1 hash of a plaintext password
847
#
848
sub createSeededPassHash {
849
    my $secret = shift;
850

    
851
    my $salt = "";
852
    for (my $i=0; $i < 4; $i++) {
853
        $salt .= int(rand(10));
854
    }
855

    
856
    my $ctx = Digest::SHA1->new;
857
    $ctx->add($secret);
858
    $ctx->add($salt);
859
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
860

    
861
    return $hashedPasswd;
862
}
863

    
864
#
865
# Look up an ldap entry for a user
866
#
867
sub getLdapEntry {
868
    my $ldapurl = shift;
869
    my $base = shift;
870
    my $username = shift;
871
    my $org = shift;
872

    
873
    my $entry = "";
874
    my $mesg;
875
    my $ldap;
876
    debug("ldap server: $ldapurl");
877

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

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

    
922
# 
923
# send an email message notifying the user of the pw change
924
#
925
sub sendPasswordNotification {
926
    my $username = shift;
927
    my $org = shift;
928
    my $newPass = shift;
929
    my $recipient = shift;
930
    my $cfg = shift;
931

    
932
    my $errorMessage = "";
933
    if ($recipient) {
934
    
935
        my $mailhost = $properties->getProperty('email.mailhost');
936
        my $sender;
937
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
938
        # Send the email message to them
939
        my $smtp = Net::SMTP->new($mailhost);
940
        $smtp->mail($sender);
941
        $smtp->to($recipient);
942

    
943
        my $message = <<"        ENDOFMESSAGE";
944
        To: $recipient
945
        From: $sender
946
        Subject: Your Account Password Reset
947
        
948
        Somebody (hopefully you) requested that your account password be reset.  
949
        Your temporary password is below. Please change it as soon as possible 
950
        at: $contextUrl.
951

    
952
            Username: $username
953
        Organization: $org
954
        New Password: $newPass
955

    
956
        Thanks,
957
            $sender
958
    
959
        ENDOFMESSAGE
960
        $message =~ s/^[ \t\r\f]+//gm;
961
    
962
        $smtp->data($message);
963
        $smtp->quit;
964
    } else {
965
        $errorMessage = "Failed to send password because I " .
966
                        "couldn't find a valid email address.";
967
    }
968
    return $errorMessage;
969
}
970

    
971
#
972
# search the LDAP directory to see if a similar account already exists
973
#
974
sub findExistingAccounts {
975
    my $ldapurl = shift;
976
    my $base = shift;
977
    my $filter = shift;
978
    my $attref = shift;
979
    my $notHtmlFormat = shift;
980
    my $ldap;
981
    my $mesg;
982

    
983
    my $foundAccounts = 0;
984

    
985
    #if main ldap server is down, a html file containing warning message will be returned
986
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
987
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
988
    if ($ldap) {
989
    	#$ldap->start_tls( verify => 'none');
990
    	$ldap->start_tls( verify => 'require',
991
                      cafile => $ldapServerCACertFile);
992
    	$ldap->bind( version => 3, anonymous => 1);
993
		$mesg = $ldap->search (
994
			base   => $base,
995
			filter => $filter,
996
			attrs => @$attref,
997
		);
998

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

    
1038
    	# Follow references
1039
    	my @references = $mesg->references();
1040
    	for (my $i = 0; $i <= $#references; $i++) {
1041
        	my $uri = URI->new($references[$i]);
1042
        	my $host = $uri->host();
1043
        	my $path = $uri->path();
1044
        	$path =~ s/^\///;
1045
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
1046
        	if ($refFound) {
1047
            	$foundAccounts .= $refFound;
1048
        	}
1049
    	}
1050
    }
1051

    
1052
    #print "<p>Checking referrals...</p>\n";
1053
    #my @referrals = $mesg->referrals();
1054
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
1055
    #for (my $i = 0; $i <= $#referrals; $i++) {
1056
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
1057
    #}
1058

    
1059
    return $foundAccounts;
1060
}
1061

    
1062
#
1063
# Validate that we have the proper set of input parameters
1064
#
1065
sub paramsAreValid {
1066
    my @pnames = @_;
1067

    
1068
    my $allValid = 1;
1069
    foreach my $parameter (@pnames) {
1070
        if (!defined($query->param($parameter)) || 
1071
            ! $query->param($parameter) ||
1072
            $query->param($parameter) =~ /^\s+$/) {
1073
            $allValid = 0;
1074
        }
1075
    }
1076

    
1077
    return $allValid;
1078
}
1079

    
1080
#
1081
# Create a temporary account for a user and send an email with a link which can click for the
1082
# verification. This is used to protect the ldap server against spams.
1083
#
1084
sub createTemporaryAccount {
1085
    my $allParams = shift;
1086
    my $org = $query->param('o'); 
1087
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1088
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1089
    my $tmp = 1;
1090

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

    
1119
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
1120
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
1121
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
1122
        
1123
    if(!$found) {
1124
        debug("generate the subtree in the dc=tmp===========================");
1125
        #need to generate the subtree o or ou
1126
        my $additions;
1127
            if($organization eq 'ou') {
1128
                $additions = [ 
1129
                    $organization   => $organizationName,
1130
                    'objectclass' => ['top', 'organizationalUnit']
1131
                    ];
1132
            
1133
            } else {
1134
                $additions = [ 
1135
                    $organization   => $organizationName,
1136
                    'objectclass' => ['top', 'organization']
1137
                    ];
1138
            
1139
            } 
1140
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1141
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1142
    } 
1143
    
1144
    ################create an account under tmp subtree 
1145
    
1146
    #generate a randomstr for matching the email.
1147
    my $randomStr = getRandomPassword(16);
1148
    # Create a hashed version of the password
1149
    my $shapass = createSeededPassHash($query->param('userPassword'));
1150
    my $additions = [ 
1151
                'uid'   => $query->param('uid'),
1152
                'cn'   => join(" ", $query->param('givenName'), 
1153
                                    $query->param('sn')),
1154
                'sn'   => $query->param('sn'),
1155
                'givenName'   => $query->param('givenName'),
1156
                'mail' => $query->param('mail'),
1157
                'userPassword' => $shapass,
1158
                'employeeNumber' => $randomStr,
1159
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1160
                                'inetOrgPerson', 'uidObject' ],
1161
                $organization   => $organizationName
1162
                ];
1163
    if (defined($query->param('telephoneNumber')) && 
1164
                $query->param('telephoneNumber') &&
1165
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1166
                $$additions[$#$additions + 1] = 'telephoneNumber';
1167
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1168
    }
1169
    if (defined($query->param('title')) && 
1170
                $query->param('title') &&
1171
                ! $query->param('title') =~ /^\s+$/) {
1172
                $$additions[$#$additions + 1] = 'title';
1173
                $$additions[$#$additions + 1] = $query->param('title');
1174
    }
1175

    
1176
    
1177
    #$$additions[$#$additions + 1] = 'o';
1178
    #$$additions[$#$additions + 1] = $org;
1179
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1180
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1181
    
1182
    
1183
    ####################send the verification email to the user
1184
    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.
1185
    
1186
    my $overrideURL;
1187
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1188
    debug("the overrideURL is " . $overrideURL);
1189
    if (defined($overrideURL) && !($overrideURL eq '')) {
1190
    	$link = $serverUrl . $overrideURL . $link;
1191
    } else {
1192
    	$link = $serverUrl . $link;
1193
    }
1194
    
1195
    my $mailhost = $properties->getProperty('email.mailhost');
1196
    my $sender;
1197
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1198
    debug("the sender is " . $sender);
1199
    my $recipient = $query->param('mail');
1200
    # Send the email message to them
1201
    my $smtp = Net::SMTP->new($mailhost) or do {  
1202
                                                  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 " . 
1203
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1204
                                                  exit(0);
1205
                                               };
1206
    $smtp->mail($sender);
1207
    $smtp->to($recipient);
1208

    
1209
    my $message = <<"     ENDOFMESSAGE";
1210
    To: $recipient
1211
    From: $sender
1212
    Subject: New Account Activation
1213
        
1214
    Somebody (hopefully you) registered an account on $contextUrl.  
1215
    Please click the following link to activate your account.
1216
    If the link doesn't work, please copy the link to your browser:
1217
    
1218
    $link
1219

    
1220
    Thanks,
1221
        $sender
1222
    
1223
     ENDOFMESSAGE
1224
     $message =~ s/^[ \t\r\f]+//gm;
1225
    
1226
     $smtp->data($message);
1227
     $smtp->quit;
1228
    debug("the link is " . $link);
1229
    fullTemplate( ['success'] );
1230
    
1231
}
1232

    
1233
#
1234
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1235
# by the user
1236
#
1237
sub createItem {
1238
    my $dn = shift;
1239
    my $ldapUsername = shift;
1240
    my $ldapPassword = shift;
1241
    my $additions = shift;
1242
    my $temp = shift; #if it is for a temporary account.
1243
    my $allParams = shift;
1244
    
1245
    my @failureTemplate;
1246
    if($temp){
1247
        @failureTemplate = ['registerFailed', 'register'];
1248
    } else {
1249
        @failureTemplate = ['registerFailed'];
1250
    }
1251
    print "Content-type: text/html\n\n";
1252
    debug("the dn is " . $dn);
1253
    debug("LDAP connection to $ldapurl...");    
1254
    #if main ldap server is down, a html file containing warning message will be returned
1255
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1256
    if ($ldap) {
1257
            $ldap->start_tls( verify => 'require',
1258
                      cafile => $ldapServerCACertFile);
1259
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1260
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1261
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1262
            if ($result->code()) {
1263
                fullTemplate(@failureTemplate, { stage => "register",
1264
                                                            allParams => $allParams,
1265
                                                            errorMessage => $result->error });
1266
                exist(0);
1267
                # TODO SCW was included as separate errors, test this
1268
                #$templateVars    = setVars({ stage => "register",
1269
                #                     allParams => $allParams });
1270
                #$template->process( $templates->{'register'}, $templateVars);
1271
            } else {
1272
                #fullTemplate( ['success'] );
1273
            }
1274
            $ldap->unbind;   # take down session
1275
            
1276
    } else {   
1277
         fullTemplate(@failureTemplate, { stage => "register",
1278
                                                            allParams => $allParams,
1279
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1280
         exit(0);
1281
    }
1282
  
1283
}
1284

    
1285

    
1286

    
1287

    
1288

    
1289

    
1290
#
1291
# This subroutine will handle a email verification:
1292
# If the hash string matches the one store in the ldap, the account will be
1293
# copied from the temporary space to the permanent tree and the account in 
1294
# the temporary space will be removed.
1295
sub handleEmailVerification {
1296

    
1297
    my $cfg = $query->param('cfg');
1298
    my $dn = $query->param('dn');
1299
    my $hash = $query->param('hash');
1300
    my $org = $query->param('o');
1301
    my $uid = $query->param('uid');
1302
    
1303
    my $ldapUsername;
1304
    my $ldapPassword;
1305
    #my $orgAuthBase;
1306

    
1307
    $ldapUsername = $ldapConfig->{$org}{'user'};
1308
    $ldapPassword = $ldapConfig->{$org}{'password'};
1309
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1310
    
1311
    debug("LDAP connection to $ldapurl...");    
1312
    
1313

    
1314
   print "Content-type: text/html\n\n";
1315
   #if main ldap server is down, a html file containing warning message will be returned
1316
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1317
   if ($ldap) {
1318
        $ldap->start_tls( verify => 'require',
1319
                      cafile => $ldapServerCACertFile);
1320
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1321
        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.
1322
        my $max = $mesg->count;
1323
        debug("the count is " . $max);
1324
        if($max < 1) {
1325
            $ldap->unbind;   # take down session
1326
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1327
            #handleLDAPBindFailure($ldapurl);
1328
            exit(0);
1329
        } else {
1330
            #check if the hash string match
1331
            my $entry = $mesg->entry (0);
1332
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1333
            if( $hashStrFromLdap eq $hash) {
1334
                #my $additions = [ ];
1335
                #foreach my $attr ( $entry->attributes ) {
1336
                    #if($attr ne 'employeeNumber') {
1337
                        #$$additions[$#$additions + 1] = $attr;
1338
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1339
                    #}
1340
                #}
1341

    
1342
                
1343
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1344
                $mesg = $ldap->moddn(
1345
                            dn => $dn,
1346
                            deleteoldrdn => 1,
1347
                            newrdn => "uid=" . $uid,
1348
                            newsuperior  =>  $orgDn);
1349
                $ldap->unbind;   # take down session
1350
                if($mesg->code()) {
1351
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1352
                    exit(0);
1353
                } else {
1354
                    fullTemplate( ['verificationSuccess'] );
1355
                }
1356
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1357
            } else {
1358
                $ldap->unbind;   # take down session
1359
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1360
                exit(0);
1361
            }
1362
            
1363
        }
1364
    } else {   
1365
        handleLDAPBindFailure($ldapurl);
1366
        exit(0);
1367
    }
1368

    
1369
}
1370

    
1371
sub handleResponseMessage {
1372

    
1373
  print "Content-type: text/html\n\n";
1374
  my $errorMessage = "You provided invalid input to the script. " .
1375
                     "Try again please.";
1376
  fullTemplate( [], { stage => $templates->{'stage'},
1377
                      errorMessage => $errorMessage });
1378
  exit();
1379
}
1380

    
1381
#
1382
# perform a simple search against the LDAP database using 
1383
# a small subset of attributes of each dn and return it
1384
# as a table to the calling browser.
1385
#
1386
sub handleSimpleSearch {
1387

    
1388
    my $o = $query->param('o');
1389

    
1390
    my $ldapurl = $ldapConfig->{$o}{'url'};
1391
    my $searchBase = $ldapConfig->{$o}{'base'};
1392

    
1393
    print "Content-type: text/html\n\n";
1394

    
1395
    my $allParams = { 
1396
                      'cn' => $query->param('cn'),
1397
                      'sn' => $query->param('sn'),
1398
                      'gn' => $query->param('gn'),
1399
                      'o'  => $query->param('o'),
1400
                      'facsimiletelephonenumber' 
1401
                      => $query->param('facsimiletelephonenumber'),
1402
                      'mail' => $query->param('cmail'),
1403
                      'telephonenumber' => $query->param('telephonenumber'),
1404
                      'title' => $query->param('title'),
1405
                      'uid' => $query->param('uid'),
1406
                      'ou' => $query->param('ou'),
1407
                    };
1408

    
1409
    # Search LDAP for matching entries that already exist
1410
    my $filter = "(" . 
1411
                 $query->param('searchField') . "=" .
1412
                 "*" .
1413
                 $query->param('searchValue') .
1414
                 "*" .
1415
                 ")";
1416

    
1417
    my @attrs = [ 'sn', 
1418
                  'gn', 
1419
                  'cn', 
1420
                  'o', 
1421
                  'facsimiletelephonenumber', 
1422
                  'mail', 
1423
                  'telephoneNumber', 
1424
                  'title', 
1425
                  'uid', 
1426
                  'labeledURI', 
1427
                  'ou' ];
1428

    
1429
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1430

    
1431
    # Send back the search results
1432
    if ($found) {
1433
      fullTemplate( ('searchResults'), { stage => "searchresults",
1434
                                         allParams => $allParams,
1435
                                         foundAccounts => $found });
1436
    } else {
1437
      $found = "No entries matched your criteria.  Please try again\n";
1438

    
1439
      fullTemplate( ('searchResults'), { stage => "searchresults",
1440
                                         allParams => $allParams,
1441
                                         foundAccounts => $found });
1442
    }
1443

    
1444
    exit();
1445
}
1446

    
1447
#
1448
# search the LDAP directory to see if a similar account already exists
1449
#
1450
sub searchDirectory {
1451
    my $ldapurl = shift;
1452
    my $base = shift;
1453
    my $filter = shift;
1454
    my $attref = shift;
1455

    
1456
	my $mesg;
1457
    my $foundAccounts = 0;
1458
    
1459
    #if ldap server is down, a html file containing warning message will be returned
1460
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1461
    
1462
    if ($ldap) {
1463
    	$ldap->start_tls( verify => 'require',
1464
                      cafile => $ldapServerCACertFile);
1465
    	$ldap->bind( version => 3, anonymous => 1);
1466
    	my $mesg = $ldap->search (
1467
        	base   => $base,
1468
        	filter => $filter,
1469
        	attrs => @$attref,
1470
    	);
1471

    
1472
    	if ($mesg->count() > 0) {
1473
        	$foundAccounts = "";
1474
        	my $entry;
1475
        	foreach $entry ($mesg->sorted(['sn'])) {
1476
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1477
          		$foundAccounts .= "<a href=\"" unless 
1478
                    (!$entry->get_value('labeledURI'));
1479
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1480
                    (!$entry->get_value('labeledURI'));
1481
          		$foundAccounts .= "\">\n" unless 
1482
                    (!$entry->get_value('labeledURI'));
1483
          		$foundAccounts .= $entry->get_value('givenName');
1484
          		$foundAccounts .= "</a>\n" unless 
1485
                    (!$entry->get_value('labeledURI'));
1486
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1487
          		$foundAccounts .= "<a href=\"" unless 
1488
                    (!$entry->get_value('labeledURI'));
1489
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1490
                    (!$entry->get_value('labeledURI'));
1491
          		$foundAccounts .= "\">\n" unless 
1492
                    (!$entry->get_value('labeledURI'));
1493
          		$foundAccounts .= $entry->get_value('sn');
1494
          		$foundAccounts .= "</a>\n";
1495
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1496
          		$foundAccounts .= $entry->get_value('mail');
1497
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1498
          		$foundAccounts .= $entry->get_value('telephonenumber');
1499
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1500
          		$foundAccounts .= $entry->get_value('title');
1501
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1502
          		$foundAccounts .= $entry->get_value('ou');
1503
          		$foundAccounts .= "\n</td>\n";
1504
          		$foundAccounts .= "</tr>\n";
1505
        	}
1506
    	}
1507
    	$ldap->unbind;   # take down session
1508
    }
1509
    return $foundAccounts;
1510
}
1511

    
1512
sub debug {
1513
    my $msg = shift;
1514
    
1515
    if ($debug) {
1516
        print STDERR "LDAPweb: $msg\n";
1517
    }
1518
}
1519

    
1520
sub handleLDAPBindFailure {
1521
    my $ldapAttemptUrl = shift;
1522
    my $primaryLdap =  $properties->getProperty('auth.url');
1523

    
1524
    if ($ldapAttemptUrl eq  $primaryLdap) {
1525
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1526
    } else {
1527
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1528
    }
1529
}
1530

    
1531
sub handleGeneralServerFailure {
1532
    my $errorMessage = shift;
1533
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1534
    exit(0);   
1535
   }
1536
    
1537
sub setVars {
1538
    my $paramVars = shift;
1539
    # initialize default parameters 
1540
    my $templateVars = { cfg => $cfg,
1541
                         styleSkinsPath => $contextUrl . "/style/skins",
1542
                         styleCommonPath => $contextUrl . "/style/common",
1543
                         contextUrl => $contextUrl,
1544
                         cgiPrefix => $cgiPrefix,
1545
                         orgList => \@validDisplayOrgList,
1546
                         config  => $config,
1547
    };
1548
    
1549
    # append customized params
1550
    while (my ($k, $v) = each (%$paramVars)) {
1551
        $templateVars->{$k} = $v;
1552
    }
1553
    
1554
    return $templateVars;
1555
} 
1556

    
1557
#Method to get the next avaliable uid number. We use the mechanism - http://www.rexconsulting.net/ldap-protocol-uidNumber.html
1558
sub getNextUidNumber {
1559
    my $base=$properties->getProperty('ldap.nextuid.storing.dn');
1560
    my $uid_attribute_name = $properties->getProperty('ldap.nextuid.storing.attributename');
1561
    my $maxAttempt = $properties->getProperty('ldap.nextuid.maxattempt');
1562
    
1563
    my $ldapUsername = $ldapConfig->{'unaffiliated'}{'user'};
1564
    my $ldapPassword = $ldapConfig->{'unaffiliated'}{'password'};
1565
    
1566
    my $realUidNumber="";
1567
    my $uidNumber="";
1568
    my $entry;
1569
    my $mesg;
1570
    my $ldap;
1571
    
1572
    debug("ldap server: $ldapurl");
1573
    
1574
    #if main ldap server is down, a html file containing warning message will be returned
1575
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1576
    
1577
    if ($ldap) {
1578
        $ldap->start_tls( verify => 'require',
1579
                      cafile => $ldapServerCACertFile);
1580
        my $bindresult = $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword);
1581
        #read the uid value stored in uidObject class
1582
        for(my $index=0; $index<$maxAttempt; $index++) {
1583
            $mesg = $ldap->search(base  => $base, filter => '(objectClass=*)');
1584
            if ($mesg->count() > 0) {
1585
                debug("Find the cn - $base");
1586
                $entry = $mesg->pop_entry;
1587
                $uidNumber = $entry->get_value($uid_attribute_name);
1588
                if($uidNumber) {
1589
                    debug("uid number is $uidNumber");
1590
                    #remove the uid attribute with the read value
1591
                    my $delMesg = $ldap->modify($base, delete => { $uid_attribute_name => $uidNumber});
1592
                    if($delMesg->is_error()) {
1593
                        my $error=$delMesg->error();
1594
                        my $errorName = $delMesg->error_name();
1595
                        debug("can't remove the attribute - $error");
1596
                        debug("can't remove the attribute and the error name - $errorName");
1597
                        #can't remove the attribute with the specified value - that means somebody modify the value in another route, so try it again
1598
                    } else {
1599
                        debug("Remove the attribute successfully and write a new increased value back");
1600
                        my $newValue = $uidNumber +1;
1601
                        $delMesg = $ldap->modify($base, add => {$uid_attribute_name => $newValue});
1602
                        $realUidNumber = $uidNumber;
1603
                        last;
1604
                    }
1605
               } else {
1606
                 debug("can't find the attribute - $uid_attribute_name in the $base and we will try again");
1607
               }
1608
            } 
1609
        }
1610
        $ldap->unbind;   # take down session
1611
    }
1612
    return $realUidNumber;
1613
}
1614

    
1615

    
(10-10/14)