Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8217

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-16 21:58:12 -0700 (Mon, 16 Sep 2013) $'
8
# '$Revision: 8217 $' 
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
             );
308

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

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

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

    
336
#
337
# create the initial registration form 
338
#
339
sub handleInitRegister {
340
  my $vars = shift;
341
  print "Content-type: text/html\n\n";
342
  # process the template files:
343
  fullTemplate(['register'], {stage => "register"}); 
344
  exit();
345
}
346

    
347
#
348
# process input from the register stage, which occurs when
349
# a user submits form data to create a new account
350
#
351
sub handleRegister {
352
    
353
    print "Content-type: text/html\n\n";
354
    
355
    
356
    my $allParams = { 'givenName' => $query->param('givenName'), 
357
                      'sn' => $query->param('sn'),
358
                      'o' => $query->param('o'), 
359
                      'mail' => $query->param('mail'), 
360
                      'uid' => $query->param('uid'), 
361
                      'userPassword' => $query->param('userPassword'), 
362
                      'userPassword2' => $query->param('userPassword2'), 
363
                      'title' => $query->param('title'), 
364
                      'telephoneNumber' => $query->param('telephoneNumber') };
365
    
366
    # Check the recaptcha
367
    my $c = Captcha::reCAPTCHA->new;
368
    my $challenge = $query->param('recaptcha_challenge_field');
369
    my $response = $query->param('recaptcha_response_field');
370
    # Verify submission
371
    my $result = $c->check_answer(
372
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
373
        $challenge, $response
374
    );
375

    
376
    if ( $result->{is_valid} ) {
377
        #print "Yes!";
378
        #exit();
379
    }
380
    else {
381
        my $errorMessage = "The verification code is wrong. Please input again.";
382
        fullTemplate(['register'], { stage => "register",
383
                                     allParams => $allParams,
384
                                     errorMessage => $errorMessage });
385
        exit();
386
    }
387
    
388
    
389
    # Check that all required fields are provided and not null
390
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
391
                           'uid', 'userPassword', 'userPassword2');
392
    if (! paramsAreValid(@requiredParams)) {
393
        my $errorMessage = "Required information is missing. " .
394
            "Please fill in all required fields and resubmit the form.";
395
        fullTemplate(['register'], { stage => "register",
396
                                     allParams => $allParams,
397
                                     errorMessage => $errorMessage });
398
        exit();
399
    } else {
400
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
401
            my $errorMessage = "The passwords do not match. Try again.";
402
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
403
                                                            allParams => $allParams,
404
                                                            errorMessage => $errorMessage });
405
            exit();
406
        }
407
        my $o = $query->param('o');    
408
        $searchBase = $ldapConfig->{$o}{'base'};  
409
    }
410

    
411
    # Search LDAP for matching entries that already exist
412
    # Some forms use a single text search box, whereas others search per
413
    # attribute.
414
    my $filter;
415
    if ($query->param('searchField')) {
416

    
417
      $filter = "(|" . 
418
                "(uid=" . $query->param('searchField') . ") " .
419
                "(mail=" . $query->param('searchField') . ")" .
420
                "(&(sn=" . $query->param('searchField') . ") " . 
421
                "(givenName=" . $query->param('searchField') . "))" . 
422
                ")";
423
    } else {
424
      $filter = "(|" . 
425
                "(uid=" . $query->param('uid') . ") " .
426
                "(mail=" . $query->param('mail') . ")" .
427
                "(&(sn=" . $query->param('sn') . ") " . 
428
                "(givenName=" . $query->param('givenName') . "))" . 
429
                ")";
430
    }
431

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

    
435
    # If entries match, send back a request to confirm new-user creation
436
    if ($found) {
437
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
438
                                                     allParams => $allParams,
439
                                                     foundAccounts => $found });
440
    # Otherwise, create a new user in the LDAP directory
441
    } else {
442
        createTemporaryAccount($allParams);
443
    }
444

    
445
    exit();
