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-18 15:10:35 -0800 (Mon, 18 Nov 2013) $'
8
# '$Revision: 8403 $' 
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
             );
314

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

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

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

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

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

    
372
    return 0;
373
}
374

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

    
393

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

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

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

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

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

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

    
474

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

    
486

    
487

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

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

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

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

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

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

    
597
    exit();
598
}
599

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

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

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

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

    
639

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
841
    return $errorMessage;
842
}
843

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

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

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

    
860
    return $hashedPasswd;
861
}
862

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

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

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

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

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

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

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

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

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

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

    
982
    my $foundAccounts = 0;
983

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

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

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

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

    
1058
    return $foundAccounts;
1059
}
1060

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

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

    
1076
    return $allValid;
1077
}
1078

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

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

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

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

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

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

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

    
1284

    
1285

    
1286

    
1287

    
1288

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

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

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

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

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

    
1368
}
1369

    
1370
sub handleResponseMessage {
1371

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

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

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

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

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

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

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

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

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

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

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

    
1443
    exit();
1444
}
1445

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

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

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

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

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

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

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

    
(10-10/14)