Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8221

1
#!/usr/bin/perl -w
2
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California 
5
#
6
#   '$Author: tao $'
7
#     '$Date: 2013-09-17 15:22:35 -0700 (Tue, 17 Sep 2013) $'
8
# '$Revision: 8221 $' 
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 Captcha::reCAPTCHA; # for protection against spams
42
use Cwd 'abs_path';
43

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

    
57
$properties->load(*METACAT_PROPERTIES);
58

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

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

    
76
my $metacatUrl = $contextUrl . "/metacat";
77
my $cgiPrefix = "/" . $properties->getProperty('application.context') . "/cgi-bin";
78
my $styleSkinsPath = $contextUrl . "/style/skins";
79
my $styleCommonPath = $contextUrl . "/style/common";
80

    
81
#recaptcha key information
82
my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');
83
my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');
84

    
85
my @errorMessages;
86
my $error = 0;
87

    
88
my $emailVerification= 'emailverification';
89

    
90
# Import all of the HTML form fields as variables
91
import_names('FORM');
92

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

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

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

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

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

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

    
147
# XXX END HACK
148

    
149

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

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

    
160
# Get the CGI input variables
161
my $query = new CGI;
162
my $debug = 1;
163

    
164
#--------------------------------------------------------------------------80c->
165
# Set up the Template Toolkit to read html form templates
166

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

    
172
# set some configuration options for the template object
173
my $ttConfig = {
174
             INCLUDE_PATH => $templatesDir,
175
             INTERPOLATE  => 0,
176
             POST_CHOMP   => 1,
177
             DEBUG        => 1, 
178
             };
179

    
180
# create an instance of the template
181
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
182

    
183
# custom LDAP properties hash
184
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
185

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

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

    
194
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. 
195
while (my ($oKey, $oVal) = each(%$orgNames)) {
196
    push(@orgList, $oKey);
197
}
198

    
199
my $authBase = $properties->getProperty("auth.base");
200
my $ldapConfig;
201
foreach my $o (@orgList) {
202
    foreach my $d (@orgData) {
203
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
204
    }
205

    
206
    # XXX hack, remove after 1.9
207
    if ($o eq 'UCNRS') {
208
        $ldapConfig->{'UCNRS'}{'base'} = $nrsConfig->{'base'};
209
        $ldapConfig->{'UCNRS'}{'user'} = $nrsConfig->{'username'};
210
        $ldapConfig->{'UCNRS'}{'password'} = $nrsConfig->{'password'};
211
    }
212

    
213
    # set default base
214
    if (!$ldapConfig->{$o}{'base'}) {
215
        $ldapConfig->{$o}{'base'} = $authBase;
216
    }
217

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

    
248
    if (!$ldapConfig->{$o}{'password'}) {
249
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
250
    }
251
}
252

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

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

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

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

    
281

    
282
#--------------------------------------------------------------------------80c->
283
# Define the main program logic that calls subroutines to do the work
284
#--------------------------------------------------------------------------80c->
285

    
286
# The processing step we are handling
287
my $stage = $query->param('stage') || $templates->{'stage'};
288

    
289
my $cfg = $query->param('cfg');
290
debug("started with stage $stage, cfg $cfg");
291

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

    
310
# call the appropriate routine based on the stage
311
if ( $stages{$stage} ) {
312
  $stages{$stage}->();
313
} else {
314
  &handleResponseMessage();
315
}
316

    
317
#--------------------------------------------------------------------------80c->
318
# Define the subroutines to do the work
319
#--------------------------------------------------------------------------80c->
320

    
321
sub fullTemplate {
322
    my $templateList = shift;
323
    my $templateVars = setVars(shift);
324
    my $c = Captcha::reCAPTCHA->new;
325
    my $captcha = 'captcha';
326
    #my $error=null;
327
    my $use_ssl= 1;
328
    #my $options=null;
329
    $templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
330
    $template->process( $templates->{'header'}, $templateVars );
331
    foreach my $tmpl (@{$templateList}) {
332
        $template->process( $templates->{$tmpl}, $templateVars );
333
    }
334
    $template->process( $templates->{'footer'}, $templateVars );
335
}
336

    
337

    
338

    
339
#
340
# Handle the user's request to look up account names with a specified email address.
341
# This relates to "Forget your user name"
342
#
343
sub handleLookupName {
344

    
345
    print "Content-type: text/html\n\n";
346
   
347
    my $allParams = {'mail' => $query->param('mail')};
348
    my @requiredParams = ('mail');
349
    if (! paramsAreValid(@requiredParams)) {
350
        my $errorMessage = "Required information is missing. " .
351
            "Please fill in all required fields and resubmit the form.";
352
        fullTemplate(['lookupname'], { stage => "lookupname",
353
                                     allParams => $allParams,
354
                                     errorMessage => $errorMessage });
355
        exit();
356
    }
357
    my $mail = $query->param('mail');
358
    
359
    #search accounts with the specified emails 
360
    $searchBase = $authBase; 
361
    my $filter = "(mail=" . $mail . ")";
362
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
363
    my $notHtmlFormat = 1;
364
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs, $notHtmlFormat);
365
    my $accountInfo;
