Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8201

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 10:32:07 -0700 (Mon, 16 Sep 2013) $'
8
# '$Revision: 8201 $' 
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 $displayOrgList;
255
$displayOrgList = $skinProperties->getProperty("ldap.templates.organizationList") or $displayOrgList = $properties->getProperty('ldap.templates.organizationList');
256

    
257

    
258
#--------------------------------------------------------------------------80c->
259
# Define the main program logic that calls subroutines to do the work
260
#--------------------------------------------------------------------------80c->
261

    
262
# The processing step we are handling
263
my $stage = $query->param('stage') || $templates->{'stage'};
264

    
265
my $cfg = $query->param('cfg');
266
debug("started with stage $stage, cfg $cfg");
267

    
268
# define the possible stages
269
my %stages = (
270
              'initregister'      => \&handleInitRegister,
271
              'register'          => \&handleRegister,
272
              'registerconfirmed' => \&handleRegisterConfirmed,
273
              'simplesearch'      => \&handleSimpleSearch,
274
              'initaddentry'      => \&handleInitAddEntry,
275
              'addentry'          => \&handleAddEntry,
276
              'initmodifyentry'   => \&handleInitModifyEntry,
277
              'modifyentry'       => \&handleModifyEntry,
278
              'changepass'        => \&handleChangePassword,
279
              'initchangepass'    => \&handleInitialChangePassword,
280
              'resetpass'         => \&handleResetPassword,
281
              'initresetpass'     => \&handleInitialResetPassword,
282
              'emailverification' => \&handleEmailVerification,
283
             );
284

    
285
# call the appropriate routine based on the stage
286
if ( $stages{$stage} ) {
287
  $stages{$stage}->();
288
} else {
289
  &handleResponseMessage();
290
}
291

    
292
#--------------------------------------------------------------------------80c->
293
# Define the subroutines to do the work
294
#--------------------------------------------------------------------------80c->
295

    
296
sub fullTemplate {
297
    my $templateList = shift;
298
    my $templateVars = setVars(shift);
299
    my $c = Captcha::reCAPTCHA->new;
300
    my $captcha = 'captcha';
301
    #my $error=null;
302
    my $use_ssl= 1;
303
    #my $options=null;
304
    $templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
305
    $template->process( $templates->{'header'}, $templateVars );
306
    foreach my $tmpl (@{$templateList}) {
307
        $template->process( $templates->{$tmpl}, $templateVars );
308
    }
309
    $template->process( $templates->{'footer'}, $templateVars );
310
}
311

    
312
#
313
# create the initial registration form 
314
#
315
sub handleInitRegister {
316
  my $vars = shift;
317
  print "Content-type: text/html\n\n";
318
  # process the template files:
319
  fullTemplate(['register'], {stage => "register"}); 
320
  exit();
321
}
322

    
323
#
324
# process input from the register stage, which occurs when
325
# a user submits form data to create a new account
326
#
327
sub handleRegister {
328
    
329
    print "Content-type: text/html\n\n";
330
    
331
    
332
    my $allParams = { 'givenName' => $query->param('givenName'), 
333
                      'sn' => $query->param('sn'),
334
                      'o' => $query->param('o'), 
335
                      'mail' => $query->param('mail'), 
336
                      'uid' => $query->param('uid'), 
337
                      'userPassword' => $query->param('userPassword'), 
338
                      'userPassword2' => $query->param('userPassword2'), 
339
                      'title' => $query->param('title'), 
340
                      'telephoneNumber' => $query->param('telephoneNumber') };
341
    
342
    # Check the recaptcha
343
    my $c = Captcha::reCAPTCHA->new;
344
    my $challenge = $query->param('recaptcha_challenge_field');
345
    my $response = $query->param('recaptcha_response_field');
346
    # Verify submission
347
    my $result = $c->check_answer(
348
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
349
        $challenge, $response
350
    );
351

    
352
    if ( $result->{is_valid} ) {
353
        #print "Yes!";
354
        #exit();
355
    }
356
    else {
357
        my $errorMessage = "The verification code is wrong. Please input again.";
358
        fullTemplate(['register'], { stage => "register",
359
                                     allParams => $allParams,
360
                                     errorMessage => $errorMessage });
361
        exit();
362
    }
363
    
364
    
365
    # Check that all required fields are provided and not null
366
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
367
                           'uid', 'userPassword', 'userPassword2');
368
    if (! paramsAreValid(@requiredParams)) {
369
        my $errorMessage = "Required information is missing. " .
370
            "Please fill in all required fields and resubmit the form.";
371
        fullTemplate(['register'], { stage => "register",
372
                                     allParams => $allParams,
373
                                     errorMessage => $errorMessage });
374
        exit();
375
    } else {
376
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
377
            my $errorMessage = "The passwords do not match. Try again.";
378
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
379
                                                            allParams => $allParams,
380
                                                            errorMessage => $errorMessage });
381
            exit();
382
        }
383
        my $o = $query->param('o');    
384
        $searchBase = $ldapConfig->{$o}{'base'};  
385
    }
386

    
387
    # Search LDAP for matching entries that already exist
388
    # Some forms use a single text search box, whereas others search per
389
    # attribute.
390
    my $filter;
