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 19:29:17 -0800 (Thu, 21 Nov 2013) $'
8
# '$Revision: 8412 $' 
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
    #get the next avaliable uid number. If it fails, the program will exist.
1147
    my $nextUidNumber = getNextUidNumber($ldapUsername, $ldapPassword);
1148
    if(!$nextUidNumber) {
1149
        print "Content-type: text/html\n\n";
1150
         my $sender;
1151
        $sender = $skinProperties->getProperty("email.recipient") or $sender = $properties->getProperty('email.recipient');
1152
        my $errorMessage = "The Identity Service can't get the next avaliable uid number.  Please try again.  If the issue persists, please contact the administrator - $sender.";
1153
        fullTemplate(['register'], { stage => "register",
1154
                                     allParams => $allParams,
1155
                                     errorMessage => $errorMessage });
1156
        exit(0);
1157
    }
1158
    my $cn = join(" ", $query->param('givenName'), $query->param('sn')); 
1159
    #generate a randomstr for matching the email.
1160
    my $randomStr = getRandomPassword(16);
1161
    # Create a hashed version of the password
1162
    my $shapass = createSeededPassHash($query->param('userPassword'));
1163
    my $additions = [ 
1164
                'uid'   => $query->param('uid'),
1165
                'cn'   => $cn,
1166
                'sn'   => $query->param('sn'),
1167
                'givenName'   => $query->param('givenName'),
1168
                'mail' => $query->param('mail'),
1169
                'userPassword' => $shapass,
1170
                'employeeNumber' => $randomStr,
1171
                'uidNumber' => $nextUidNumber,
1172
                'gidNumber' => $nextUidNumber,
1173
                'loginShell' => '/sbin/nologin',
1174
                'homeDirectory' => '/dev/null',
1175
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1176
                                'inetOrgPerson', 'posixAccount', 'shadowAccount' ],
1177
                $organization   => $organizationName
1178
                ];
1179
    my $gecos;
