Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8229

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 17:02:57 -0700 (Tue, 17 Sep 2013) $'
8
# '$Revision: 8229 $' 
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
              'searchnamesbyemail'=> \&handleSearchNameByEmail,
309
             );
310

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

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

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

    
338

    
339
#
340
# Initialize a form for a user to request the account name associated with an email address
341
#
342
sub handleLookupName {
343
    
344
    print "Content-type: text/html\n\n";
345
    # process the template files:
346
    fullTemplate(['lookupName']); 
347
    exit();
348
}
349

    
350
#
351
# Handle the user's request to look up account names with a specified email address.
352
# This relates to "Forget your user name"
353
#
354
sub handleSearchNameByEmail{
355

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

    
401
    my $message = <<"     ENDOFMESSAGE";
402
    To: $recipient
403
    From: $sender
404
    Subject: KNB Account
405
        
406
    Somebody (hopefully you) looked up the KNB accounts associated with the email address.  
407
    Here is the accounts information:
408
    
409
    $accountInfo
410

    
411
    Thanks,
412
        The KNB Development Team
413
    
414
     ENDOFMESSAGE
415
     $message =~ s/^[ \t\r\f]+//gm;
416
    
417
     $smtp->data($message);
418
     $smtp->quit;
419
     fullTemplate( ['lookupNameSuccess'] );
420
    
421
}
422

    
423

    
424
#
425
# create the initial registration form 
426
#
427
sub handleInitRegister {
428
  my $vars = shift;
429
  print "Content-type: text/html\n\n";
430
  # process the template files:
431
  fullTemplate(['register'], {stage => "register"}); 
432
  exit();
433
}
434

    
435

    
436

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

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

    
504
    # Search LDAP for matching entries that already exist
505
    # Some forms use a single text search box, whereas others search per
506
    # attribute.
507
    my $filter;
508
    if ($query->param('searchField')) {
509

    
510
      $filter = "(|" . 
511
                "(uid=" . $query->param('searchField') . ") " .
512
                "(mail=" . $query->param('searchField') . ")" .
513
                "(&(sn=" . $query->param('searchField') . ") " . 
514
                "(givenName=" . $query->param('searchField') . "))" . 
515
                ")";
516
    } else {
517
      $filter = "(|" . 
518
                "(uid=" . $query->param('uid') . ") " .
519
                "(mail=" . $query->param('mail') . ")" .
520
                "(&(sn=" . $query->param('sn') . ") " . 
521
                "(givenName=" . $query->param('givenName') . "))" . 
522
                ")";
523
    }
524

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

    
528
    # If entries match, send back a request to confirm new-user creation
529
    if ($found) {
530
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
531
                                                     allParams => $allParams,
532
                                                     foundAccounts => $found });
533
    # Otherwise, create a new user in the LDAP directory
534
    } else {
535
        createTemporaryAccount($allParams);
536
    }
537

    
538
    exit();
539
}
540

    
541
#
542
# process input from the registerconfirmed stage, which occurs when
543
# a user chooses to create an account despite similarities to other
544
# existing accounts
545
#
546
sub handleRegisterConfirmed {
547
  
548
    my $allParams = { 'givenName' => $query->param('givenName'), 
549
                      'sn' => $query->param('sn'),
550
                      'o' => $query->param('o'), 
551
                      'mail' => $query->param('mail'), 
552
                      'uid' => $query->param('uid'), 
553
                      'userPassword' => $query->param('userPassword'), 
554
                      'userPassword2' => $query->param('userPassword2'), 
555
                      'title' => $query->param('title'), 
556
                      'telephoneNumber' => $query->param('telephoneNumber') };
557
    print "Content-type: text/html\n\n";
558
    createTemporaryAccount($allParams);
559
    exit();
560
}
561

    
562
#
563
# change a user's password upon request
564
#
565
sub handleChangePassword {
566

    
567
    print "Content-type: text/html\n\n";
568

    
569
    my $allParams = { 'test' => "1", };
570
    if ($query->param('uid')) {
571
        $$allParams{'uid'} = $query->param('uid');
572
    }
573
    if ($query->param('o')) {
574
        $$allParams{'o'} = $query->param('o');
575
        my $o = $query->param('o');
576
        
577
        $searchBase = $ldapConfig->{$o}{'base'};
578
    }
579

    
580

    
581
    # Check that all required fields are provided and not null
582
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
583
                           'userPassword', 'userPassword2');