391
    if ($query->param('searchField')) {
392

    
393
      $filter = "(|" . 
394
                "(uid=" . $query->param('searchField') . ") " .
395
                "(mail=" . $query->param('searchField') . ")" .
396
                "(&(sn=" . $query->param('searchField') . ") " . 
397
                "(givenName=" . $query->param('searchField') . "))" . 
398
                ")";
399
    } else {
400
      $filter = "(|" . 
401
                "(uid=" . $query->param('uid') . ") " .
402
                "(mail=" . $query->param('mail') . ")" .
403
                "(&(sn=" . $query->param('sn') . ") " . 
404
                "(givenName=" . $query->param('givenName') . "))" . 
405
                ")";
406
    }
407

    
408
    my @attrs = [ 'uid', 'o', 'cn', 'mail', 'telephoneNumber', 'title' ];
409
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
410

    
411
    # If entries match, send back a request to confirm new-user creation
412
    if ($found) {
413
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
414
                                                     allParams => $allParams,
415
                                                     foundAccounts => $found });
416
    # Otherwise, create a new user in the LDAP directory
417
    } else {
418
        createTemporaryAccount($allParams);
419
    }
420

    
421
    exit();
422
}
423

    
424
#
425
# process input from the registerconfirmed stage, which occurs when
426
# a user chooses to create an account despite similarities to other
427
# existing accounts
428
#
429
sub handleRegisterConfirmed {
430
  
431
    my $allParams = { 'givenName' => $query->param('givenName'), 
432
                      'sn' => $query->param('sn'),
433
                      'o' => 'unaffiliated', # only accept unaffiliated registration
434
                      'mail' => $query->param('mail'), 
435
                      'uid' => $query->param('uid'), 
436
                      'userPassword' => $query->param('userPassword'), 
437
                      'userPassword2' => $query->param('userPassword2'), 
438
                      'title' => $query->param('title'), 
439
                      'telephoneNumber' => $query->param('telephoneNumber') };
440
    print "Content-type: text/html\n\n";
441
    createTemporaryAccount($allParams);
442
    exit();
443
}
444

    
445
#
446
# change a user's password upon request
447
#
448
sub handleChangePassword {
449

    
450
    print "Content-type: text/html\n\n";
451

    
452
    my $allParams = { 'test' => "1", };
453
    if ($query->param('uid')) {
454
        $$allParams{'uid'} = $query->param('uid');
455
    }
456
    if ($query->param('o')) {
457
        $$allParams{'o'} = $query->param('o');
458
        my $o = $query->param('o');
459
        
460
        $searchBase = $ldapConfig->{$o}{'base'};
461
    }
462

    
463

    
464
    # Check that all required fields are provided and not null
465
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
466
                           'userPassword', 'userPassword2');
467
    if (! paramsAreValid(@requiredParams)) {
468
        my $errorMessage = "Required information is missing. " .
469
            "Please fill in all required fields and submit the form.";
470
        fullTemplate( ['changePass'], { stage => "changepass",
471
                                        allParams => $allParams,
472
                                        errorMessage => $errorMessage });
473
        exit();
474
    }
475

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

    
479
        my $o = $query->param('o');
480
        $searchBase = $ldapConfig->{$o}{'base'};
481
        $ldapUsername = $ldapConfig->{$o}{'user'};
482
        $ldapPassword = $ldapConfig->{$o}{'password'};
483

    
484
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
485
        if ($query->param('o') =~ "LTER") {
486
            fullTemplate( ['registerLter'] );
487
        } else {
488
            my $errorMessage = changePassword(
489
                    $dn, $query->param('userPassword'), 
490
                    $dn, $query->param('oldpass'), $query->param('o'));
491
            if ($errorMessage) {
492
                fullTemplate( ['changePass'], { stage => "changepass",
493
                                                allParams => $allParams,
494
                                                errorMessage => $errorMessage });
495
                exit();
496
            } else {
497
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
498
                                                       allParams => $allParams });
499
                exit();
500
            }
501
        }
502
    } else {
503
        my $errorMessage = "The passwords do not match. Try again.";
504
        fullTemplate( ['changePass'], { stage => "changepass",
505
                                        allParams => $allParams,
506
                                        errorMessage => $errorMessage });
507
        exit();
508
    }