366
    if($found) {
367
        $accountInfo = $found;
368
    } else {
369
        my $link = $contextUrl. '/cgi-bin/ldapweb.cgi?cfg=' . $skinName;
370
        $accountInfo = "There are no KNB accounts associated with the email " . $mail . ".\n" .
371
                       "You may create a new one by the following link: \n" . $link
372
    }
373
    
374
    
375
    
376
    my $mailhost = $properties->getProperty('email.mailhost');
377
    my $sender;
378
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
379
    debug("the sender is " . $sender);
380
    my $recipient = $query->param('mail');
381
    # Send the email message to them
382
    my $smtp = Net::SMTP->new($mailhost) or do {  
383
                                                  fullTemplate( ['lookupNameFailed'], {errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " . 
384
                                                  $skinProperties->getProperty("email.recipient") . "." });  
385
                                                  exit(0);
386
                                               };
387
    $smtp->mail($sender);
388
    $smtp->to($recipient);
389

    
390
    my $message = <<"     ENDOFMESSAGE";
391
    To: $recipient
392
    From: $sender
393
    Subject: KNB Account
394
        
395
    Somebody (hopefully you) looked up the KNB accounts associated with the email address.  
396
    Here is the accounts information:
397
    
398
    $accountInfo
399

    
400
    Thanks,
401
        The KNB Development Team
402
    
403
     ENDOFMESSAGE
404
     $message =~ s/^[ \t\r\f]+//gm;
405
    
406
     $smtp->data($message);
407
     $smtp->quit;
408
     fullTemplate( ['lookupNameSuccess'] );
409
    
410
}
411

    
412

    
413
#
414
# create the initial registration form 
415
#
416
sub handleInitRegister {
417
  my $vars = shift;
418
  print "Content-type: text/html\n\n";
419
  # process the template files:
420
  fullTemplate(['register'], {stage => "register"}); 
421
  exit();
422
}
423

    
424

    
425

    
426
#
427
# process input from the register stage, which occurs when
428
# a user submits form data to create a new account
429
#
430
sub handleRegister {
431
    
432
    print "Content-type: text/html\n\n";
433
    if ($query->param('o') =~ "LTER") {
434
      fullTemplate( ['registerLter'] );
435
      exit(0);
436
    } 
437
    
438
    my $allParams = { 'givenName' => $query->param('givenName'), 
439
                      'sn' => $query->param('sn'),
440
                      'o' => $query->param('o'), 
441
                      'mail' => $query->param('mail'), 
442
                      'uid' => $query->param('uid'), 
443
                      'userPassword' => $query->param('userPassword'), 
444
                      'userPassword2' => $query->param('userPassword2'), 
445
                      'title' => $query->param('title'), 
446
                      'telephoneNumber' => $query->param('telephoneNumber') };
447
    
448
    # Check the recaptcha
449
    my $c = Captcha::reCAPTCHA->new;
450
    my $challenge = $query->param('recaptcha_challenge_field');
451
    my $response = $query->param('recaptcha_response_field');
452
    # Verify submission
453
    my $result = $c->check_answer(
454
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
455
        $challenge, $response
456
    );
457

    
458
    if ( $result->{is_valid} ) {
459
        #print "Yes!";
460
        #exit();
461
    }
462
    else {
463
        my $errorMessage = "The verification code is wrong. Please input again.";
464
        fullTemplate(['register'], { stage => "register",
465
                                     allParams => $allParams,
466
                                     errorMessage => $errorMessage });
467
        exit();
468
    }
469
    
470
    
471
    # Check that all required fields are provided and not null
472
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
473
                           'uid', 'userPassword', 'userPassword2');
474
    if (! paramsAreValid(@requiredParams)) {
475
        my $errorMessage = "Required information is missing. " .
476
            "Please fill in all required fields and resubmit the form.";
477
        fullTemplate(['register'], { stage => "register",
478
                                     allParams => $allParams,
479
                                     errorMessage => $errorMessage });
480
        exit();
481
    } else {
482
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
483
            my $errorMessage = "The passwords do not match. Try again.";
484
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
485
                                                            allParams => $allParams,
486
                                                            errorMessage => $errorMessage });
487
            exit();
488
        }
489
        my $o = $query->param('o');    
490
        $searchBase = $ldapConfig->{$o}{'base'};  
491
    }
492

    
493
    # Search LDAP for matching entries that already exist
494
    # Some forms use a single text search box, whereas others search per
495
    # attribute.
496
    my $filter;
497
    if ($query->param('searchField')) {
498

    
499
      $filter = "(|" . 
500
                "(uid=" . $query->param('searchField') . ") " .
501
                "(mail=" . $query->param('searchField') . ")" .
502
                "(&(sn=" . $query->param('searchField') . ") " . 
503
                "(givenName=" . $query->param('searchField') . "))" . 
504
                ")";
505
    } else {
506
      $filter = "(|" . 
507
                "(uid=" . $query->param('uid') . ") " .
508
                "(mail=" . $query->param('mail') . ")" .
509
                "(&(sn=" . $query->param('sn') . ") " . 
510
                "(givenName=" . $query->param('givenName') . "))" . 
511
                ")";
512
    }
513

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

    
517
    # If entries match, send back a request to confirm new-user creation