584
    if (! paramsAreValid(@requiredParams)) {
585
        my $errorMessage = "Required information is missing. " .
586
            "Please fill in all required fields and submit the form.";
587
        fullTemplate( ['changePass'], { stage => "changepass",
588
                                        allParams => $allParams,
589
                                        errorMessage => $errorMessage });
590
        exit();
591
    }
592

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

    
596
        my $o = $query->param('o');
597
        $searchBase = $ldapConfig->{$o}{'base'};
598
        $ldapUsername = $ldapConfig->{$o}{'user'};
599
        $ldapPassword = $ldapConfig->{$o}{'password'};
600

    
601
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
602
        if ($query->param('o') =~ "LTER") {
603
            fullTemplate( ['registerLter'] );
604
        } else {
605
            my $errorMessage = changePassword(
606
                    $dn, $query->param('userPassword'), 
607
                    $dn, $query->param('oldpass'), $query->param('o'));
608
            if ($errorMessage) {
609
                fullTemplate( ['changePass'], { stage => "changepass",
610
                                                allParams => $allParams,
611
                                                errorMessage => $errorMessage });
612
                exit();
613
            } else {
614
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
615
                                                       allParams => $allParams });
616
                exit();
617
            }
618
        }
619
    } else {
620
        my $errorMessage = "The passwords do not match. Try again.";
621
        fullTemplate( ['changePass'], { stage => "changepass",
622
                                        allParams => $allParams,
623
                                        errorMessage => $errorMessage });
624
        exit();
625
    }
626
}
627

    
628
#
629
# change a user's password upon request - no input params
630
# only display chagepass template without any error
631
#
632
sub handleInitialChangePassword {
633
    print "Content-type: text/html\n\n";
634

    
635
    my $allParams = { 'test' => "1", };
636
    my $errorMessage = "";
637
    fullTemplate( ['changePass'], { stage => "changepass",
638
                                    errorMessage => $errorMessage });
639
    exit();
640
}
641

    
642
#
643
# reset a user's password upon request
644
#
645
sub handleResetPassword {
646

    
647
    print "Content-type: text/html\n\n";
648

    
649
    my $allParams = { 'test' => "1", };
650
    if ($query->param('uid')) {
651
        $$allParams{'uid'} = $query->param('uid');
652
    }
653
    if ($query->param('o')) {
654
        $$allParams{'o'} = $query->param('o');
655
        my $o = $query->param('o');
656
        
657
        $searchBase = $ldapConfig->{$o}{'base'};
658
        $ldapUsername = $ldapConfig->{$o}{'user'};
659
        $ldapPassword = $ldapConfig->{$o}{'password'};
660
    }
661

    
662
    # Check that all required fields are provided and not null
663
    my @requiredParams = ( 'uid', 'o' );
664
    if (! paramsAreValid(@requiredParams)) {
665
        my $errorMessage = "Required information is missing. " .
666
            "Please fill in all required fields and submit the form.";
667
        fullTemplate( ['resetPass'],  { stage => "resetpass",
668
                                        allParams => $allParams,
669
                                        errorMessage => $errorMessage });
670
        exit();
671
    }
672

    
673
    # We have all of the info we need, so try to change the password
674
    my $o = $query->param('o');
675
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
676
    debug("handleResetPassword: dn: $dn");
677
    if ($query->param('o') =~ "LTER") {
678
        fullTemplate( ['registerLter'] );
679
        exit();
680
    } else {
681
        my $errorMessage = "";
682
        my $recipient;
683
        my $userPass;
684
        my $entry = getLdapEntry($ldapurl, $searchBase, 
685
                $query->param('uid'), $query->param('o'));
686

    
687
        if ($entry) {
688
            $recipient = $entry->get_value('mail');
689
            $userPass = getRandomPassword();
690
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
691
        } else {
692
            $errorMessage = "User not found in database.  Please try again.";
693
        }
694

    
695
        if ($errorMessage) {
696
            fullTemplate( ['resetPass'], { stage => "resetpass",
697
                                           allParams => $allParams,
698
                                           errorMessage => $errorMessage });
699
            exit();
700
        } else {
701
            my $errorMessage = sendPasswordNotification($query->param('uid'),
702
                    $query->param('o'), $userPass, $recipient, $cfg);
703
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
704
                                                  allParams => $allParams,
705
                                                  errorMessage => $errorMessage });
706
            exit();
707
        }