509
}
510

    
511
#
512
# change a user's password upon request - no input params
513
# only display chagepass template without any error
514
#
515
sub handleInitialChangePassword {
516
    print "Content-type: text/html\n\n";
517

    
518
    my $allParams = { 'test' => "1", };
519
    my $errorMessage = "";
520
    fullTemplate( ['changePass'], { stage => "changepass",
521
                                    errorMessage => $errorMessage });
522
    exit();
523
}
524

    
525
#
526
# reset a user's password upon request
527
#
528
sub handleResetPassword {
529

    
530
    print "Content-type: text/html\n\n";
531

    
532
    my $allParams = { 'test' => "1", };
533
    if ($query->param('uid')) {
534
        $$allParams{'uid'} = $query->param('uid');
535
    }
536
    if ($query->param('o')) {
537
        $$allParams{'o'} = $query->param('o');
538
        my $o = $query->param('o');
539
        
540
        $searchBase = $ldapConfig->{$o}{'base'};
541
        $ldapUsername = $ldapConfig->{$o}{'user'};
542
        $ldapPassword = $ldapConfig->{$o}{'password'};
543
    }
544

    
545
    # Check that all required fields are provided and not null
546
    my @requiredParams = ( 'uid', 'o' );
547
    if (! paramsAreValid(@requiredParams)) {
548
        my $errorMessage = "Required information is missing. " .
549
            "Please fill in all required fields and submit the form.";
550
        fullTemplate( ['resetPass'],  { stage => "resetpass",
551
                                        allParams => $allParams,
552
                                        errorMessage => $errorMessage });
553
        exit();
554
    }
555

    
556
    # We have all of the info we need, so try to change the password
557
    my $o = $query->param('o');
558
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
559
    debug("handleResetPassword: dn: $dn");
560
    if ($query->param('o') =~ "LTER") {
561
        fullTemplate( ['registerLter'] );
562
        exit();
563
    } else {
564
        my $errorMessage = "";
565
        my $recipient;
566
        my $userPass;
567
        my $entry = getLdapEntry($ldapurl, $searchBase, 
568
                $query->param('uid'), $query->param('o'));
569

    
570
        if ($entry) {
571
            $recipient = $entry->get_value('mail');
572
            $userPass = getRandomPassword();
573
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
574
        } else {
575
            $errorMessage = "User not found in database.  Please try again.";
576
        }
577

    
578
        if ($errorMessage) {
579
            fullTemplate( ['resetPass'], { stage => "resetpass",
580
                                           allParams => $allParams,
581
                                           errorMessage => $errorMessage });
582
            exit();
583
        } else {
584
            my $errorMessage = sendPasswordNotification($query->param('uid'),
585
                    $query->param('o'), $userPass, $recipient, $cfg);
586
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
587
                                                  allParams => $allParams,
588
                                                  errorMessage => $errorMessage });
589
            exit();
590
        }
591
    }
592
}
593

    
594
#
595
# reset a user's password upon request- no initial params
596
# only display resetpass template without any error
597
#
598
sub handleInitialResetPassword {
599
    print "Content-type: text/html\n\n";
600
    my $errorMessage = "";
601
    fullTemplate( ['resetPass'], { stage => "resetpass",
602
                                   errorMessage => $errorMessage });
603
    exit();
604
}
605

    
606
#
607
# Construct a random string to use for a newly reset password
608
#
609
sub getRandomPassword {
610
    my $length = shift;
611
    if (!$length) {
612
        $length = 8;
613
    }
614
    my $newPass = "";
615

    
616
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
617
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
618
    return $newPass;
619
}
620

    
621
#
622
# Change a password to a new value, binding as the provided user
623
#
624
sub changePassword {
625
    my $userDN = shift;
626
    my $userPass = shift;
627
    my $bindDN = shift;
628
    my $bindPass = shift;
629
    my $o = shift;
630

    
631
    my $searchBase = $ldapConfig->{$o}{'base'};
632

    
633
    my $errorMessage = 0;
634
    my $ldap;
635

    
636
    #if main ldap server is down, a html file containing warning message will be returned
637
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
638
    
639
    if ($ldap) {
640
        #$ldap->start_tls( verify => 'require',
641
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
642
        $ldap->start_tls( verify => 'none');
643
        debug("changePassword: attempting to bind to $bindDN");
644
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
645
                                  password => $bindPass );
646
        if ($bindresult->code) {
647
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
648
                            "correct? Please correct and try again...";
649
            return $errorMessage;
650
        }
651

    
652
    	# Find the user here and change their entry
653
    	my $newpass = createSeededPassHash($userPass);
654
    	my $modifications = { userPassword => $newpass };
655
      debug("changePass: setting password for $userDN to $newpass");
656
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
657
    
658
    	if ($result->code()) {
659
            debug("changePass: error changing password: " . $result->error);
660
        	$errorMessage = "There was an error changing the password:" .
661
                           "<br />\n" . $result->error;
662
    	} 
663
    	$ldap->unbind;   # take down session
664
    }
665

    
666
    return $errorMessage;