446
}
447

    
448
#
449
# process input from the registerconfirmed stage, which occurs when
450
# a user chooses to create an account despite similarities to other
451
# existing accounts
452
#
453
sub handleRegisterConfirmed {
454
  
455
    my $allParams = { 'givenName' => $query->param('givenName'), 
456
                      'sn' => $query->param('sn'),
457
                      'o' => $query->param('o'), 
458
                      'mail' => $query->param('mail'), 
459
                      'uid' => $query->param('uid'), 
460
                      'userPassword' => $query->param('userPassword'), 
461
                      'userPassword2' => $query->param('userPassword2'), 
462
                      'title' => $query->param('title'), 
463
                      'telephoneNumber' => $query->param('telephoneNumber') };
464
    print "Content-type: text/html\n\n";
465
    createTemporaryAccount($allParams);
466
    exit();
467
}
468

    
469
#
470
# change a user's password upon request
471
#
472
sub handleChangePassword {
473

    
474
    print "Content-type: text/html\n\n";
475

    
476
    my $allParams = { 'test' => "1", };
477
    if ($query->param('uid')) {
478
        $$allParams{'uid'} = $query->param('uid');
479
    }
480
    if ($query->param('o')) {
481
        $$allParams{'o'} = $query->param('o');
482
        my $o = $query->param('o');
483
        
484
        $searchBase = $ldapConfig->{$o}{'base'};
485
    }
486

    
487

    
488
    # Check that all required fields are provided and not null
489
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
490
                           'userPassword', 'userPassword2');
491
    if (! paramsAreValid(@requiredParams)) {
492
        my $errorMessage = "Required information is missing. " .
493
            "Please fill in all required fields and submit the form.";
494
        fullTemplate( ['changePass'], { stage => "changepass",
495
                                        allParams => $allParams,
496
                                        errorMessage => $errorMessage });
497
        exit();
498
    }
499

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

    
503
        my $o = $query->param('o');
504
        $searchBase = $ldapConfig->{$o}{'base'};
505
        $ldapUsername = $ldapConfig->{$o}{'user'};
506
        $ldapPassword = $ldapConfig->{$o}{'password'};
507

    
508
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
509
        if ($query->param('o') =~ "LTER") {
510
            fullTemplate( ['registerLter'] );
511
        } else {
512
            my $errorMessage = changePassword(
513
                    $dn, $query->param('userPassword'), 
514
                    $dn, $query->param('oldpass'), $query->param('o'));
515
            if ($errorMessage) {
516
                fullTemplate( ['changePass'], { stage => "changepass",
517
                                                allParams => $allParams,
518
                                                errorMessage => $errorMessage });
519
                exit();
520
            } else {
521
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
522
                                                       allParams => $allParams });
523
                exit();
524
            }
525
        }
526
    } else {
527
        my $errorMessage = "The passwords do not match. Try again.";
528
        fullTemplate( ['changePass'], { stage => "changepass",
529
                                        allParams => $allParams,
530
                                        errorMessage => $errorMessage });
531
        exit();
532
    }
533
}
534

    
535
#
536
# change a user's password upon request - no input params
537
# only display chagepass template without any error
538
#
539
sub handleInitialChangePassword {
540
    print "Content-type: text/html\n\n";
541

    
542
    my $allParams = { 'test' => "1", };
543
    my $errorMessage = "";
544
    fullTemplate( ['changePass'], { stage => "changepass",
545
                                    errorMessage => $errorMessage });
546
    exit();
547
}
548

    
549
#
550
# reset a user's password upon request
551
#
552
sub handleResetPassword {
553

    
554
    print "Content-type: text/html\n\n";
555

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

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

    
580
    # We have all of the info we need, so try to change the password
581
    my $o = $query->param('o');
582
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
583
    debug("handleResetPassword: dn: $dn");
584
    if ($query->param('o') =~ "LTER") {
585
        fullTemplate( ['registerLter'] );
586
        exit();
587
    } else {
588
        my $errorMessage = "";
589
        my $recipient;
590
        my $userPass;
591
        my $entry = getLdapEntry($ldapurl, $searchBase, 
592
                $query->param('uid'), $query->param('o'));
593

    
594
        if ($entry) {
595
            $recipient = $entry->get_value('mail');
596
            $userPass = getRandomPassword();
597
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
598
        } else {
599
            $errorMessage = "User not found in database.  Please try again.";
600
        }
601

    
602
        if ($errorMessage) {
603
            fullTemplate( ['resetPass'], { stage => "resetpass",
604
                                           allParams => $allParams,
605
                                           errorMessage => $errorMessage });
606
            exit();
607
        } else {
608
            my $errorMessage = sendPasswordNotification($query->param('uid'),
609
                    $query->param('o'), $userPass, $recipient, $cfg);
610
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
611
                                                  allParams => $allParams,
612
                                                  errorMessage => $errorMessage });
613
            exit();
614
        }