708
    }
709
}
710

    
711
#
712
# reset a user's password upon request- no initial params
713
# only display resetpass template without any error
714
#
715
sub handleInitialResetPassword {
716
    print "Content-type: text/html\n\n";
717
    my $errorMessage = "";
718
    fullTemplate( ['resetPass'], { stage => "resetpass",
719
                                   errorMessage => $errorMessage });
720
    exit();
721
}
722

    
723
#
724
# Construct a random string to use for a newly reset password
725
#
726
sub getRandomPassword {
727
    my $length = shift;
728
    if (!$length) {
729
        $length = 8;
730
    }
731
    my $newPass = "";
732

    
733
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
734
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
735
    return $newPass;
736
}
737

    
738
#
739
# Change a password to a new value, binding as the provided user
740
#
741
sub changePassword {
742
    my $userDN = shift;
743
    my $userPass = shift;
744
    my $bindDN = shift;
745
    my $bindPass = shift;
746
    my $o = shift;
747

    
748
    my $searchBase = $ldapConfig->{$o}{'base'};
749

    
750
    my $errorMessage = 0;
751
    my $ldap;
752

    
753
    #if main ldap server is down, a html file containing warning message will be returned
754
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
755
    
756
    if ($ldap) {
757
        #$ldap->start_tls( verify => 'require',
758
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
759
        $ldap->start_tls( verify => 'none');
760
        debug("changePassword: attempting to bind to $bindDN");
761
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
762
                                  password => $bindPass );
763
        if ($bindresult->code) {
764
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
765
                            "correct? Please correct and try again...";
766
            return $errorMessage;
767
        }
768

    
769
    	# Find the user here and change their entry
770
    	my $newpass = createSeededPassHash($userPass);
771
    	my $modifications = { userPassword => $newpass };
772
      debug("changePass: setting password for $userDN to $newpass");
773
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
774
    
775
    	if ($result->code()) {
776
            debug("changePass: error changing password: " . $result->error);
777
        	$errorMessage = "There was an error changing the password:" .
778
                           "<br />\n" . $result->error;
779
    	} 
780
    	$ldap->unbind;   # take down session
781
    }
782

    
783
    return $errorMessage;