518
    if ($found) {
519
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
520
                                                     allParams => $allParams,
521
                                                     foundAccounts => $found });
522
    # Otherwise, create a new user in the LDAP directory
523
    } else {
524
        createTemporaryAccount($allParams);
525
    }
526

    
527
    exit();
528
}
529

    
530
#
531
# process input from the registerconfirmed stage, which occurs when
532
# a user chooses to create an account despite similarities to other
533
# existing accounts
534
#
535
sub handleRegisterConfirmed {
536
  
537
    my $allParams = { 'givenName' => $query->param('givenName'), 
538
                      'sn' => $query->param('sn'),
539
                      'o' => $query->param('o'), 
540
                      'mail' => $query->param('mail'), 
541
                      'uid' => $query->param('uid'), 
542
                      'userPassword' => $query->param('userPassword'), 
543
                      'userPassword2' => $query->param('userPassword2'), 
544
                      'title' => $query->param('title'), 
545
                      'telephoneNumber' => $query->param('telephoneNumber') };
546
    print "Content-type: text/html\n\n";
547
    createTemporaryAccount($allParams);
548
    exit();
549
}
550

    
551
#
552
# change a user's password upon request
553
#
554
sub handleChangePassword {
555

    
556
    print "Content-type: text/html\n\n";
557

    
558
    my $allParams = { 'test' => "1", };
559
    if ($query->param('uid')) {
560
        $$allParams{'uid'} = $query->param('uid');
561
    }
562
    if ($query->param('o')) {
563
        $$allParams{'o'} = $query->param('o');
564
        my $o = $query->param('o');
565
        
566
        $searchBase = $ldapConfig->{$o}{'base'};
567
    }
568

    
569

    
570
    # Check that all required fields are provided and not null
571
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
572
                           'userPassword', 'userPassword2');
573
    if (! paramsAreValid(@requiredParams)) {
574
        my $errorMessage = "Required information is missing. " .
575
            "Please fill in all required fields and submit the form.";
576
        fullTemplate( ['changePass'], { stage => "changepass",
577
                                        allParams => $allParams,
578
                                        errorMessage => $errorMessage });
579
        exit();
580
    }
581

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

    
585
        my $o = $query->param('o');
586
        $searchBase = $ldapConfig->{$o}{'base'};
587
        $ldapUsername = $ldapConfig->{$o}{'user'};
588
        $ldapPassword = $ldapConfig->{$o}{'password'};
589

    
590
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
591
        if ($query->param('o') =~ "LTER") {
592
            fullTemplate( ['registerLter'] );
593
        } else {
594
            my $errorMessage = changePassword(
595
                    $dn, $query->param('userPassword'), 
596
                    $dn, $query->param('oldpass'), $query->param('o'));
597
            if ($errorMessage) {
598
                fullTemplate( ['changePass'], { stage => "changepass",
599
                                                allParams => $allParams,
600
                                                errorMessage => $errorMessage });
601
                exit();
602
            } else {
603
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
604
                                                       allParams => $allParams });
605
                exit();
606
            }
607
        }
608
    } else {
609
        my $errorMessage = "The passwords do not match. Try again.";
610
        fullTemplate( ['changePass'], { stage => "changepass",
611
                                        allParams => $allParams,
612
                                        errorMessage => $errorMessage });
613
        exit();
614
    }
615
}
616

    
617
#
618
# change a user's password upon request - no input params
619
# only display chagepass template without any error
620
#
621
sub handleInitialChangePassword {
622
    print "Content-type: text/html\n\n";
623

    
624
    my $allParams = { 'test' => "1", };
625
    my $errorMessage = "";
626
    fullTemplate( ['changePass'], { stage => "changepass",
627
                                    errorMessage => $errorMessage });
628
    exit();
629
}
630

    
631
#
632
# reset a user's password upon request
633
#
634
sub handleResetPassword {
635

    
636
    print "Content-type: text/html\n\n";
637

    
638
    my $allParams = { 'test' => "1", };
639
    if ($query->param('uid')) {
640
        $$allParams{'uid'} = $query->param('uid');
641
    }
642
    if ($query->param('o')) {
643
        $$allParams{'o'} = $query->param('o');
644
        my $o = $query->param('o');
645
        
646
        $searchBase = $ldapConfig->{$o}{'base'};
647
        $ldapUsername = $ldapConfig->{$o}{'user'};
648
        $ldapPassword = $ldapConfig->{$o}{'password'};
649
    }
650

    
651
    # Check that all required fields are provided and not null
652
    my @requiredParams = ( 'uid', 'o' );
653
    if (! paramsAreValid(@requiredParams)) {
654
        my $errorMessage = "Required information is missing. " .
655
            "Please fill in all required fields and submit the form.";
656
        fullTemplate( ['resetPass'],  { stage => "resetpass",
657
                                        allParams => $allParams,
658
                                        errorMessage => $errorMessage });
659
        exit();
660
    }
661

    
662
    # We have all of the info we need, so try to change the password
663
    my $o = $query->param('o');
664
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
665
    debug("handleResetPassword: dn: $dn");
666
    if ($query->param('o') =~ "LTER") {
667
        fullTemplate( ['registerLter'] );
668
        exit();
669
    } else {
670
        my $errorMessage = "";
671
        my $recipient;
672
        my $userPass;
673
        my $entry = getLdapEntry($ldapurl, $searchBase, 
674
                $query->param('uid'), $query->param('o'));
675

    
676
        if ($entry) {
677
            $recipient = $entry->get_value('mail');
678
            $userPass = getRandomPassword();
679
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
680
        } else {
681
            $errorMessage = "User not found in database.  Please try again.";
682
        }
683

    
684
        if ($errorMessage) {
685
            fullTemplate( ['resetPass'], { stage => "resetpass",
686
                                           allParams => $allParams,
687
                                           errorMessage => $errorMessage });
688
            exit();
689
        } else {
690
            my $errorMessage = sendPasswordNotification($query->param('uid'),
691
                    $query->param('o'), $userPass, $recipient, $cfg);
692
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
693
                                                  allParams => $allParams,
694
                                                  errorMessage => $errorMessage });
695
            exit();
696
        }
