Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8413

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-22 16:01:10 -0800 (Fri, 22 Nov 2013) $'
8
# '$Revision: 8413 $' 
9
# 
10
# This program is free software; you can redistribute it and/or modify
11
# it under the terms of the GNU General Public License as published by
12
# the Free Software Foundation; either version 2 of the License, or
13
# (at your option) any later version.
14
#
15
# This program is distributed in the hope that it will be useful,
16
# but WITHOUT ANY WARRANTY; without even the implied warranty of
17
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
# GNU General Public License for more details.
19
#
20
# You should have received a copy of the GNU General Public License
21
# along with this program; if not, write to the Free Software
22
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
23
#
24

    
25
#
26
# This is a web-based application for allowing users to register a new
27
# account for Metacat access.  We currently only support LDAP even
28
# though metacat could potentially support other types of directories.
29

    
30
use lib '../WEB-INF/lib';
31
use strict;             # turn on strict syntax checking
32
use Template;           # load the template-toolkit module
33
use CGI qw/:standard :html3/; # load the CGI module 
34
use Net::LDAP;          # load the LDAP net libraries
35
use Net::SMTP;          # load the SMTP net libraries
36
use Digest::SHA1;       # for creating the password hash
37
use MIME::Base64;       # for creating the password hash
38
use URI;                # for parsing URL syntax
39
use Config::Properties; # for parsing Java .properties files
40
use File::Basename;     # for path name parsing
41
use DateTime;			# for parsing dates
42
use DateTime::Duration; # for substracting
43
use Captcha::reCAPTCHA; # for protection against spams
44
use Cwd 'abs_path';
45
use Scalar::Util qw(looks_like_number);
46

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

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

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

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

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

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

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

    
93
my $emailVerification= 'emailverification';
94

    
95
 my $dn_store_next_uid=$properties->getProperty('ldap.nextuid.storing.dn');
96
 my $attribute_name_store_next_uid = $properties->getProperty('ldap.nextuid.storing.attributename');
97

    
98
# Import all of the HTML form fields as variables
99
import_names('FORM');
100

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

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

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

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

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

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

    
155
# XXX END HACK
156

    
157

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

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

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

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

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

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

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

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

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

    
197
#This is a hash which has the keys of the ldap sub tree names of the organizations, such as 'NCEAS', 'LTER' and 'KU', and values are real name of the organization.
198
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
199
# pull out properties available e.g. 'name', 'base'
200
my @orgData = keys(%$orgProps);
201

    
202
my @orgList; #An array has the names (i.e, sub tree names, such as 'NCEAS', 'LTER' and 'KU')  of the all organizations in the metacat.properties. 
203
while (my ($oKey, $oVal) = each(%$orgNames)) {
204
    push(@orgList, $oKey);
205
}
206

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

    
214
    # XXX hack, remove after 1.9
215
    if ($o eq 'UCNRS') {
216
        $ldapConfig->{'UCNRS'}{'base'} = $nrsConfig->{'base'};
217
        $ldapConfig->{'UCNRS'}{'user'} = $nrsConfig->{'username'};
218
        $ldapConfig->{'UCNRS'}{'password'} = $nrsConfig->{'password'};
219
    }
220

    
221
    # set default base
222
    if (!$ldapConfig->{$o}{'base'}) {
223
        $ldapConfig->{$o}{'base'} = $authBase;
224
    }
225

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

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

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

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

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

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

    
289

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

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

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

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

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

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

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

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

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

    
377
    return 0;
378
}
379

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

    
398

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

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

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

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

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

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

    
479

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

    
491

    
492

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

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

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

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

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

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

    
602
    exit();
603
}
604

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

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

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

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

    
644

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
846
    return $errorMessage;
847
}
848

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

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

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

    
865
    return $hashedPasswd;
866
}
867

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

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

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

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

    
926
# 
927
# send an email message notifying the user of the pw change
928
#
929
sub sendPasswordNotification {
930
    my $username = shift;
931
    my $org = shift;
932
    my $newPass = shift;
933
    my $recipient = shift;
934
    my $cfg = shift;
935

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

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

    
956
            Username: $username
957
        Organization: $org
958
        New Password: $newPass
959

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

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

    
987
    my $foundAccounts = 0;
988

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

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

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

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

    
1063
    return $foundAccounts;
1064
}
1065

    
1066
#
1067
# Validate that we have the proper set of input parameters
1068
#
1069
sub paramsAreValid {
1070
    my @pnames = @_;
1071

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

    
1081
    return $allValid;
1082
}
1083

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

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

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

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

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

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

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

    
1317

    
1318

    
1319

    
1320

    
1321

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

    
1329
    my $cfg = $query->param('cfg');
1330
    my $dn = $query->param('dn');
1331
    my $hash = $query->param('hash');
1332
    my $org = $query->param('o');
1333
    my $uid = $query->param('uid');
1334
    
1335
    my $ldapUsername;
1336
    my $ldapPassword;
1337
    #my $orgAuthBase;
1338

    
1339
    $ldapUsername = $ldapConfig->{$org}{'user'};
1340
    $ldapPassword = $ldapConfig->{$org}{'password'};
1341
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1342
    
1343
    debug("LDAP connection to $ldapurl...");    
1344
    
1345

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

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

    
1401
}
1402

    
1403
sub handleResponseMessage {
1404

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

    
1413
#
1414
# perform a simple search against the LDAP database using 
1415
# a small subset of attributes of each dn and return it
1416
# as a table to the calling browser.
1417
#
1418
sub handleSimpleSearch {
1419

    
1420
    my $o = $query->param('o');
1421

    
1422
    my $ldapurl = $ldapConfig->{$o}{'url'};
1423
    my $searchBase = $ldapConfig->{$o}{'base'};
1424

    
1425
    print "Content-type: text/html\n\n";
1426

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

    
1441
    # Search LDAP for matching entries that already exist
1442
    my $filter = "(" . 
1443
                 $query->param('searchField') . "=" .
1444
                 "*" .
1445
                 $query->param('searchValue') .
1446
                 "*" .
1447
                 ")";
1448

    
1449
    my @attrs = [ 'sn', 
1450
                  'gn', 
1451
                  'cn', 
1452
                  'o', 
1453
                  'facsimiletelephonenumber', 
1454
                  'mail', 
1455
                  'telephoneNumber', 
1456
                  'title', 
1457
                  'uid', 
1458
                  'labeledURI', 
1459
                  'ou' ];
1460

    
1461
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1462

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

    
1471
      fullTemplate( ('searchResults'), { stage => "searchresults",
1472
                                         allParams => $allParams,
1473
                                         foundAccounts => $found });
1474
    }
1475

    
1476
    exit();
1477
}
1478

    
1479
#
1480
# search the LDAP directory to see if a similar account already exists
1481
#
1482
sub searchDirectory {
1483
    my $ldapurl = shift;
1484
    my $base = shift;
1485
    my $filter = shift;
1486
    my $attref = shift;
1487

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

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

    
1544
sub debug {
1545
    my $msg = shift;
1546
    
1547
    if ($debug) {
1548
        print STDERR "LDAPweb: $msg\n";
1549
    }
1550
}
1551

    
1552
sub handleLDAPBindFailure {
1553
    my $ldapAttemptUrl = shift;
1554
    my $primaryLdap =  $properties->getProperty('auth.url');
1555

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

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

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

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

    
1649