615
    }
616
}
617

    
618
#
619
# reset a user's password upon request- no initial params
620
# only display resetpass template without any error
621
#
622
sub handleInitialResetPassword {
623
    print "Content-type: text/html\n\n";
624
    my $errorMessage = "";
625
    fullTemplate( ['resetPass'], { stage => "resetpass",
626
                                   errorMessage => $errorMessage });
627
    exit();
628
}
629

    
630
#
631
# Construct a random string to use for a newly reset password
632
#
633
sub getRandomPassword {
634
    my $length = shift;
635
    if (!$length) {
636
        $length = 8;
637
    }
638
    my $newPass = "";
639

    
640
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
641
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
642
    return $newPass;
643
}
644

    
645
#
646
# Change a password to a new value, binding as the provided user
647
#
648
sub changePassword {
649
    my $userDN = shift;
650
    my $userPass = shift;
651
    my $bindDN = shift;
652
    my $bindPass = shift;
653
    my $o = shift;
654

    
655
    my $searchBase = $ldapConfig->{$o}{'base'};
656

    
657
    my $errorMessage = 0;
658
    my $ldap;
659

    
660
    #if main ldap server is down, a html file containing warning message will be returned
661
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
662
    
663
    if ($ldap) {
664
        #$ldap->start_tls( verify => 'require',
665
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
666
        $ldap->start_tls( verify => 'none');
667
        debug("changePassword: attempting to bind to $bindDN");
668
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
669
                                  password => $bindPass );
670
        if ($bindresult->code) {
671
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
672
                            "correct? Please correct and try again...";
673
            return $errorMessage;
674
        }
675

    
676
    	# Find the user here and change their entry
677
    	my $newpass = createSeededPassHash($userPass);
678
    	my $modifications = { userPassword => $newpass };
679
      debug("changePass: setting password for $userDN to $newpass");
680
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
681
    
682
    	if ($result->code()) {
683
            debug("changePass: error changing password: " . $result->error);
684
        	$errorMessage = "There was an error changing the password:" .
685
                           "<br />\n" . $result->error;
686
    	} 
687
    	$ldap->unbind;   # take down session
688
    }
689

    
690
    return $errorMessage;