697
    }
698
}
699

    
700
#
701
# reset a user's password upon request- no initial params
702
# only display resetpass template without any error
703
#
704
sub handleInitialResetPassword {
705
    print "Content-type: text/html\n\n";
706
    my $errorMessage = "";
707
    fullTemplate( ['resetPass'], { stage => "resetpass",
708
                                   errorMessage => $errorMessage });
709
    exit();
710
}
711

    
712
#
713
# Construct a random string to use for a newly reset password
714
#
715
sub getRandomPassword {
716
    my $length = shift;
717
    if (!$length) {
718
        $length = 8;
719
    }
720
    my $newPass = "";
721

    
722
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
723
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
724
    return $newPass;
725
}
726

    
727
#
728
# Change a password to a new value, binding as the provided user
729
#
730
sub changePassword {
731
    my $userDN = shift;
732
    my $userPass = shift;
733
    my $bindDN = shift;
734
    my $bindPass = shift;
735
    my $o = shift;
736

    
737
    my $searchBase = $ldapConfig->{$o}{'base'};
738

    
739
    my $errorMessage = 0;
740
    my $ldap;
741

    
742
    #if main ldap server is down, a html file containing warning message will be returned
743
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
744
    
745
    if ($ldap) {
746
        #$ldap->start_tls( verify => 'require',
747
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
748
        $ldap->start_tls( verify => 'none');
749
        debug("changePassword: attempting to bind to $bindDN");
750
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
751
                                  password => $bindPass );
752
        if ($bindresult->code) {
753
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
754
                            "correct? Please correct and try again...";
755
            return $errorMessage;
756
        }
757

    
758
    	# Find the user here and change their entry
759
    	my $newpass = createSeededPassHash($userPass);
760
    	my $modifications = { userPassword => $newpass };
761
      debug("changePass: setting password for $userDN to $newpass");
762
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
763
    
764
    	if ($result->code()) {
765
            debug("changePass: error changing password: " . $result->error);
766
        	$errorMessage = "There was an error changing the password:" .
767
                           "<br />\n" . $result->error;
768
    	} 
769
    	$ldap->unbind;   # take down session
770
    }
771

    
772
    return $errorMessage;