667
}
668

    
669
#
670
# generate a Seeded SHA1 hash of a plaintext password
671
#
672
sub createSeededPassHash {
673
    my $secret = shift;
674

    
675
    my $salt = "";
676
    for (my $i=0; $i < 4; $i++) {
677
        $salt .= int(rand(10));
678
    }
679

    
680
    my $ctx = Digest::SHA1->new;
681
    $ctx->add($secret);
682
    $ctx->add($salt);
683
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
684

    
685
    return $hashedPasswd;
686
}
687

    
688
#
689
# Look up an ldap entry for a user
690
#
691
sub getLdapEntry {
692
    my $ldapurl = shift;
693
    my $base = shift;
694
    my $username = shift;
695
    my $org = shift;
696

    
697
    my $entry = "";
698
    my $mesg;
699
    my $ldap;
700
    debug("ldap server: $ldapurl");
701

    
702
    #if main ldap server is down, a html file containing warning message will be returned
703
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
704
    
705
    if ($ldap) {
706
    	$ldap->start_tls( verify => 'none');
707
    	my $bindresult = $ldap->bind;
708
    	if ($bindresult->code) {
709
        	return $entry;
710
    	}
711

    
712
    	if($ldapConfig->{$org}{'filter'}){
713
            debug("getLdapEntry: filter set, searching for base=$base, " .
714
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
715
        	$mesg = $ldap->search ( base   => $base,
716
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
717
    	} else {
718
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
719
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
720
    	}
721
    
722
    	if ($mesg->count > 0) {
723
        	$entry = $mesg->pop_entry;
724
        	$ldap->unbind;   # take down session
725
    	} else {
726
        	$ldap->unbind;   # take down session
727
        	# Follow references by recursive call to self
728
        	my @references = $mesg->references();
729
        	for (my $i = 0; $i <= $#references; $i++) {
730
            	my $uri = URI->new($references[$i]);
731
            	my $host = $uri->host();
732
            	my $path = $uri->path();
733
            	$path =~ s/^\///;
734
            	$entry = &getLdapEntry($host, $path, $username, $org);
735
            	if ($entry) {
736
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
737
                	return $entry;
738
            	}
739
        	}
740
    	}
741
    }
742
    return $entry;
743
}
744

    
745
# 
746
# send an email message notifying the user of the pw change
747
#
748
sub sendPasswordNotification {
749
    my $username = shift;
750
    my $org = shift;
751
    my $newPass = shift;
752
    my $recipient = shift;
753
    my $cfg = shift;
754

    
755
    my $errorMessage = "";
756
    if ($recipient) {
757
        my $mailhost = $properties->getProperty('email.mailhost');
758
        my $sender;
759
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
760
        # Send the email message to them
761
        my $smtp = Net::SMTP->new($mailhost);
762
        $smtp->mail($sender);
763
        $smtp->to($recipient);
764

    
765
        my $message = <<"        ENDOFMESSAGE";
766
        To: $recipient
767
        From: $sender
768
        Subject: KNB Password Reset
769
        
770
        Somebody (hopefully you) requested that your KNB password be reset.  
771
        This is generally done when somebody forgets their password.  Your 
772
        password can be changed by visiting the following URL:
773

    
774
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
775

    
776
            Username: $username
777
        Organization: $org
778
        New Password: $newPass
779

    
780
        Thanks,
781
            The KNB Development Team
782
    
783
        ENDOFMESSAGE
784
        $message =~ s/^[ \t\r\f]+//gm;
785
    
786
        $smtp->data($message);
787
        $smtp->quit;
788
    } else {
789
        $errorMessage = "Failed to send password because I " .
790
                        "couldn't find a valid email address.";
791
    }
792
    return $errorMessage;
793
}
794

    
795
#
796
# search the LDAP directory to see if a similar account already exists
797
#
798
sub findExistingAccounts {
799
    my $ldapurl = shift;
800
    my $base = shift;
801
    my $filter = shift;
802
    my $attref = shift;
803
    my $ldap;
804
    my $mesg;
805

    
806
    my $foundAccounts = 0;
807

    
808
    #if main ldap server is down, a html file containing warning message will be returned
809
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
810
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
811
    if ($ldap) {
812
    	$ldap->start_tls( verify => 'none');
813
    	$ldap->bind( version => 3, anonymous => 1);
814
		$mesg = $ldap->search (
815
			base   => $base,
816
			filter => $filter,
817
			attrs => @$attref,
818
		);
819

    
820
	    if ($mesg->count() > 0) {
821
			$foundAccounts = "";
822
			my $entry;
823
			foreach $entry ($mesg->all_entries) { 
824
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
825
                # this could be done directly with filters on the LDAP connection, instead.
826
                if ($entry->dn !~ /ou=Account/) {
827
                    $foundAccounts .= "<p>\n<b><u>Account:</u> ";
828
                    $foundAccounts .= $entry->dn();
829
                    $foundAccounts .= "</b><br />\n";
830
                    foreach my $attribute ($entry->attributes()) {
831
                        my $value = $entry->get_value($attribute);
832
                        $foundAccounts .= "$attribute: ";
833
                        $foundAccounts .= $value;
834
                        $foundAccounts .= "<br />\n";
835
                    }
836
                    $foundAccounts .= "</p>\n";
837
                }
838
			}
839
        }
840
    	$ldap->unbind;   # take down session
841

    
842
    	# Follow references
843
    	my @references = $mesg->references();
844
    	for (my $i = 0; $i <= $#references; $i++) {
845
        	my $uri = URI->new($references[$i]);
846
        	my $host = $uri->host();
847
        	my $path = $uri->path();
848
        	$path =~ s/^\///;
849
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
850
        	if ($refFound) {
851
            	$foundAccounts .= $refFound;
852
        	}
853
    	}
854
    }
855

    
856
    #print "<p>Checking referrals...</p>\n";
857
    #my @referrals = $mesg->referrals();
858
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
859
    #for (my $i = 0; $i <= $#referrals; $i++) {
860
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
861
    #}
862

    
863
    return $foundAccounts;
864
}
865

    
866
#
867
# Validate that we have the proper set of input parameters
868
#
869
sub paramsAreValid {
870
    my @pnames = @_;
871

    
872
    my $allValid = 1;
873
    foreach my $parameter (@pnames) {
874
        if (!defined($query->param($parameter)) || 
875
            ! $query->param($parameter) ||
876
            $query->param($parameter) =~ /^\s+$/) {
877
            $allValid = 0;
878
        }
879
    }
880

    
881
    return $allValid;
882
}
883

    
884
#
885
# Create a temporary account for a user and send an email with a link which can click for the
886
# verification. This is used to protect the ldap server against spams.
887
#
888
sub createTemporaryAccount {
889
    my $allParams = shift;
890
    my $org = $query->param('o'); 
891
 
892

    
893
    
894
    ################## Search LDAP for matching o or ou that already exist
895
    my $orgAuthBase = $ldapConfig->{$org}{'base'};; 
896
    my $filter = $ldapConfig->{$org}{'filter'};   
897
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
898
    debug("search filer " . $filter);
899
    debug("ldap server ". $ldapurl);
900
    debug("sesarch base " . $tmpSearchBase);
901
    print "Content-type: text/html\n\n";
902
    my @attrs = ['o', 'ou' ];
903
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
904
    
905
    my $ldapUsername = $ldapConfig->{$org}{'user'};
906
    my $ldapPassword = $ldapConfig->{$org}{'password'};
907
    debug("LDAP connection to $ldapurl...");    
908
    
909
     my @organizationInfo = split(/=/, $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
910
     my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
911
     my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
912
        
913
    if(!$found) {
914
        debug("generate the subtree in the dc=tmp===========================");
915
        #need to generate the subtree o or ou
916
        my $dn;
917
        #if main ldap server is down, a html file containing warning message will be returned
918
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
919
        if ($ldap) {
920
            $ldap->start_tls( verify => 'none');
921
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
922
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
923
            my $additions; 
924
            $additions = [ 
925
                $organization   => $organizationName,
926
                'objectclass' => ['top', 'organization']
927
                ];
928
            $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
929
            # Do the insertion
930
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
931
            if ($result->code()) {
932
                fullTemplate( ['registerFailed', 'register'], { stage => "register",
933
                                                            allParams => $allParams,
934
                                                            errorMessage => $result->error });
935
                $ldap->unbind;   # take down session
936
                exist(0)
937
                # TODO SCW was included as separate errors, test this
938
                #$templateVars    = setVars({ stage => "register",
939
                #                     allParams => $allParams });
940
                #$template->process( $templates->{'register'}, $templateVars);
941
            } 
942
            $ldap->unbind;   # take down session
943
        } else {
944
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
945
                                                            allParams => $allParams,
946
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
947
            exit(0);
948
        }
949

    
950
    } 
951
    
952
    ################create an account under tmp subtree 
953
    
954
    #generate a randomstr for matching the email.
955
    my $randomStr = getRandomPassword(16);
956
    # Create a hashed version of the password
957
    my $shapass = createSeededPassHash($query->param('userPassword'));
958
    my $additions = [ 
959
                'uid'   => $query->param('uid'),
960
                'cn'   => join(" ", $query->param('givenName'), 
961
                                    $query->param('sn')),
962
                'sn'   => $query->param('sn'),
963
                'givenName'   => $query->param('givenName'),
964
                'mail' => $query->param('mail'),
965
                'userPassword' => $shapass,
966
                'employeeNumber' => $randomStr,
967
                'objectclass' => ['top', 'person', 'organizationalPerson', 
968
                                'inetOrgPerson', 'uidObject' ],
969
                $organization   => $organizationName
970
                ];
971
    if (defined($query->param('telephoneNumber')) && 
972
                $query->param('telephoneNumber') &&
973
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
974
                $$additions[$#$additions + 1] = 'telephoneNumber';
975
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
976
    }
977
    if (defined($query->param('title')) && 
978
                $query->param('title') &&
979
                ! $query->param('title') =~ /^\s+$/) {
980
                $$additions[$#$additions + 1] = 'title';
981
                $$additions[$#$additions + 1] = $query->param('title');
982
    }
983

    
984
    
985
    #$$additions[$#$additions + 1] = 'o';
986
    #$$additions[$#$additions + 1] = $org;
987
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
988
    my $tmp = 1;
989
    createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
990
    
991
    
992
    ####################send the verification email to the user
993
    my $link = $contextUrl. '/cgi-bin/ldapweb.cgi?cfg=' . $skinName . '&' . 'stage=' . $emailVerification . '&' . 'dn=' . $dn . '&' . 'hash=' . $randomStr . '&' . $ldapConfig->{$org}{'org'} . '&uid=' . $query->param('uid');
994
    
995
    my $mailhost = $properties->getProperty('email.mailhost');
996
    my $sender;
997
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
998
    debug("the sender is " . $sender);
999
    my $recipient = $query->param('mail');
1000
    # Send the email message to them
1001
    my $smtp = Net::SMTP->new($mailhost) or do {  
1002
                                                  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 " . 
1003
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1004
                                                  exit(0);
1005
                                               };
1006
    $smtp->mail($sender);
1007
    $smtp->to($recipient);
1008

    
1009
    my $message = <<"     ENDOFMESSAGE";
1010
    To: $recipient
1011
    From: $sender
1012
    Subject: Activate the New KNB Account
1013
        
1014
    Somebody (hopefully you) registered a KNB account.  
1015
    Please click the following link to activate your account.
1016
    If the link doesn't work, please copy the link to your browser:
1017
    
1018
    $link
1019

    
1020
    Thanks,
1021
        The KNB Development Team
1022
    
1023
     ENDOFMESSAGE
1024
     $message =~ s/^[ \t\r\f]+//gm;
1025
    
1026
     $smtp->data($message);
1027
     $smtp->quit;
1028
    debug("the link is " . $link);
1029
    fullTemplate( ['success'] );
1030
    
1031
}
1032

    
1033
#
1034
# Bind to LDAP and create a new account using the information provided
1035
# by the user
1036
#
1037
sub createAccount2 {
1038
    my $dn = shift;
1039
    my $ldapUsername = shift;
1040
    my $ldapPassword = shift;
1041
    my $additions = shift;
1042
    my $temp = shift; #if it is for a temporary account.
1043
    my $allParams = shift;
1044
    
1045
    my @failureTemplate;
1046
    if($temp){
1047
        @failureTemplate = ['registerFailed', 'register'];
1048
    } else {
1049
        @failureTemplate = ['registerFailed'];
1050
    }
1051
    print "Content-type: text/html\n\n";
1052
    debug("the dn is " . $dn);
1053
    debug("LDAP connection to $ldapurl...");    
1054
    #if main ldap server is down, a html file containing warning message will be returned
1055
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1056
    if ($ldap) {
1057
            $ldap->start_tls( verify => 'none');
1058
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1059
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1060
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1061
            if ($result->code()) {
1062
                fullTemplate(@failureTemplate, { stage => "register",
1063
                                                            allParams => $allParams,
1064
                                                            errorMessage => $result->error });
1065
                # TODO SCW was included as separate errors, test this
1066
                #$templateVars    = setVars({ stage => "register",
1067
                #                     allParams => $allParams });
1068
                #$template->process( $templates->{'register'}, $templateVars);
1069
            } else {
1070
                #fullTemplate( ['success'] );
1071
            }
1072
            $ldap->unbind;   # take down session
1073
            
1074
    } else {   
1075
         fullTemplate(@failureTemplate, { stage => "register",
1076
                                                            allParams => $allParams,
1077
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1078
         exit(0);
1079
    }
1080
  
1081
}
1082

    
1083
#
1084
# Bind to LDAP and create a new account using the information provided
1085
# by the user
1086
#
1087
sub createAccount {
1088
    my $allParams = shift;
1089

    
1090
    if ($query->param('o') =~ "LTER") {
1091
        fullTemplate( ['registerLter'] );
1092
    } else {
1093

    
1094
        # Be sure the passwords match
1095
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
1096
            my $errorMessage = "The passwords do not match. Try again.";
1097
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
1098
                                                            allParams => $allParams,
1099
                                                            errorMessage => $errorMessage });
1100
            exit();
1101
        }
1102

    
1103
        my $o = $query->param('o');
1104

    
1105
        my $searchBase = $ldapConfig->{$o}{'base'};
1106
        my $dnBase = $ldapConfig->{$o}{'dn'};
1107
        debug("the dn is " . $dnBase);
1108
        my $ldapUsername = $ldapConfig->{$o}{'user'};
1109
        my $ldapPassword = $ldapConfig->{$o}{'password'};
1110
        debug("LDAP connection to $ldapurl...");    
1111
        #if main ldap server is down, a html file containing warning message will be returned
1112
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1113
        
1114
        if ($ldap) {
1115
        	$ldap->start_tls( verify => 'none');
1116
        	debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1117
        	$ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1118
        
1119
        	my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
1120
        	debug("Inserting new entry for: $dn");
1121

    
1122
        	# Create a hashed version of the password
1123
        	my $shapass = createSeededPassHash($query->param('userPassword'));
1124

    
1125
        	# Do the insertion
1126
        	my $additions = [ 
1127
                'uid'   => $query->param('uid'),
1128
                'o'   => $query->param('o'),
1129
                'cn'   => join(" ", $query->param('givenName'), 
1130
                                    $query->param('sn')),
1131
                'sn'   => $query->param('sn'),
1132
                'givenName'   => $query->param('givenName'),
1133
                'mail' => $query->param('mail'),
1134
                'userPassword' => $shapass,
1135
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1136
                                'inetOrgPerson', 'uidObject' ]
1137
            	];
1138
        	if (defined($query->param('telephoneNumber')) && 
1139
            	$query->param('telephoneNumber') &&
1140
            	! $query->param('telephoneNumber') =~ /^\s+$/) {
1141
            	$$additions[$#$additions + 1] = 'telephoneNumber';
1142
            	$$additions[$#$additions + 1] = $query->param('telephoneNumber');
1143
        	}
1144
        	if (defined($query->param('title')) && 
1145
            	$query->param('title') &&
1146
            	! $query->param('title') =~ /^\s+$/) {
1147
            	$$additions[$#$additions + 1] = 'title';
1148
            	$$additions[$#$additions + 1] = $query->param('title');
1149
        	}
1150
        	my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
1151
    
1152
        	if ($result->code()) {
1153
            	fullTemplate( ['registerFailed', 'register'], { stage => "register",
1154
                                                            allParams => $allParams,
1155
                                                            errorMessage => $result->error });
1156
            	# TODO SCW was included as separate errors, test this
1157
           	 	#$templateVars    = setVars({ stage => "register",
1158
           	 	#                     allParams => $allParams });
1159
            	#$template->process( $templates->{'register'}, $templateVars);
1160
        	} else {
1161
            	fullTemplate( ['success'] );
1162
        	}
1163

    
1164
        	$ldap->unbind;   # take down session
1165
        }
1166
    }
1167
}
1168

    
1169
#
1170
# This subroutine will handle a email verification:
1171
# If the hash string matches the one store in the ldap, the account will be
1172
# copied from the temporary space to the permanent tree and the account in 
1173
# the temporary space will be removed.
1174
sub handleEmailVerification {
1175

    
1176
    my $cfg = $query->param('cfg');
1177
    my $dn = $query->param('dn');
1178
    my $hash = $query->param('hash');
1179
    my $org = $query->param('o');
1180
    my $ou = $query->param('ou');
1181
    my $uid = $query->param('uid');
1182
    
1183
    my $orgAttributeName;
1184
    my $ldapUsername;
1185
    my $ldapPassword;
1186
    my $ldaporg;
1187
    my $orgAuthBase;
1188
    if($org) {
1189
        $ldapUsername = $ldapConfig->{$org}{'user'};
1190
        $ldapPassword = $ldapConfig->{$org}{'password'};
1191
        $orgAttributeName = 'o';
1192
        $ldaporg = $org;
1193
        $orgAuthBase = $ldapConfig->{$org}{'base'};
1194
    } else {
1195
        $ldapUsername = $ldapConfig->{$ou}{'user'};
1196
        $ldapPassword = $ldapConfig->{$ou}{'password'};
1197
        $orgAttributeName = 'ou';
1198
        $ldaporg = $ou;
1199
        $orgAuthBase = $ldapConfig->{$org}{'base'};
1200
    }
1201
    debug("LDAP connection to $ldapurl...");    
1202
    
1203

    
1204
   print "Content-type: text/html\n\n";
1205
   #if main ldap server is down, a html file containing warning message will be returned
1206
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1207
   if ($ldap) {
1208
        $ldap->start_tls( verify => 'none');
1209
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1210
        my $mesg = $ldap->search(base => $dn, scope => 'base', filter => '(objectClass=*)');
1211
        my $max = $mesg->count;
1212
        debug("the count is " . $max);
1213
        if($max < 1) {
1214
            $ldap->unbind;   # take down session
1215
            fullTemplate( ['registerFailed'], {errorMessage => "No record matched the dn " . $dn . " for the verification. You probably already verified the account."});
1216
            #handleLDAPBindFailure($ldapurl);
1217
            exit(0);
1218
        } else {
1219
            #check if the hash string match
1220
            my $entry = $mesg->entry (0);
1221
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1222
            if( $hashStrFromLdap eq $hash) {
1223
                #my $additions = [ ];
1224
                #foreach my $attr ( $entry->attributes ) {
1225
                    #if($attr ne 'employeeNumber') {
1226
                        #$$additions[$#$additions + 1] = $attr;
1227
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1228
                    #}
1229
                #}
1230
                #my $tmp=0;
1231
                #my $allParams="";
1232
                $mesg = $ldap->moddn(
1233
                            dn => $dn,
1234
                            deleteoldrdn => 1,
1235
                            newrdn => "uid=" . $uid,
1236
                            newsuperior  => $orgAttributeName . "=" . $ldaporg . "," . $orgAuthBase);
1237
                $ldap->unbind;   # take down session
1238
                if($mesg->code()) {
1239
                    fullTemplate( ['registerFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1240
                    exit(0);
1241
                } else {
1242
                    fullTemplate( ['success'] );
1243
                }
1244
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1245
            } else {
1246
                $ldap->unbind;   # take down session
1247
                fullTemplate( ['registerFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1248
                exit(0);
1249
            }
1250
            
1251
        }
1252
    } else {   
1253
        handleLDAPBindFailure($ldapurl);
1254
        exit(0);
1255
    }
1256

    
1257
}
1258

    
1259
sub handleResponseMessage {
1260

    
1261
  print "Content-type: text/html\n\n";
1262
  my $errorMessage = "You provided invalid input to the script. " .
1263
                     "Try again please.";
1264
  fullTemplate( [], { stage => $templates->{'stage'},
1265
                      errorMessage => $errorMessage });
1266
  exit();
1267
}
1268

    
1269
#
1270
# perform a simple search against the LDAP database using 
1271
# a small subset of attributes of each dn and return it
1272
# as a table to the calling browser.
1273
#
1274
sub handleSimpleSearch {
1275

    
1276
    my $o = $query->param('o');
1277

    
1278
    my $ldapurl = $ldapConfig->{$o}{'url'};
1279
    my $searchBase = $ldapConfig->{$o}{'base'};
1280

    
1281
    print "Content-type: text/html\n\n";
1282

    
1283
    my $allParams = { 
1284
                      'cn' => $query->param('cn'),
1285
                      'sn' => $query->param('sn'),
1286
                      'gn' => $query->param('gn'),
1287
                      'o'  => $query->param('o'),
1288
                      'facsimiletelephonenumber' 
1289
                      => $query->param('facsimiletelephonenumber'),
1290
                      'mail' => $query->param('cmail'),
1291
                      'telephonenumber' => $query->param('telephonenumber'),
1292
                      'title' => $query->param('title'),
1293
                      'uid' => $query->param('uid'),
1294
                      'ou' => $query->param('ou'),
1295
                    };
1296

    
1297
    # Search LDAP for matching entries that already exist
1298
    my $filter = "(" . 
1299
                 $query->param('searchField') . "=" .
1300
                 "*" .
1301
                 $query->param('searchValue') .
1302
                 "*" .
1303
                 ")";
1304

    
1305
    my @attrs = [ 'sn', 
1306
                  'gn', 
1307
                  'cn', 
1308
                  'o', 
1309
                  'facsimiletelephonenumber', 
1310
                  'mail', 
1311
                  'telephoneNumber', 
1312
                  'title', 
1313
                  'uid', 
1314
                  'labeledURI', 
1315
                  'ou' ];
1316

    
1317
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1318

    
1319
    # Send back the search results
1320
    if ($found) {
1321
      fullTemplate( ('searchResults'), { stage => "searchresults",
1322
                                         allParams => $allParams,
1323
                                         foundAccounts => $found });
1324
    } else {
1325
      $found = "No entries matched your criteria.  Please try again\n";
1326

    
1327
      fullTemplate( ('searchResults'), { stage => "searchresults",
1328
                                         allParams => $allParams,
1329
                                         foundAccounts => $found });
1330
    }
1331

    
1332
    exit();
1333
}
1334

    
1335
#
1336
# search the LDAP directory to see if a similar account already exists
1337
#
1338
sub searchDirectory {
1339
    my $ldapurl = shift;
1340
    my $base = shift;
1341
    my $filter = shift;
1342
    my $attref = shift;
1343

    
1344
	my $mesg;
1345
    my $foundAccounts = 0;
1346
    
1347
    #if ldap server is down, a html file containing warning message will be returned
1348
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1349
    
1350
    if ($ldap) {
1351
    	$ldap->start_tls( verify => 'none');
1352
    	$ldap->bind( version => 3, anonymous => 1);
1353
    	my $mesg = $ldap->search (
1354
        	base   => $base,
1355
        	filter => $filter,
1356
        	attrs => @$attref,
1357
    	);
1358

    
1359
    	if ($mesg->count() > 0) {
1360
        	$foundAccounts = "";
1361
        	my $entry;
1362
        	foreach $entry ($mesg->sorted(['sn'])) {
1363
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1364
          		$foundAccounts .= "<a href=\"" unless 
1365
                    (!$entry->get_value('labeledURI'));
1366
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1367
                    (!$entry->get_value('labeledURI'));
1368
          		$foundAccounts .= "\">\n" unless 
1369
                    (!$entry->get_value('labeledURI'));
1370
          		$foundAccounts .= $entry->get_value('givenName');
1371
          		$foundAccounts .= "</a>\n" unless 
1372
                    (!$entry->get_value('labeledURI'));
1373
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1374
          		$foundAccounts .= "<a href=\"" unless 
1375
                    (!$entry->get_value('labeledURI'));
1376
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1377
                    (!$entry->get_value('labeledURI'));
1378
          		$foundAccounts .= "\">\n" unless 
1379
                    (!$entry->get_value('labeledURI'));
1380
          		$foundAccounts .= $entry->get_value('sn');
1381
          		$foundAccounts .= "</a>\n";
1382
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1383
          		$foundAccounts .= $entry->get_value('mail');
1384
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1385
          		$foundAccounts .= $entry->get_value('telephonenumber');
1386
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1387
          		$foundAccounts .= $entry->get_value('title');
1388
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1389
          		$foundAccounts .= $entry->get_value('ou');
1390
          		$foundAccounts .= "\n</td>\n";
1391
          		$foundAccounts .= "</tr>\n";
1392
        	}
1393
    	}
1394
    	$ldap->unbind;   # take down session
1395
    }
1396
    return $foundAccounts;
1397
}
1398

    
1399
sub debug {
1400
    my $msg = shift;
1401
    
1402
    if ($debug) {
1403
        print STDERR "LDAPweb: $msg\n";
1404
    }
1405
}
1406

    
1407
sub handleLDAPBindFailure {
1408
    my $ldapAttemptUrl = shift;
1409
    my $primaryLdap =  $properties->getProperty('auth.url');
1410

    
1411
    if ($ldapAttemptUrl eq  $primaryLdap) {
1412
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1413
    } else {
1414
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1415
    }
1416
}
1417

    
1418
sub handleGeneralServerFailure {
1419
    my $errorMessage = shift;
1420
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1421
    exit(0);   
1422
   }
1423
    
1424
sub setVars {
1425
    my $paramVars = shift;
1426
    # initialize default parameters 
1427
    my $templateVars = { cfg => $cfg,
1428
                         styleSkinsPath => $contextUrl . "/style/skins",
1429
                         styleCommonPath => $contextUrl . "/style/common",
1430
                         contextUrl => $contextUrl,
1431
                         cgiPrefix => $cgiPrefix,
1432
                         orgList => \@orgList,
1433
                         config  => $config,
1434
    };
1435
    
1436
    # append customized params
1437
    while (my ($k, $v) = each (%$paramVars)) {
1438
        $templateVars->{$k} = $v;
1439
    }
1440
    
1441
    return $templateVars;
1442
} 
1443