691
}
692

    
693
#
694
# generate a Seeded SHA1 hash of a plaintext password
695
#
696
sub createSeededPassHash {
697
    my $secret = shift;
698

    
699
    my $salt = "";
700
    for (my $i=0; $i < 4; $i++) {
701
        $salt .= int(rand(10));
702
    }
703

    
704
    my $ctx = Digest::SHA1->new;
705
    $ctx->add($secret);
706
    $ctx->add($salt);
707
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
708

    
709
    return $hashedPasswd;
710
}
711

    
712
#
713
# Look up an ldap entry for a user
714
#
715
sub getLdapEntry {
716
    my $ldapurl = shift;
717
    my $base = shift;
718
    my $username = shift;
719
    my $org = shift;
720

    
721
    my $entry = "";
722
    my $mesg;
723
    my $ldap;
724
    debug("ldap server: $ldapurl");
725

    
726
    #if main ldap server is down, a html file containing warning message will be returned
727
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
728
    
729
    if ($ldap) {
730
    	$ldap->start_tls( verify => 'none');
731
    	my $bindresult = $ldap->bind;
732
    	if ($bindresult->code) {
733
        	return $entry;
734
    	}
735

    
736
    	if($ldapConfig->{$org}{'filter'}){
737
            debug("getLdapEntry: filter set, searching for base=$base, " .
738
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
739
        	$mesg = $ldap->search ( base   => $base,
740
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
741
    	} else {
742
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
743
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
744
    	}
745
    
746
    	if ($mesg->count > 0) {
747
        	$entry = $mesg->pop_entry;
748
        	$ldap->unbind;   # take down session
749
    	} else {
750
        	$ldap->unbind;   # take down session
751
        	# Follow references by recursive call to self
752
        	my @references = $mesg->references();
753
        	for (my $i = 0; $i <= $#references; $i++) {
754
            	my $uri = URI->new($references[$i]);
755
            	my $host = $uri->host();
756
            	my $path = $uri->path();
757
            	$path =~ s/^\///;
758
            	$entry = &getLdapEntry($host, $path, $username, $org);
759
            	if ($entry) {
760
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
761
                	return $entry;
762
            	}
763
        	}
764
    	}
765
    }
766
    return $entry;
767
}
768

    
769
# 
770
# send an email message notifying the user of the pw change
771
#
772
sub sendPasswordNotification {
773
    my $username = shift;
774
    my $org = shift;
775
    my $newPass = shift;
776
    my $recipient = shift;
777
    my $cfg = shift;
778

    
779
    my $errorMessage = "";
780
    if ($recipient) {
781
        my $mailhost = $properties->getProperty('email.mailhost');
782
        my $sender;
783
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
784
        # Send the email message to them
785
        my $smtp = Net::SMTP->new($mailhost);
786
        $smtp->mail($sender);
787
        $smtp->to($recipient);
788

    
789
        my $message = <<"        ENDOFMESSAGE";
790
        To: $recipient
791
        From: $sender
792
        Subject: KNB Password Reset
793
        
794
        Somebody (hopefully you) requested that your KNB password be reset.  
795
        This is generally done when somebody forgets their password.  Your 
796
        password can be changed by visiting the following URL:
797

    
798
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
799

    
800
            Username: $username
801
        Organization: $org
802
        New Password: $newPass
803

    
804
        Thanks,
805
            The KNB Development Team
806
    
807
        ENDOFMESSAGE
808
        $message =~ s/^[ \t\r\f]+//gm;
809
    
810
        $smtp->data($message);
811
        $smtp->quit;
812
    } else {
813
        $errorMessage = "Failed to send password because I " .
814
                        "couldn't find a valid email address.";
815
    }
816
    return $errorMessage;
817
}
818

    
819
#
820
# search the LDAP directory to see if a similar account already exists
821
#
822
sub findExistingAccounts {
823
    my $ldapurl = shift;
824
    my $base = shift;
825
    my $filter = shift;
826
    my $attref = shift;
827
    my $ldap;
828
    my $mesg;
829

    
830
    my $foundAccounts = 0;
831

    
832
    #if main ldap server is down, a html file containing warning message will be returned
833
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
834
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
835
    if ($ldap) {
836
    	$ldap->start_tls( verify => 'none');
837
    	$ldap->bind( version => 3, anonymous => 1);
838
		$mesg = $ldap->search (
839
			base   => $base,
840
			filter => $filter,
841
			attrs => @$attref,
842
		);
843

    
844
	    if ($mesg->count() > 0) {
845
			$foundAccounts = "";
846
			my $entry;
847
			foreach $entry ($mesg->all_entries) { 
848
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
849
                # this could be done directly with filters on the LDAP connection, instead.
850
                #if ($entry->dn !~ /ou=Account/) {
851
                    $foundAccounts .= "<p>\n<b><u>Account:</u> ";
852
                    $foundAccounts .= $entry->dn();
853
                    $foundAccounts .= "</b><br />\n";
854
                    foreach my $attribute ($entry->attributes()) {
855
                        my $value = $entry->get_value($attribute);
856
                        $foundAccounts .= "$attribute: ";
857
                        $foundAccounts .= $value;
858
                        $foundAccounts .= "<br />\n";
859
                    }
860
                    $foundAccounts .= "</p>\n";
861
                #}
862
			}
863
        }
864
    	$ldap->unbind;   # take down session
865

    
866
    	# Follow references
867
    	my @references = $mesg->references();
868
    	for (my $i = 0; $i <= $#references; $i++) {
869
        	my $uri = URI->new($references[$i]);
870
        	my $host = $uri->host();
871
        	my $path = $uri->path();
872
        	$path =~ s/^\///;
873
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
874
        	if ($refFound) {
875
            	$foundAccounts .= $refFound;
876
        	}
877
    	}
878
    }
879

    
880
    #print "<p>Checking referrals...</p>\n";
881
    #my @referrals = $mesg->referrals();
882
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
883
    #for (my $i = 0; $i <= $#referrals; $i++) {
884
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
885
    #}
886

    
887
    return $foundAccounts;
888
}
889

    
890
#
891
# Validate that we have the proper set of input parameters
892
#
893
sub paramsAreValid {
894
    my @pnames = @_;
895

    
896
    my $allValid = 1;
897
    foreach my $parameter (@pnames) {
898
        if (!defined($query->param($parameter)) || 
899
            ! $query->param($parameter) ||
900
            $query->param($parameter) =~ /^\s+$/) {
901
            $allValid = 0;
902
        }
903
    }
904

    
905
    return $allValid;
906
}
907

    
908
#
909
# Create a temporary account for a user and send an email with a link which can click for the
910
# verification. This is used to protect the ldap server against spams.
911
#
912
sub createTemporaryAccount {
913
    my $allParams = shift;
914
    my $org = $query->param('o'); 
915
 
916

    
917
    
918
    ################## Search LDAP for matching o or ou that already exist
919
    my $orgAuthBase = $ldapConfig->{$org}{'base'};; 
920
    my $filter = $ldapConfig->{$org}{'filter'};   
921
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
922
    debug("search filer " . $filter);
923
    debug("ldap server ". $ldapurl);
924
    debug("sesarch base " . $tmpSearchBase);
925
    print "Content-type: text/html\n\n";
926
    my @attrs = ['o', 'ou' ];
927
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
928
    
929
    my $ldapUsername = $ldapConfig->{$org}{'user'};
930
    my $ldapPassword = $ldapConfig->{$org}{'password'};
931
    debug("LDAP connection to $ldapurl...");    
932
    
933
     my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
934
     my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
935
     my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
936
        
937
    if(!$found) {
938
        debug("generate the subtree in the dc=tmp===========================");
939
        #need to generate the subtree o or ou
940
        my $dn;
941
        #if main ldap server is down, a html file containing warning message will be returned
942
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
943
        if ($ldap) {
944
            $ldap->start_tls( verify => 'none');
945
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
946
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
947
            my $additions;
948
            if($organization eq 'ou') {
949
                $additions = [ 
950
                    $organization   => $organizationName,
951
                    'objectclass' => ['top', 'organizationalUnit']
952
                    ];
953
            
954
            } else {
955
                $additions = [ 
956
                    $organization   => $organizationName,
957
                    'objectclass' => ['top', 'organization']
958
                    ];
959
            
960
            } 
961
            
962
            $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
963
            # Do the insertion
964
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
965
            if ($result->code()) {
966
                fullTemplate( ['registerFailed', 'register'], { stage => "register",
967
                                                            allParams => $allParams,
968
                                                            errorMessage => $result->error });
969
                $ldap->unbind;   # take down session
970
                exist(0)
971
                # TODO SCW was included as separate errors, test this
972
                #$templateVars    = setVars({ stage => "register",
973
                #                     allParams => $allParams });
974
                #$template->process( $templates->{'register'}, $templateVars);
975
            } 
976
            $ldap->unbind;   # take down session
977
        } else {
978
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
979
                                                            allParams => $allParams,
980
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
981
            exit(0);
982
        }
983

    
984
    } 
985
    
986
    ################create an account under tmp subtree 
987
    
988
    #generate a randomstr for matching the email.
989
    my $randomStr = getRandomPassword(16);
990
    # Create a hashed version of the password
991
    my $shapass = createSeededPassHash($query->param('userPassword'));
992
    my $additions = [ 
993
                'uid'   => $query->param('uid'),
994
                'cn'   => join(" ", $query->param('givenName'), 
995
                                    $query->param('sn')),
996
                'sn'   => $query->param('sn'),
997
                'givenName'   => $query->param('givenName'),
998
                'mail' => $query->param('mail'),
999
                'userPassword' => $shapass,
1000
                'employeeNumber' => $randomStr,
1001
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1002
                                'inetOrgPerson', 'uidObject' ],
1003
                $organization   => $organizationName
1004
                ];
1005
    if (defined($query->param('telephoneNumber')) && 
1006
                $query->param('telephoneNumber') &&
1007
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1008
                $$additions[$#$additions + 1] = 'telephoneNumber';
1009
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1010
    }
1011
    if (defined($query->param('title')) && 
1012
                $query->param('title') &&
1013
                ! $query->param('title') =~ /^\s+$/) {
1014
                $$additions[$#$additions + 1] = 'title';
1015
                $$additions[$#$additions + 1] = $query->param('title');
1016
    }
1017

    
1018
    
1019
    #$$additions[$#$additions + 1] = 'o';
1020
    #$$additions[$#$additions + 1] = $org;
1021
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1022
    my $tmp = 1;
1023
    createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1024
    
1025
    
1026
    ####################send the verification email to the user
1027
    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.
1028
    
1029
    my $mailhost = $properties->getProperty('email.mailhost');
1030
    my $sender;
1031
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1032
    debug("the sender is " . $sender);
1033
    my $recipient = $query->param('mail');
1034
    # Send the email message to them
1035
    my $smtp = Net::SMTP->new($mailhost) or do {  
1036
                                                  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 " . 
1037
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1038
                                                  exit(0);
1039
                                               };
1040
    $smtp->mail($sender);
1041
    $smtp->to($recipient);
1042

    
1043
    my $message = <<"     ENDOFMESSAGE";
1044
    To: $recipient
1045
    From: $sender
1046
    Subject: Activate the New KNB Account
1047
        
1048
    Somebody (hopefully you) registered a KNB account.  
1049
    Please click the following link to activate your account.
1050
    If the link doesn't work, please copy the link to your browser:
1051
    
1052
    $link
1053

    
1054
    Thanks,
1055
        The KNB Development Team
1056
    
1057
     ENDOFMESSAGE
1058
     $message =~ s/^[ \t\r\f]+//gm;
1059
    
1060
     $smtp->data($message);
1061
     $smtp->quit;
1062
    debug("the link is " . $link);
1063
    fullTemplate( ['success'] );
1064
    
1065
}
1066

    
1067
#
1068
# Bind to LDAP and create a new account using the information provided
1069
# by the user
1070
#
1071
sub createAccount2 {
1072
    my $dn = shift;
1073
    my $ldapUsername = shift;
1074
    my $ldapPassword = shift;
1075
    my $additions = shift;
1076
    my $temp = shift; #if it is for a temporary account.
1077
    my $allParams = shift;
1078
    
1079
    my @failureTemplate;
1080
    if($temp){
1081
        @failureTemplate = ['registerFailed', 'register'];
1082
    } else {
1083
        @failureTemplate = ['registerFailed'];
1084
    }
1085
    print "Content-type: text/html\n\n";
1086
    debug("the dn is " . $dn);
1087
    debug("LDAP connection to $ldapurl...");    
1088
    #if main ldap server is down, a html file containing warning message will be returned
1089
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1090
    if ($ldap) {
1091
            $ldap->start_tls( verify => 'none');
1092
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1093
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1094
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1095
            if ($result->code()) {
1096
                fullTemplate(@failureTemplate, { stage => "register",
1097
                                                            allParams => $allParams,
1098
                                                            errorMessage => $result->error });
1099
                # TODO SCW was included as separate errors, test this
1100
                #$templateVars    = setVars({ stage => "register",
1101
                #                     allParams => $allParams });
1102
                #$template->process( $templates->{'register'}, $templateVars);
1103
            } else {
1104
                #fullTemplate( ['success'] );
1105
            }
1106
            $ldap->unbind;   # take down session
1107
            
1108
    } else {   
1109
         fullTemplate(@failureTemplate, { stage => "register",
1110
                                                            allParams => $allParams,
1111
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1112
         exit(0);
1113
    }
1114
  
1115
}
1116

    
1117
#
1118
# Bind to LDAP and create a new account using the information provided
1119
# by the user
1120
#
1121
sub createAccount {
1122
    my $allParams = shift;
1123

    
1124
    if ($query->param('o') =~ "LTER") {
1125
        fullTemplate( ['registerLter'] );
1126
    } else {
1127

    
1128
        # Be sure the passwords match
1129
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
1130
            my $errorMessage = "The passwords do not match. Try again.";
1131
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
1132
                                                            allParams => $allParams,
1133
                                                            errorMessage => $errorMessage });
1134
            exit();
1135
        }
1136

    
1137
        my $o = $query->param('o');
1138

    
1139
        my $searchBase = $ldapConfig->{$o}{'base'};
1140
        my $dnBase = $ldapConfig->{$o}{'dn'};
1141
        debug("the dn is " . $dnBase);
1142
        my $ldapUsername = $ldapConfig->{$o}{'user'};
1143
        my $ldapPassword = $ldapConfig->{$o}{'password'};
1144
        debug("LDAP connection to $ldapurl...");    
1145
        #if main ldap server is down, a html file containing warning message will be returned
1146
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1147
        
1148
        if ($ldap) {
1149
        	$ldap->start_tls( verify => 'none');
1150
        	debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1151
        	$ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1152
        
1153
        	my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
1154
        	debug("Inserting new entry for: $dn");
1155

    
1156
        	# Create a hashed version of the password
1157
        	my $shapass = createSeededPassHash($query->param('userPassword'));
1158

    
1159
        	# Do the insertion
1160
        	my $additions = [ 
1161
                'uid'   => $query->param('uid'),
1162
                'o'   => $query->param('o'),
1163
                'cn'   => join(" ", $query->param('givenName'), 
1164
                                    $query->param('sn')),
1165
                'sn'   => $query->param('sn'),
1166
                'givenName'   => $query->param('givenName'),
1167
                'mail' => $query->param('mail'),
1168
                'userPassword' => $shapass,
1169
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1170
                                'inetOrgPerson', 'uidObject' ]
1171
            	];
1172
        	if (defined($query->param('telephoneNumber')) && 
1173
            	$query->param('telephoneNumber') &&
1174
            	! $query->param('telephoneNumber') =~ /^\s+$/) {
1175
            	$$additions[$#$additions + 1] = 'telephoneNumber';
1176
            	$$additions[$#$additions + 1] = $query->param('telephoneNumber');
1177
        	}
1178
        	if (defined($query->param('title')) && 
1179
            	$query->param('title') &&
1180
            	! $query->param('title') =~ /^\s+$/) {
1181
            	$$additions[$#$additions + 1] = 'title';
1182
            	$$additions[$#$additions + 1] = $query->param('title');
1183
        	}
1184
        	my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
1185
    
1186
        	if ($result->code()) {
1187
            	fullTemplate( ['registerFailed', 'register'], { stage => "register",
1188
                                                            allParams => $allParams,
1189
                                                            errorMessage => $result->error });
1190
            	# TODO SCW was included as separate errors, test this
1191
           	 	#$templateVars    = setVars({ stage => "register",
1192
           	 	#                     allParams => $allParams });
1193
            	#$template->process( $templates->{'register'}, $templateVars);
1194
        	} else {
1195
            	fullTemplate( ['success'] );
1196
        	}
1197

    
1198
        	$ldap->unbind;   # take down session
1199
        }
1200
    }
1201
}
1202

    
1203
#
1204
# This subroutine will handle a email verification:
1205
# If the hash string matches the one store in the ldap, the account will be
1206
# copied from the temporary space to the permanent tree and the account in 
1207
# the temporary space will be removed.
1208
sub handleEmailVerification {
1209

    
1210
    my $cfg = $query->param('cfg');
1211
    my $dn = $query->param('dn');
1212
    my $hash = $query->param('hash');
1213
    my $org = $query->param('o');
1214
    my $uid = $query->param('uid');
1215
    
1216
    my $ldapUsername;
1217
    my $ldapPassword;
1218
    #my $orgAuthBase;
1219

    
1220
    $ldapUsername = $ldapConfig->{$org}{'user'};
1221
    $ldapPassword = $ldapConfig->{$org}{'password'};
1222
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1223
    
1224
    debug("LDAP connection to $ldapurl...");    
1225
    
1226

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

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

    
1281
}
1282

    
1283
sub handleResponseMessage {
1284

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

    
1293
#
1294
# perform a simple search against the LDAP database using 
1295
# a small subset of attributes of each dn and return it
1296
# as a table to the calling browser.
1297
#
1298
sub handleSimpleSearch {
1299

    
1300
    my $o = $query->param('o');
1301

    
1302
    my $ldapurl = $ldapConfig->{$o}{'url'};
1303
    my $searchBase = $ldapConfig->{$o}{'base'};
1304

    
1305
    print "Content-type: text/html\n\n";
1306

    
1307
    my $allParams = { 
1308
                      'cn' => $query->param('cn'),
1309
                      'sn' => $query->param('sn'),
1310
                      'gn' => $query->param('gn'),
1311
                      'o'  => $query->param('o'),
1312
                      'facsimiletelephonenumber' 
1313
                      => $query->param('facsimiletelephonenumber'),
1314
                      'mail' => $query->param('cmail'),
1315
                      'telephonenumber' => $query->param('telephonenumber'),
1316
                      'title' => $query->param('title'),
1317
                      'uid' => $query->param('uid'),
1318
                      'ou' => $query->param('ou'),
1319
                    };
1320

    
1321
    # Search LDAP for matching entries that already exist
1322
    my $filter = "(" . 
1323
                 $query->param('searchField') . "=" .
1324
                 "*" .
1325
                 $query->param('searchValue') .
1326
                 "*" .
1327
                 ")";
1328

    
1329
    my @attrs = [ 'sn', 
1330
                  'gn', 
1331
                  'cn', 
1332
                  'o', 
1333
                  'facsimiletelephonenumber', 
1334
                  'mail', 
1335
                  'telephoneNumber', 
1336
                  'title', 
1337
                  'uid', 
1338
                  'labeledURI', 
1339
                  'ou' ];
1340

    
1341
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1342

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

    
1351
      fullTemplate( ('searchResults'), { stage => "searchresults",
1352
                                         allParams => $allParams,
1353
                                         foundAccounts => $found });
1354
    }
1355

    
1356
    exit();
1357
}
1358

    
1359
#
1360
# search the LDAP directory to see if a similar account already exists
1361
#
1362
sub searchDirectory {
1363
    my $ldapurl = shift;
1364
    my $base = shift;
1365
    my $filter = shift;
1366
    my $attref = shift;
1367

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

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

    
1423
sub debug {
1424
    my $msg = shift;
1425
    
1426
    if ($debug) {
1427
        print STDERR "LDAPweb: $msg\n";
1428
    }
1429
}
1430

    
1431
sub handleLDAPBindFailure {
1432
    my $ldapAttemptUrl = shift;
1433
    my $primaryLdap =  $properties->getProperty('auth.url');
1434

    
1435
    if ($ldapAttemptUrl eq  $primaryLdap) {
1436
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1437
    } else {
1438
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1439
    }
1440
}
1441

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