773
}
774

    
775
#
776
# generate a Seeded SHA1 hash of a plaintext password
777
#
778
sub createSeededPassHash {
779
    my $secret = shift;
780

    
781
    my $salt = "";
782
    for (my $i=0; $i < 4; $i++) {
783
        $salt .= int(rand(10));
784
    }
785

    
786
    my $ctx = Digest::SHA1->new;
787
    $ctx->add($secret);
788
    $ctx->add($salt);
789
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
790

    
791
    return $hashedPasswd;
792
}
793

    
794
#
795
# Look up an ldap entry for a user
796
#
797
sub getLdapEntry {
798
    my $ldapurl = shift;
799
    my $base = shift;
800
    my $username = shift;
801
    my $org = shift;
802

    
803
    my $entry = "";
804
    my $mesg;
805
    my $ldap;
806
    debug("ldap server: $ldapurl");
807

    
808
    #if main ldap server is down, a html file containing warning message will be returned
809
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
810
    
811
    if ($ldap) {
812
    	$ldap->start_tls( verify => 'none');
813
    	my $bindresult = $ldap->bind;
814
    	if ($bindresult->code) {
815
        	return $entry;
816
    	}
817

    
818
    	if($ldapConfig->{$org}{'filter'}){
819
            debug("getLdapEntry: filter set, searching for base=$base, " .
820
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
821
        	$mesg = $ldap->search ( base   => $base,
822
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
823
    	} else {
824
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
825
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
826
    	}
827
    
828
    	if ($mesg->count > 0) {
829
        	$entry = $mesg->pop_entry;
830
        	$ldap->unbind;   # take down session
831
    	} else {
832
        	$ldap->unbind;   # take down session
833
        	# Follow references by recursive call to self
834
        	my @references = $mesg->references();
835
        	for (my $i = 0; $i <= $#references; $i++) {
836
            	my $uri = URI->new($references[$i]);
837
            	my $host = $uri->host();
838
            	my $path = $uri->path();
839
            	$path =~ s/^\///;
840
            	$entry = &getLdapEntry($host, $path, $username, $org);
841
            	if ($entry) {
842
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
843
                	return $entry;
844
            	}
845
        	}
846
    	}
847
    }
848
    return $entry;
849
}
850

    
851
# 
852
# send an email message notifying the user of the pw change
853
#
854
sub sendPasswordNotification {
855
    my $username = shift;
856
    my $org = shift;
857
    my $newPass = shift;
858
    my $recipient = shift;
859
    my $cfg = shift;
860

    
861
    my $errorMessage = "";
862
    if ($recipient) {
863
        my $mailhost = $properties->getProperty('email.mailhost');
864
        my $sender;
865
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
866
        # Send the email message to them
867
        my $smtp = Net::SMTP->new($mailhost);
868
        $smtp->mail($sender);
869
        $smtp->to($recipient);
870

    
871
        my $message = <<"        ENDOFMESSAGE";
872
        To: $recipient
873
        From: $sender
874
        Subject: KNB Password Reset
875
        
876
        Somebody (hopefully you) requested that your KNB password be reset.  
877
        This is generally done when somebody forgets their password.  Your 
878
        password can be changed by visiting the following URL:
879

    
880
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
881

    
882
            Username: $username
883
        Organization: $org
884
        New Password: $newPass
885

    
886
        Thanks,
887
            The KNB Development Team
888
    
889
        ENDOFMESSAGE
890
        $message =~ s/^[ \t\r\f]+//gm;
891
    
892
        $smtp->data($message);
893
        $smtp->quit;
894
    } else {
895
        $errorMessage = "Failed to send password because I " .
896
                        "couldn't find a valid email address.";
897
    }
898
    return $errorMessage;
899
}
900

    
901
#
902
# search the LDAP directory to see if a similar account already exists
903
#
904
sub findExistingAccounts {
905
    my $ldapurl = shift;
906
    my $base = shift;
907
    my $filter = shift;
908
    my $attref = shift;
909
    my $notHtmlFormat = shift;
910
    my $ldap;
911
    my $mesg;
912

    
913
    my $foundAccounts = 0;
914

    
915
    #if main ldap server is down, a html file containing warning message will be returned
916
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
917
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
918
    if ($ldap) {
919
    	$ldap->start_tls( verify => 'none');
920
    	$ldap->bind( version => 3, anonymous => 1);
921
		$mesg = $ldap->search (
922
			base   => $base,
923
			filter => $filter,
924
			attrs => @$attref,
925
		);
926

    
927
	    if ($mesg->count() > 0) {
928
			$foundAccounts = "";
929
			my $entry;
930
			foreach $entry ($mesg->all_entries) { 
931
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
932
                # this could be done directly with filters on the LDAP connection, instead.
933
                #if ($entry->dn !~ /ou=Account/) {
934
                    if($notHtmlFormat) {
935
                        $foundAccounts .= "\nAccount: ";
936
                    } else {
937
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
938
                    }
939
                    $foundAccounts .= $entry->dn();
940
                    if($notHtmlFormat) {
941
                        $foundAccounts .= "\n";
942
                    } else {
943
                        $foundAccounts .= "</b><br />\n";
944
                    }
945
                    foreach my $attribute ($entry->attributes()) {
946
                        my $value = $entry->get_value($attribute);
947
                        $foundAccounts .= "$attribute: ";
948
                        $foundAccounts .= $value;
949
                         if($notHtmlFormat) {
950
                            $foundAccounts .= "\n";
951
                        } else {
952
                            $foundAccounts .= "<br />\n";
953
                        }
954
                    }
955
                    if($notHtmlFormat) {
956
                        $foundAccounts .= "\n";
957
                    } else {
958
                        $foundAccounts .= "</p>\n";
959
                    }
960
                    
961
                #}
962
			}
963
        }
964
    	$ldap->unbind;   # take down session
965

    
966
    	# Follow references
967
    	my @references = $mesg->references();
968
    	for (my $i = 0; $i <= $#references; $i++) {
969
        	my $uri = URI->new($references[$i]);
970
        	my $host = $uri->host();
971
        	my $path = $uri->path();
972
        	$path =~ s/^\///;
973
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
974
        	if ($refFound) {
975
            	$foundAccounts .= $refFound;
976
        	}
977
    	}
978
    }
979

    
980
    #print "<p>Checking referrals...</p>\n";
981
    #my @referrals = $mesg->referrals();
982
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
983
    #for (my $i = 0; $i <= $#referrals; $i++) {
984
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
985
    #}
986

    
987
    return $foundAccounts;
988
}
989

    
990
#
991
# Validate that we have the proper set of input parameters
992
#
993
sub paramsAreValid {
994
    my @pnames = @_;
995

    
996
    my $allValid = 1;
997
    foreach my $parameter (@pnames) {
998
        if (!defined($query->param($parameter)) || 
999
            ! $query->param($parameter) ||
1000
            $query->param($parameter) =~ /^\s+$/) {
1001
            $allValid = 0;
1002
        }
1003
    }
1004

    
1005
    return $allValid;
1006
}
1007

    
1008
#
1009
# Create a temporary account for a user and send an email with a link which can click for the
1010
# verification. This is used to protect the ldap server against spams.
1011
#
1012
sub createTemporaryAccount {
1013
    my $allParams = shift;
1014
    my $org = $query->param('o'); 
1015
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1016
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1017
    my $tmp = 1;
1018

    
1019
    ################## 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
1020
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
1021
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
1022
    my $tmpFilter = "dc=tmp";
1023
    my @attributes=['dc'];
1024
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
1025
    if (!$foundTmp) {
1026
        my $dn = $tmpSearchBase;
1027
        my $additions = [ 
1028
                    'dc' => 'tmp',
1029
                    'o'  => 'tmp',
1030
                    'objectclass' => ['top', 'dcObject', 'organization']
1031
                    ];
1032
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1033
    } else {
1034
     debug("found the tmp space");
1035
    }
1036
    
1037
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1038
    my $filter = $ldapConfig->{$org}{'filter'};   
1039
    
1040
    debug("search filer " . $filter);
1041
    debug("ldap server ". $ldapurl);
1042
    debug("sesarch base " . $tmpSearchBase);
1043
    print "Content-type: text/html\n\n";
1044
    my @attrs = ['o', 'ou' ];
1045
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1046

    
1047
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
1048
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
1049
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
1050
        
1051
    if(!$found) {
1052
        debug("generate the subtree in the dc=tmp===========================");
1053
        #need to generate the subtree o or ou
1054
        my $additions;
1055
            if($organization eq 'ou') {
1056
                $additions = [ 
1057
                    $organization   => $organizationName,
1058
                    'objectclass' => ['top', 'organizationalUnit']
1059
                    ];
1060
            
1061
            } else {
1062
                $additions = [ 
1063
                    $organization   => $organizationName,
1064
                    'objectclass' => ['top', 'organization']
1065
                    ];
1066
            
1067
            } 
1068
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1069
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1070
    } 
1071
    
1072
    ################create an account under tmp subtree 
1073
    
1074
    #generate a randomstr for matching the email.
1075
    my $randomStr = getRandomPassword(16);
1076
    # Create a hashed version of the password
1077
    my $shapass = createSeededPassHash($query->param('userPassword'));
1078
    my $additions = [ 
1079
                'uid'   => $query->param('uid'),
1080
                'cn'   => join(" ", $query->param('givenName'), 
1081
                                    $query->param('sn')),
1082
                'sn'   => $query->param('sn'),
1083
                'givenName'   => $query->param('givenName'),
1084
                'mail' => $query->param('mail'),
1085
                'userPassword' => $shapass,
1086
                'employeeNumber' => $randomStr,
1087
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1088
                                'inetOrgPerson', 'uidObject' ],
1089
                $organization   => $organizationName
1090
                ];
1091
    if (defined($query->param('telephoneNumber')) && 
1092
                $query->param('telephoneNumber') &&
1093
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1094
                $$additions[$#$additions + 1] = 'telephoneNumber';
1095
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1096
    }
1097
    if (defined($query->param('title')) && 
1098
                $query->param('title') &&
1099
                ! $query->param('title') =~ /^\s+$/) {
1100
                $$additions[$#$additions + 1] = 'title';
1101
                $$additions[$#$additions + 1] = $query->param('title');
1102
    }
1103

    
1104
    
1105
    #$$additions[$#$additions + 1] = 'o';
1106
    #$$additions[$#$additions + 1] = $org;
1107
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1108
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1109
    
1110
    
1111
    ####################send the verification email to the user
1112
    my $link = $contextUrl. '/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.
1113
    
1114
    my $mailhost = $properties->getProperty('email.mailhost');
1115
    my $sender;
1116
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1117
    debug("the sender is " . $sender);
1118
    my $recipient = $query->param('mail');
1119
    # Send the email message to them
1120
    my $smtp = Net::SMTP->new($mailhost) or do {  
1121
                                                  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 " . 
1122
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1123
                                                  exit(0);
1124
                                               };
1125
    $smtp->mail($sender);
1126
    $smtp->to($recipient);
1127

    
1128
    my $message = <<"     ENDOFMESSAGE";
1129
    To: $recipient
1130
    From: $sender
1131
    Subject: Activate the New KNB Account
1132
        
1133
    Somebody (hopefully you) registered a KNB account.  
1134
    Please click the following link to activate your account.
1135
    If the link doesn't work, please copy the link to your browser:
1136
    
1137
    $link
1138

    
1139
    Thanks,
1140
        The KNB Development Team
1141
    
1142
     ENDOFMESSAGE
1143
     $message =~ s/^[ \t\r\f]+//gm;
1144
    
1145
     $smtp->data($message);
1146
     $smtp->quit;
1147
    debug("the link is " . $link);
1148
    fullTemplate( ['success'] );
1149
    
1150
}
1151

    
1152
#
1153
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1154
# by the user
1155
#
1156
sub createItem {
1157
    my $dn = shift;
1158
    my $ldapUsername = shift;
1159
    my $ldapPassword = shift;
1160
    my $additions = shift;
1161
    my $temp = shift; #if it is for a temporary account.
1162
    my $allParams = shift;
1163
    
1164
    my @failureTemplate;
1165
    if($temp){
1166
        @failureTemplate = ['registerFailed', 'register'];
1167
    } else {
1168
        @failureTemplate = ['registerFailed'];
1169
    }
1170
    print "Content-type: text/html\n\n";
1171
    debug("the dn is " . $dn);
1172
    debug("LDAP connection to $ldapurl...");    
1173
    #if main ldap server is down, a html file containing warning message will be returned
1174
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1175
    if ($ldap) {
1176
            $ldap->start_tls( verify => 'none');
1177
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1178
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1179
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1180
            if ($result->code()) {
1181
                fullTemplate(@failureTemplate, { stage => "register",
1182
                                                            allParams => $allParams,
1183
                                                            errorMessage => $result->error });
1184
                exist(0);
1185
                # TODO SCW was included as separate errors, test this
1186
                #$templateVars    = setVars({ stage => "register",
1187
                #                     allParams => $allParams });
1188
                #$template->process( $templates->{'register'}, $templateVars);
1189
            } else {
1190
                #fullTemplate( ['success'] );
1191
            }
1192
            $ldap->unbind;   # take down session
1193
            
1194
    } else {   
1195
         fullTemplate(@failureTemplate, { stage => "register",
1196
                                                            allParams => $allParams,
1197
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1198
         exit(0);
1199
    }
1200
  
1201
}
1202

    
1203

    
1204

    
1205

    
1206

    
1207

    
1208
#
1209
# This subroutine will handle a email verification:
1210
# If the hash string matches the one store in the ldap, the account will be
1211
# copied from the temporary space to the permanent tree and the account in 
1212
# the temporary space will be removed.
1213
sub handleEmailVerification {
1214

    
1215
    my $cfg = $query->param('cfg');
1216
    my $dn = $query->param('dn');
1217
    my $hash = $query->param('hash');
1218
    my $org = $query->param('o');
1219
    my $uid = $query->param('uid');
1220
    
1221
    my $ldapUsername;
1222
    my $ldapPassword;
1223
    #my $orgAuthBase;
1224

    
1225
    $ldapUsername = $ldapConfig->{$org}{'user'};
1226
    $ldapPassword = $ldapConfig->{$org}{'password'};
1227
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1228
    
1229
    debug("LDAP connection to $ldapurl...");    
1230
    
1231

    
1232
   print "Content-type: text/html\n\n";
1233
   #if main ldap server is down, a html file containing warning message will be returned
1234
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1235
   if ($ldap) {
1236
        $ldap->start_tls( verify => 'none');
1237
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1238
        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.
1239
        my $max = $mesg->count;
1240
        debug("the count is " . $max);
1241
        if($max < 1) {
1242
            $ldap->unbind;   # take down session
1243
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1244
            #handleLDAPBindFailure($ldapurl);
1245
            exit(0);
1246
        } else {
1247
            #check if the hash string match
1248
            my $entry = $mesg->entry (0);
1249
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1250
            if( $hashStrFromLdap eq $hash) {
1251
                #my $additions = [ ];
1252
                #foreach my $attr ( $entry->attributes ) {
1253
                    #if($attr ne 'employeeNumber') {
1254
                        #$$additions[$#$additions + 1] = $attr;
1255
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1256
                    #}
1257
                #}
1258

    
1259
                
1260
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1261
                $mesg = $ldap->moddn(
1262
                            dn => $dn,
1263
                            deleteoldrdn => 1,
1264
                            newrdn => "uid=" . $uid,
1265
                            newsuperior  =>  $orgDn);
1266
                $ldap->unbind;   # take down session
1267
                if($mesg->code()) {
1268
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1269
                    exit(0);
1270
                } else {
1271
                    fullTemplate( ['verificationSuccess'] );
1272
                }
1273
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1274
            } else {
1275
                $ldap->unbind;   # take down session
1276
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1277
                exit(0);
1278
            }
1279
            
1280
        }
1281
    } else {   
1282
        handleLDAPBindFailure($ldapurl);
1283
        exit(0);
1284
    }
1285

    
1286
}
1287

    
1288
sub handleResponseMessage {
1289

    
1290
  print "Content-type: text/html\n\n";
1291
  my $errorMessage = "You provided invalid input to the script. " .
1292
                     "Try again please.";
1293
  fullTemplate( [], { stage => $templates->{'stage'},
1294
                      errorMessage => $errorMessage });
1295
  exit();
1296
}
1297

    
1298
#
1299
# perform a simple search against the LDAP database using 
1300
# a small subset of attributes of each dn and return it
1301
# as a table to the calling browser.
1302
#
1303
sub handleSimpleSearch {
1304

    
1305
    my $o = $query->param('o');
1306

    
1307
    my $ldapurl = $ldapConfig->{$o}{'url'};
1308
    my $searchBase = $ldapConfig->{$o}{'base'};
1309

    
1310
    print "Content-type: text/html\n\n";
1311

    
1312
    my $allParams = { 
1313
                      'cn' => $query->param('cn'),
1314
                      'sn' => $query->param('sn'),
1315
                      'gn' => $query->param('gn'),
1316
                      'o'  => $query->param('o'),
1317
                      'facsimiletelephonenumber' 
1318
                      => $query->param('facsimiletelephonenumber'),
1319
                      'mail' => $query->param('cmail'),
1320
                      'telephonenumber' => $query->param('telephonenumber'),
1321
                      'title' => $query->param('title'),
1322
                      'uid' => $query->param('uid'),
1323
                      'ou' => $query->param('ou'),
1324
                    };
1325

    
1326
    # Search LDAP for matching entries that already exist
1327
    my $filter = "(" . 
1328
                 $query->param('searchField') . "=" .
1329
                 "*" .
1330
                 $query->param('searchValue') .
1331
                 "*" .
1332
                 ")";
1333

    
1334
    my @attrs = [ 'sn', 
1335
                  'gn', 
1336
                  'cn', 
1337
                  'o', 
1338
                  'facsimiletelephonenumber', 
1339
                  'mail', 
1340
                  'telephoneNumber', 
1341
                  'title', 
1342
                  'uid', 
1343
                  'labeledURI', 
1344
                  'ou' ];
1345

    
1346
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1347

    
1348
    # Send back the search results
1349
    if ($found) {
1350
      fullTemplate( ('searchResults'), { stage => "searchresults",
1351
                                         allParams => $allParams,
1352
                                         foundAccounts => $found });
1353
    } else {
1354
      $found = "No entries matched your criteria.  Please try again\n";
1355

    
1356
      fullTemplate( ('searchResults'), { stage => "searchresults",
1357
                                         allParams => $allParams,
1358
                                         foundAccounts => $found });
1359
    }
1360

    
1361
    exit();
1362
}
1363

    
1364
#
1365
# search the LDAP directory to see if a similar account already exists
1366
#
1367
sub searchDirectory {
1368
    my $ldapurl = shift;
1369
    my $base = shift;
1370
    my $filter = shift;
1371
    my $attref = shift;
1372

    
1373
	my $mesg;
1374
    my $foundAccounts = 0;
1375
    
1376
    #if ldap server is down, a html file containing warning message will be returned
1377
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1378
    
1379
    if ($ldap) {
1380
    	$ldap->start_tls( verify => 'none');
1381
    	$ldap->bind( version => 3, anonymous => 1);
1382
    	my $mesg = $ldap->search (
1383
        	base   => $base,
1384
        	filter => $filter,
1385
        	attrs => @$attref,
1386
    	);
1387

    
1388
    	if ($mesg->count() > 0) {
1389
        	$foundAccounts = "";
1390
        	my $entry;
1391
        	foreach $entry ($mesg->sorted(['sn'])) {
1392
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1393
          		$foundAccounts .= "<a href=\"" unless 
1394
                    (!$entry->get_value('labeledURI'));
1395
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1396
                    (!$entry->get_value('labeledURI'));
1397
          		$foundAccounts .= "\">\n" unless 
1398
                    (!$entry->get_value('labeledURI'));
1399
          		$foundAccounts .= $entry->get_value('givenName');
1400
          		$foundAccounts .= "</a>\n" unless 
1401
                    (!$entry->get_value('labeledURI'));
1402
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1403
          		$foundAccounts .= "<a href=\"" unless 
1404
                    (!$entry->get_value('labeledURI'));
1405
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1406
                    (!$entry->get_value('labeledURI'));
1407
          		$foundAccounts .= "\">\n" unless 
1408
                    (!$entry->get_value('labeledURI'));
1409
          		$foundAccounts .= $entry->get_value('sn');
1410
          		$foundAccounts .= "</a>\n";
1411
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1412
          		$foundAccounts .= $entry->get_value('mail');
1413
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1414
          		$foundAccounts .= $entry->get_value('telephonenumber');
1415
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1416
          		$foundAccounts .= $entry->get_value('title');
1417
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1418
          		$foundAccounts .= $entry->get_value('ou');
1419
          		$foundAccounts .= "\n</td>\n";
1420
          		$foundAccounts .= "</tr>\n";
1421
        	}
1422
    	}
1423
    	$ldap->unbind;   # take down session
1424
    }
1425
    return $foundAccounts;
1426
}
1427

    
1428
sub debug {
1429
    my $msg = shift;
1430
    
1431
    if ($debug) {
1432
        print STDERR "LDAPweb: $msg\n";
1433
    }
1434
}
1435

    
1436
sub handleLDAPBindFailure {
1437
    my $ldapAttemptUrl = shift;
1438
    my $primaryLdap =  $properties->getProperty('auth.url');
1439

    
1440
    if ($ldapAttemptUrl eq  $primaryLdap) {
1441
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1442
    } else {
1443
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1444
    }
1445
}
1446

    
1447
sub handleGeneralServerFailure {
1448
    my $errorMessage = shift;
1449
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1450
    exit(0);   
1451
   }
1452
    
1453
sub setVars {
1454
    my $paramVars = shift;
1455
    # initialize default parameters 
1456
    my $templateVars = { cfg => $cfg,
1457
                         styleSkinsPath => $contextUrl . "/style/skins",
1458
                         styleCommonPath => $contextUrl . "/style/common",
1459
                         contextUrl => $contextUrl,
1460
                         cgiPrefix => $cgiPrefix,
1461
                         orgList => \@validDisplayOrgList,
1462
                         config  => $config,
1463
    };
1464
    
1465
    # append customized params
1466
    while (my ($k, $v) = each (%$paramVars)) {
1467
        $templateVars->{$k} = $v;
1468
    }
1469
    
1470
    return $templateVars;
1471
} 
1472