1180
    if (defined($query->param('telephoneNumber')) && 
1181
                $query->param('telephoneNumber') &&
1182
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1183
                $$additions[$#$additions + 1] = 'telephoneNumber';
1184
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1185
                $gecos = $cn . ',,'. $query->param('telephoneNumber'). ',';
1186
    } else {
1187
        $gecos = $cn . ',,,';
1188
    }
1189
    
1190
    $$additions[$#$additions + 1] = 'gecos';
1191
    $$additions[$#$additions + 1] = $gecos;
1192
    
1193
    if (defined($query->param('title')) && 
1194
                $query->param('title') &&
1195
                ! $query->param('title') =~ /^\s+$/) {
1196
                $$additions[$#$additions + 1] = 'title';
1197
                $$additions[$#$additions + 1] = $query->param('title');
1198
    }
1199

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

    
1233
    my $message = <<"     ENDOFMESSAGE";
1234
    To: $recipient
1235
    From: $sender
1236
    Subject: New Account Activation
1237
        
1238
    Somebody (hopefully you) registered an account on $contextUrl.  
1239
    Please click the following link to activate your account.
1240
    If the link doesn't work, please copy the link to your browser:
1241
    
1242
    $link
1243

    
1244
    Thanks,
1245
        $sender
1246
    
1247
     ENDOFMESSAGE
1248
     $message =~ s/^[ \t\r\f]+//gm;
1249
    
1250
     $smtp->data($message);
1251
     $smtp->quit;
1252
    debug("the link is " . $link);
1253
    fullTemplate( ['success'] );
1254
    
1255
}
1256

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

    
1309

    
1310

    
1311

    
1312

    
1313

    
1314
#
1315
# This subroutine will handle a email verification:
1316
# If the hash string matches the one store in the ldap, the account will be
1317
# copied from the temporary space to the permanent tree and the account in 
1318
# the temporary space will be removed.
1319
sub handleEmailVerification {
1320

    
1321
    my $cfg = $query->param('cfg');
1322
    my $dn = $query->param('dn');
1323
    my $hash = $query->param('hash');
1324
    my $org = $query->param('o');
1325
    my $uid = $query->param('uid');
1326
    
1327
    my $ldapUsername;
1328
    my $ldapPassword;
1329
    #my $orgAuthBase;
1330

    
1331
    $ldapUsername = $ldapConfig->{$org}{'user'};
1332
    $ldapPassword = $ldapConfig->{$org}{'password'};
1333
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1334
    
1335
    debug("LDAP connection to $ldapurl...");    
1336
    
1337

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

    
1366
                
1367
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1368
                $mesg = $ldap->moddn(
1369
                            dn => $dn,
1370
                            deleteoldrdn => 1,
1371
                            newrdn => "uid=" . $uid,
1372
                            newsuperior  =>  $orgDn);
1373
                $ldap->unbind;   # take down session
1374
                if($mesg->code()) {
1375
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1376
                    exit(0);
1377
                } else {
1378
                    fullTemplate( ['verificationSuccess'] );
1379
                }
1380
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1381
            } else {
1382
                $ldap->unbind;   # take down session
1383
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1384
                exit(0);
1385
            }
1386
            
1387
        }
1388
    } else {   
1389
        handleLDAPBindFailure($ldapurl);
1390
        exit(0);
1391
    }
1392

    
1393
}
1394

    
1395
sub handleResponseMessage {
1396

    
1397
  print "Content-type: text/html\n\n";
1398
  my $errorMessage = "You provided invalid input to the script. " .
1399
                     "Try again please.";
1400
  fullTemplate( [], { stage => $templates->{'stage'},
1401
                      errorMessage => $errorMessage });
1402
  exit();
1403
}
1404

    
1405
#
1406
# perform a simple search against the LDAP database using 
1407
# a small subset of attributes of each dn and return it
1408
# as a table to the calling browser.
1409
#
1410
sub handleSimpleSearch {
1411

    
1412
    my $o = $query->param('o');
1413

    
1414
    my $ldapurl = $ldapConfig->{$o}{'url'};
1415
    my $searchBase = $ldapConfig->{$o}{'base'};
1416

    
1417
    print "Content-type: text/html\n\n";
1418

    
1419
    my $allParams = { 
1420
                      'cn' => $query->param('cn'),
1421
                      'sn' => $query->param('sn'),
1422
                      'gn' => $query->param('gn'),
1423
                      'o'  => $query->param('o'),
1424
                      'facsimiletelephonenumber' 
1425
                      => $query->param('facsimiletelephonenumber'),
1426
                      'mail' => $query->param('cmail'),
1427
                      'telephonenumber' => $query->param('telephonenumber'),
1428
                      'title' => $query->param('title'),
1429
                      'uid' => $query->param('uid'),
1430
                      'ou' => $query->param('ou'),
1431
                    };
1432

    
1433
    # Search LDAP for matching entries that already exist
1434
    my $filter = "(" . 
1435
                 $query->param('searchField') . "=" .
1436
                 "*" .
1437
                 $query->param('searchValue') .
1438
                 "*" .
1439
                 ")";
1440

    
1441
    my @attrs = [ 'sn', 
1442
                  'gn', 
1443
                  'cn', 
1444
                  'o', 
1445
                  'facsimiletelephonenumber', 
1446
                  'mail', 
1447
                  'telephoneNumber', 
1448
                  'title', 
1449
                  'uid', 
1450
                  'labeledURI', 
1451
                  'ou' ];
1452

    
1453
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1454

    
1455
    # Send back the search results
1456
    if ($found) {
1457
      fullTemplate( ('searchResults'), { stage => "searchresults",
1458
                                         allParams => $allParams,
1459
                                         foundAccounts => $found });
1460
    } else {
1461
      $found = "No entries matched your criteria.  Please try again\n";
1462

    
1463
      fullTemplate( ('searchResults'), { stage => "searchresults",
1464
                                         allParams => $allParams,
1465
                                         foundAccounts => $found });
1466
    }
1467

    
1468
    exit();
1469
}
1470

    
1471
#
1472
# search the LDAP directory to see if a similar account already exists
1473
#
1474
sub searchDirectory {
1475
    my $ldapurl = shift;
1476
    my $base = shift;
1477
    my $filter = shift;
1478
    my $attref = shift;
1479

    
1480
	my $mesg;
1481
    my $foundAccounts = 0;
1482
    
1483
    #if ldap server is down, a html file containing warning message will be returned
1484
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1485
    
1486
    if ($ldap) {
1487
    	$ldap->start_tls( verify => 'require',
1488
                      cafile => $ldapServerCACertFile);
1489
    	$ldap->bind( version => 3, anonymous => 1);
1490
    	my $mesg = $ldap->search (
1491
        	base   => $base,
1492
        	filter => $filter,
1493
        	attrs => @$attref,
1494
    	);
1495

    
1496
    	if ($mesg->count() > 0) {
1497
        	$foundAccounts = "";
1498
        	my $entry;
1499
        	foreach $entry ($mesg->sorted(['sn'])) {
1500
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1501
          		$foundAccounts .= "<a href=\"" unless 
1502
                    (!$entry->get_value('labeledURI'));
1503
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1504
                    (!$entry->get_value('labeledURI'));
1505
          		$foundAccounts .= "\">\n" unless 
1506
                    (!$entry->get_value('labeledURI'));
1507
          		$foundAccounts .= $entry->get_value('givenName');
1508
          		$foundAccounts .= "</a>\n" unless 
1509
                    (!$entry->get_value('labeledURI'));
1510
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1511
          		$foundAccounts .= "<a href=\"" unless 
1512
                    (!$entry->get_value('labeledURI'));
1513
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1514
                    (!$entry->get_value('labeledURI'));
1515
          		$foundAccounts .= "\">\n" unless 
1516
                    (!$entry->get_value('labeledURI'));
1517
          		$foundAccounts .= $entry->get_value('sn');
1518
          		$foundAccounts .= "</a>\n";
1519
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1520
          		$foundAccounts .= $entry->get_value('mail');
1521
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1522
          		$foundAccounts .= $entry->get_value('telephonenumber');
1523
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1524
          		$foundAccounts .= $entry->get_value('title');
1525
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1526
          		$foundAccounts .= $entry->get_value('ou');
1527
          		$foundAccounts .= "\n</td>\n";
1528
          		$foundAccounts .= "</tr>\n";
1529
        	}
1530
    	}
1531
    	$ldap->unbind;   # take down session
1532
    }
1533
    return $foundAccounts;
1534
}
1535

    
1536
sub debug {
1537
    my $msg = shift;
1538
    
1539
    if ($debug) {
1540
        print STDERR "LDAPweb: $msg\n";
1541
    }
1542
}
1543

    
1544
sub handleLDAPBindFailure {
1545
    my $ldapAttemptUrl = shift;
1546
    my $primaryLdap =  $properties->getProperty('auth.url');
1547

    
1548
    if ($ldapAttemptUrl eq  $primaryLdap) {
1549
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1550
    } else {
1551
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1552
    }
1553
}
1554

    
1555
sub handleGeneralServerFailure {
1556
    my $errorMessage = shift;
1557
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1558
    exit(0);   
1559
   }
1560
    
1561
sub setVars {
1562
    my $paramVars = shift;
1563
    # initialize default parameters 
1564
    my $templateVars = { cfg => $cfg,
1565
                         styleSkinsPath => $contextUrl . "/style/skins",
1566
                         styleCommonPath => $contextUrl . "/style/common",
1567
                         contextUrl => $contextUrl,
1568
                         cgiPrefix => $cgiPrefix,
1569
                         orgList => \@validDisplayOrgList,
1570
                         config  => $config,
1571
    };
1572
    
1573
    # append customized params
1574
    while (my ($k, $v) = each (%$paramVars)) {
1575
        $templateVars->{$k} = $v;
1576
    }
1577
    
1578
    return $templateVars;
1579
} 
1580

    
1581
#Method to get the next avaliable uid number. We use the mechanism - http://www.rexconsulting.net/ldap-protocol-uidNumber.html
1582
sub getNextUidNumber {
1583
    my $base=$properties->getProperty('ldap.nextuid.storing.dn');
1584
    my $uid_attribute_name = $properties->getProperty('ldap.nextuid.storing.attributename');
1585
    my $maxAttempt = $properties->getProperty('ldap.nextuid.maxattempt');
1586
    
1587
    my $ldapUsername = shift;
1588
    my $ldapPassword = shift;
1589
    
1590
    my $realUidNumber;
1591
    my $uidNumber;
1592
    my $entry;
1593
    my $mesg;
1594
    my $ldap;
1595
    
1596
    debug("ldap server: $ldapurl");
1597
    
1598
    #if main ldap server is down, a html file containing warning message will be returned
1599
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1600
    
1601
    if ($ldap) {
1602
        $ldap->start_tls( verify => 'require',
1603
                      cafile => $ldapServerCACertFile);
1604
        my $bindresult = $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword);
1605
        #read the uid value stored in uidObject class
1606
        for(my $index=0; $index<$maxAttempt; $index++) {
1607
            $mesg = $ldap->search(base  => $base, filter => '(objectClass=*)');
1608
            if ($mesg->count() > 0) {
1609
                debug("Find the cn - $base");
1610
                $entry = $mesg->pop_entry;
1611
                $uidNumber = $entry->get_value($uid_attribute_name);
1612
                if($uidNumber) {
1613
                    debug("uid number is $uidNumber");
1614
                    #remove the uid attribute with the read value
1615
                    my $delMesg = $ldap->modify($base, delete => { $uid_attribute_name => $uidNumber});
1616
                    if($delMesg->is_error()) {
1617
                        my $error=$delMesg->error();
1618
                        my $errorName = $delMesg->error_name();
1619
                        debug("can't remove the attribute - $error");
1620
                        debug("can't remove the attribute and the error name - $errorName");
1621
                        #can't remove the attribute with the specified value - that means somebody modify the value in another route, so try it again
1622
                    } else {
1623
                        debug("Remove the attribute successfully and write a new increased value back");
1624
                        my $newValue = $uidNumber +1;
1625
                        $delMesg = $ldap->modify($base, add => {$uid_attribute_name => $newValue});
1626
                        $realUidNumber = $uidNumber;
1627
                        last;
1628
                    }
1629
               } else {
1630
                 debug("can't find the attribute - $uid_attribute_name in the $base and we will try again");
1631
               }
1632
            } 
1633
        }
1634
        $ldap->unbind;   # take down session
1635
    }
1636
    return $realUidNumber;
1637
}
1638

    
1639

    
(10-10/14)