784
}
785

    
786
#
787
# generate a Seeded SHA1 hash of a plaintext password
788
#
789
sub createSeededPassHash {
790
    my $secret = shift;
791

    
792
    my $salt = "";
793
    for (my $i=0; $i < 4; $i++) {
794
        $salt .= int(rand(10));
795
    }
796

    
797
    my $ctx = Digest::SHA1->new;
798
    $ctx->add($secret);
799
    $ctx->add($salt);
800
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
801

    
802
    return $hashedPasswd;
803
}
804

    
805
#
806
# Look up an ldap entry for a user
807
#
808
sub getLdapEntry {
809
    my $ldapurl = shift;
810
    my $base = shift;
811
    my $username = shift;
812
    my $org = shift;
813

    
814
    my $entry = "";
815
    my $mesg;
816
    my $ldap;
817
    debug("ldap server: $ldapurl");
818

    
819
    #if main ldap server is down, a html file containing warning message will be returned
820
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
821
    
822
    if ($ldap) {
823
    	$ldap->start_tls( verify => 'none');
824
    	my $bindresult = $ldap->bind;
825
    	if ($bindresult->code) {
826
        	return $entry;
827
    	}
828

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

    
862
# 
863
# send an email message notifying the user of the pw change
864
#
865
sub sendPasswordNotification {
866
    my $username = shift;
867
    my $org = shift;
868
    my $newPass = shift;
869
    my $recipient = shift;
870
    my $cfg = shift;
871

    
872
    my $errorMessage = "";
873
    if ($recipient) {
874
        my $mailhost = $properties->getProperty('email.mailhost');
875
        my $sender;
876
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
877
        # Send the email message to them
878
        my $smtp = Net::SMTP->new($mailhost);
879
        $smtp->mail($sender);
880
        $smtp->to($recipient);
881

    
882
        my $message = <<"        ENDOFMESSAGE";
883
        To: $recipient
884
        From: $sender
885
        Subject: KNB Password Reset
886
        
887
        Somebody (hopefully you) requested that your KNB password be reset.  
888
        This is generally done when somebody forgets their password.  Your 
889
        password can be changed by visiting the following URL:
890

    
891
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
892

    
893
            Username: $username
894
        Organization: $org
895
        New Password: $newPass
896

    
897
        Thanks,
898
            The KNB Development Team
899
    
900
        ENDOFMESSAGE
901
        $message =~ s/^[ \t\r\f]+//gm;
902
    
903
        $smtp->data($message);
904
        $smtp->quit;
905
    } else {
906
        $errorMessage = "Failed to send password because I " .
907
                        "couldn't find a valid email address.";
908
    }
909
    return $errorMessage;
910
}
911

    
912
#
913
# search the LDAP directory to see if a similar account already exists
914
#
915
sub findExistingAccounts {
916
    my $ldapurl = shift;
917
    my $base = shift;
918
    my $filter = shift;
919
    my $attref = shift;
920
    my $notHtmlFormat = shift;
921
    my $ldap;
922
    my $mesg;
923

    
924
    my $foundAccounts = 0;
925

    
926
    #if main ldap server is down, a html file containing warning message will be returned
927
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
928
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
929
    if ($ldap) {
930
    	$ldap->start_tls( verify => 'none');
931
    	$ldap->bind( version => 3, anonymous => 1);
932
		$mesg = $ldap->search (
933
			base   => $base,
934
			filter => $filter,
935
			attrs => @$attref,
936
		);
937

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

    
977
    	# Follow references
978
    	my @references = $mesg->references();
979
    	for (my $i = 0; $i <= $#references; $i++) {
980
        	my $uri = URI->new($references[$i]);
981
        	my $host = $uri->host();
982
        	my $path = $uri->path();
983
        	$path =~ s/^\///;
984
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
985
        	if ($refFound) {
986
            	$foundAccounts .= $refFound;
987
        	}
988
    	}
989
    }
990

    
991
    #print "<p>Checking referrals...</p>\n";
992
    #my @referrals = $mesg->referrals();
993
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
994
    #for (my $i = 0; $i <= $#referrals; $i++) {
995
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
996
    #}
997

    
998
    return $foundAccounts;
999
}
1000

    
1001
#
1002
# Validate that we have the proper set of input parameters
1003
#
1004
sub paramsAreValid {
1005
    my @pnames = @_;
1006

    
1007
    my $allValid = 1;
1008
    foreach my $parameter (@pnames) {
1009
        if (!defined($query->param($parameter)) || 
1010
            ! $query->param($parameter) ||
1011
            $query->param($parameter) =~ /^\s+$/) {
1012
            $allValid = 0;
1013
        }
1014
    }
1015

    
1016
    return $allValid;
1017
}
1018

    
1019
#
1020
# Create a temporary account for a user and send an email with a link which can click for the
1021
# verification. This is used to protect the ldap server against spams.
1022
#
1023
sub createTemporaryAccount {
1024
    my $allParams = shift;
1025
    my $org = $query->param('o'); 
1026
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1027
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1028
    my $tmp = 1;
1029

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

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

    
1115
    
1116
    #$$additions[$#$additions + 1] = 'o';
1117
    #$$additions[$#$additions + 1] = $org;
1118
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1119
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1120
    
1121
    
1122
    ####################send the verification email to the user
1123
    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.
1124
    
1125
    my $mailhost = $properties->getProperty('email.mailhost');
1126
    my $sender;
1127
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1128
    debug("the sender is " . $sender);
1129
    my $recipient = $query->param('mail');
1130
    # Send the email message to them
1131
    my $smtp = Net::SMTP->new($mailhost) or do {  
1132
                                                  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 " . 
1133
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1134
                                                  exit(0);
1135
                                               };
1136
    $smtp->mail($sender);
1137
    $smtp->to($recipient);
1138

    
1139
    my $message = <<"     ENDOFMESSAGE";
1140
    To: $recipient
1141
    From: $sender
1142
    Subject: Activate the New KNB Account
1143
        
1144
    Somebody (hopefully you) registered a KNB account.  
1145
    Please click the following link to activate your account.
1146
    If the link doesn't work, please copy the link to your browser:
1147
    
1148
    $link
1149

    
1150
    Thanks,
1151
        The KNB Development Team
1152
    
1153
     ENDOFMESSAGE
1154
     $message =~ s/^[ \t\r\f]+//gm;
1155
    
1156
     $smtp->data($message);
1157
     $smtp->quit;
1158
    debug("the link is " . $link);
1159
    fullTemplate( ['success'] );
1160
    
1161
}
1162

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

    
1214

    
1215

    
1216

    
1217

    
1218

    
1219
#
1220
# This subroutine will handle a email verification:
1221
# If the hash string matches the one store in the ldap, the account will be
1222
# copied from the temporary space to the permanent tree and the account in 
1223
# the temporary space will be removed.
1224
sub handleEmailVerification {
1225

    
1226
    my $cfg = $query->param('cfg');
1227
    my $dn = $query->param('dn');
1228
    my $hash = $query->param('hash');
1229
    my $org = $query->param('o');
1230
    my $uid = $query->param('uid');
1231
    
1232
    my $ldapUsername;
1233
    my $ldapPassword;
1234
    #my $orgAuthBase;
1235

    
1236
    $ldapUsername = $ldapConfig->{$org}{'user'};
1237
    $ldapPassword = $ldapConfig->{$org}{'password'};
1238
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1239
    
1240
    debug("LDAP connection to $ldapurl...");    
1241
    
1242

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

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

    
1297
}
1298

    
1299
sub handleResponseMessage {
1300

    
1301
  print "Content-type: text/html\n\n";
1302
  my $errorMessage = "You provided invalid input to the script. " .
1303
                     "Try again please.";
1304
  fullTemplate( [], { stage => $templates->{'stage'},
1305
                      errorMessage => $errorMessage });
1306
  exit();
1307
}
1308

    
1309
#
1310
# perform a simple search against the LDAP database using 
1311
# a small subset of attributes of each dn and return it
1312
# as a table to the calling browser.
1313
#
1314
sub handleSimpleSearch {
1315

    
1316
    my $o = $query->param('o');
1317

    
1318
    my $ldapurl = $ldapConfig->{$o}{'url'};
1319
    my $searchBase = $ldapConfig->{$o}{'base'};
1320

    
1321
    print "Content-type: text/html\n\n";
1322

    
1323
    my $allParams = { 
1324
                      'cn' => $query->param('cn'),
1325
                      'sn' => $query->param('sn'),
1326
                      'gn' => $query->param('gn'),
1327
                      'o'  => $query->param('o'),
1328
                      'facsimiletelephonenumber' 
1329
                      => $query->param('facsimiletelephonenumber'),
1330
                      'mail' => $query->param('cmail'),
1331
                      'telephonenumber' => $query->param('telephonenumber'),
1332
                      'title' => $query->param('title'),
1333
                      'uid' => $query->param('uid'),
1334
                      'ou' => $query->param('ou'),
1335
                    };
1336

    
1337
    # Search LDAP for matching entries that already exist
1338
    my $filter = "(" . 
1339
                 $query->param('searchField') . "=" .
1340
                 "*" .
1341
                 $query->param('searchValue') .
1342
                 "*" .
1343
                 ")";
1344

    
1345
    my @attrs = [ 'sn', 
1346
                  'gn', 
1347
                  'cn', 
1348
                  'o', 
1349
                  'facsimiletelephonenumber', 
1350
                  'mail', 
1351
                  'telephoneNumber', 
1352
                  'title', 
1353
                  'uid', 
1354
                  'labeledURI', 
1355
                  'ou' ];
1356

    
1357
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1358

    
1359
    # Send back the search results
1360
    if ($found) {
1361
      fullTemplate( ('searchResults'), { stage => "searchresults",
1362
                                         allParams => $allParams,
1363
                                         foundAccounts => $found });
1364
    } else {
1365
      $found = "No entries matched your criteria.  Please try again\n";
1366

    
1367
      fullTemplate( ('searchResults'), { stage => "searchresults",
1368
                                         allParams => $allParams,
1369
                                         foundAccounts => $found });
1370
    }
1371

    
1372
    exit();
1373
}
1374

    
1375
#
1376
# search the LDAP directory to see if a similar account already exists
1377
#
1378
sub searchDirectory {
1379
    my $ldapurl = shift;
1380
    my $base = shift;
1381
    my $filter = shift;
1382
    my $attref = shift;
1383

    
1384
	my $mesg;
1385
    my $foundAccounts = 0;
1386
    
1387
    #if ldap server is down, a html file containing warning message will be returned
1388
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1389
    
1390
    if ($ldap) {
1391
    	$ldap->start_tls( verify => 'none');
1392
    	$ldap->bind( version => 3, anonymous => 1);
1393
    	my $mesg = $ldap->search (
1394
        	base   => $base,
1395
        	filter => $filter,
1396
        	attrs => @$attref,
1397
    	);
1398

    
1399
    	if ($mesg->count() > 0) {
1400
        	$foundAccounts = "";
1401
        	my $entry;
1402
        	foreach $entry ($mesg->sorted(['sn'])) {
1403
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1404
          		$foundAccounts .= "<a href=\"" unless 
1405
                    (!$entry->get_value('labeledURI'));
1406
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1407
                    (!$entry->get_value('labeledURI'));
1408
          		$foundAccounts .= "\">\n" unless 
1409
                    (!$entry->get_value('labeledURI'));
1410
          		$foundAccounts .= $entry->get_value('givenName');
1411
          		$foundAccounts .= "</a>\n" unless 
1412
                    (!$entry->get_value('labeledURI'));
1413
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1414
          		$foundAccounts .= "<a href=\"" unless 
1415
                    (!$entry->get_value('labeledURI'));
1416
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1417
                    (!$entry->get_value('labeledURI'));
1418
          		$foundAccounts .= "\">\n" unless 
1419
                    (!$entry->get_value('labeledURI'));
1420
          		$foundAccounts .= $entry->get_value('sn');
1421
          		$foundAccounts .= "</a>\n";
1422
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1423
          		$foundAccounts .= $entry->get_value('mail');
1424
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1425
          		$foundAccounts .= $entry->get_value('telephonenumber');
1426
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1427
          		$foundAccounts .= $entry->get_value('title');
1428
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1429
          		$foundAccounts .= $entry->get_value('ou');
1430
          		$foundAccounts .= "\n</td>\n";
1431
          		$foundAccounts .= "</tr>\n";
1432
        	}
1433
    	}
1434
    	$ldap->unbind;   # take down session
1435
    }
1436
    return $foundAccounts;
1437
}
1438

    
1439
sub debug {
1440
    my $msg = shift;
1441
    
1442
    if ($debug) {
1443
        print STDERR "LDAPweb: $msg\n";
1444
    }
1445
}
1446

    
1447
sub handleLDAPBindFailure {
1448
    my $ldapAttemptUrl = shift;
1449
    my $primaryLdap =  $properties->getProperty('auth.url');
1450

    
1451
    if ($ldapAttemptUrl eq  $primaryLdap) {
1452
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1453
    } else {
1454
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1455
    }
1456
}
1457

    
1458
sub handleGeneralServerFailure {
1459
    my $errorMessage = shift;
1460
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1461
    exit(0);   
1462
   }
1463
    
1464
sub setVars {
1465
    my $paramVars = shift;
1466
    # initialize default parameters 
1467
    my $templateVars = { cfg => $cfg,
1468
                         styleSkinsPath => $contextUrl . "/style/skins",
1469
                         styleCommonPath => $contextUrl . "/style/common",
1470
                         contextUrl => $contextUrl,
1471
                         cgiPrefix => $cgiPrefix,
1472
                         orgList => \@validDisplayOrgList,
1473
                         config  => $config,
1474
    };
1475
    
1476
    # append customized params
1477
    while (my ($k, $v) = each (%$paramVars)) {
1478
        $templateVars->{$k} = $v;
1479
    }
1480
    
1481
    return $templateVars;
1482
} 
1483