Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8197

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-13 15:01:49 -0700 (Fri, 13 Sep 2013) $'
8
# '$Revision: 8197 $' 
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
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
187
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
188
# pull out properties available e.g. 'name', 'base'
189
my @orgData = keys(%$orgProps);
190

    
191
my @orgList;
192
while (my ($oKey, $oVal) = each(%$orgNames)) {
193
    push(@orgList, $oKey);
194
}
195

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

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

    
210
    # set default base
211
    if (!$ldapConfig->{$o}{'base'}) {
212
        $ldapConfig->{$o}{'base'} = $authBase;
213
    }
214

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

    
244
    if (!$ldapConfig->{$o}{'password'}) {
245
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
246
    }
247
}
248

    
249
#--------------------------------------------------------------------------80c->
250
# Define the main program logic that calls subroutines to do the work
251
#--------------------------------------------------------------------------80c->
252

    
253
# The processing step we are handling
254
my $stage = $query->param('stage') || $templates->{'stage'};
255

    
256
my $cfg = $query->param('cfg');
257
debug("started with stage $stage, cfg $cfg");
258

    
259
# define the possible stages
260
my %stages = (
261
              'initregister'      => \&handleInitRegister,
262
              'register'          => \&handleRegister,
263
              'registerconfirmed' => \&handleRegisterConfirmed,
264
              'simplesearch'      => \&handleSimpleSearch,
265
              'initaddentry'      => \&handleInitAddEntry,
266
              'addentry'          => \&handleAddEntry,
267
              'initmodifyentry'   => \&handleInitModifyEntry,
268
              'modifyentry'       => \&handleModifyEntry,
269
              'changepass'        => \&handleChangePassword,
270
              'initchangepass'    => \&handleInitialChangePassword,
271
              'resetpass'         => \&handleResetPassword,
272
              'initresetpass'     => \&handleInitialResetPassword,
273
              'emailverification' => \&handleEmailVerification,
274
             );
275

    
276
# call the appropriate routine based on the stage
277
if ( $stages{$stage} ) {
278
  $stages{$stage}->();
279
} else {
280
  &handleResponseMessage();
281
}
282

    
283
#--------------------------------------------------------------------------80c->
284
# Define the subroutines to do the work
285
#--------------------------------------------------------------------------80c->
286

    
287
sub fullTemplate {
288
    my $templateList = shift;
289
    my $templateVars = setVars(shift);
290
    my $c = Captcha::reCAPTCHA->new;
291
    my $captcha = 'captcha';
292
    #my $error=null;
293
    my $use_ssl= 1;
294
    #my $options=null;
295
    $templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
296
    $template->process( $templates->{'header'}, $templateVars );
297
    foreach my $tmpl (@{$templateList}) {
298
        $template->process( $templates->{$tmpl}, $templateVars );
299
    }
300
    $template->process( $templates->{'footer'}, $templateVars );
301
}
302

    
303
#
304
# create the initial registration form 
305
#
306
sub handleInitRegister {
307
  my $vars = shift;
308
  print "Content-type: text/html\n\n";
309
  # process the template files:
310
  fullTemplate(['register'], {stage => "register"}); 
311
  exit();
312
}
313

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

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

    
378
    # Search LDAP for matching entries that already exist
379
    # Some forms use a single text search box, whereas others search per
380
    # attribute.
381
    my $filter;
382
    if ($query->param('searchField')) {
383

    
384
      $filter = "(|" . 
385
                "(uid=" . $query->param('searchField') . ") " .
386
                "(mail=" . $query->param('searchField') . ")" .
387
                "(&(sn=" . $query->param('searchField') . ") " . 
388
                "(givenName=" . $query->param('searchField') . "))" . 
389
                ")";
390
    } else {
391
      $filter = "(|" . 
392
                "(uid=" . $query->param('uid') . ") " .
393
                "(mail=" . $query->param('mail') . ")" .
394
                "(&(sn=" . $query->param('sn') . ") " . 
395
                "(givenName=" . $query->param('givenName') . "))" . 
396
                ")";
397
    }
398

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

    
402
    # If entries match, send back a request to confirm new-user creation
403
    if ($found) {
404
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
405
                                                     allParams => $allParams,
406
                                                     foundAccounts => $found });
407
    # Otherwise, create a new user in the LDAP directory
408
    } else {
409
        createTemporaryAccount($allParams);
410
    }
411

    
412
    exit();
413
}
414

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

    
436
#
437
# change a user's password upon request
438
#
439
sub handleChangePassword {
440

    
441
    print "Content-type: text/html\n\n";
442

    
443
    my $allParams = { 'test' => "1", };
444
    if ($query->param('uid')) {
445
        $$allParams{'uid'} = $query->param('uid');
446
    }
447
    if ($query->param('o')) {
448
        $$allParams{'o'} = $query->param('o');
449
        my $o = $query->param('o');
450
        
451
        $searchBase = $ldapConfig->{$o}{'base'};
452
    }
453

    
454

    
455
    # Check that all required fields are provided and not null
456
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
457
                           'userPassword', 'userPassword2');
458
    if (! paramsAreValid(@requiredParams)) {
459
        my $errorMessage = "Required information is missing. " .
460
            "Please fill in all required fields and submit the form.";
461
        fullTemplate( ['changePass'], { stage => "changepass",
462
                                        allParams => $allParams,
463
                                        errorMessage => $errorMessage });
464
        exit();
465
    }
466

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

    
470
        my $o = $query->param('o');
471
        $searchBase = $ldapConfig->{$o}{'base'};
472
        $ldapUsername = $ldapConfig->{$o}{'user'};
473
        $ldapPassword = $ldapConfig->{$o}{'password'};
474

    
475
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
476
        if ($query->param('o') =~ "LTER") {
477
            fullTemplate( ['registerLter'] );
478
        } else {
479
            my $errorMessage = changePassword(
480
                    $dn, $query->param('userPassword'), 
481
                    $dn, $query->param('oldpass'), $query->param('o'));
482
            if ($errorMessage) {
483
                fullTemplate( ['changePass'], { stage => "changepass",
484
                                                allParams => $allParams,
485
                                                errorMessage => $errorMessage });
486
                exit();
487
            } else {
488
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
489
                                                       allParams => $allParams });
490
                exit();
491
            }
492
        }
493
    } else {
494
        my $errorMessage = "The passwords do not match. Try again.";
495
        fullTemplate( ['changePass'], { stage => "changepass",
496
                                        allParams => $allParams,
497
                                        errorMessage => $errorMessage });
498
        exit();
499
    }
500
}
501

    
502
#
503
# change a user's password upon request - no input params
504
# only display chagepass template without any error
505
#
506
sub handleInitialChangePassword {
507
    print "Content-type: text/html\n\n";
508

    
509
    my $allParams = { 'test' => "1", };
510
    my $errorMessage = "";
511
    fullTemplate( ['changePass'], { stage => "changepass",
512
                                    errorMessage => $errorMessage });
513
    exit();
514
}
515

    
516
#
517
# reset a user's password upon request
518
#
519
sub handleResetPassword {
520

    
521
    print "Content-type: text/html\n\n";
522

    
523
    my $allParams = { 'test' => "1", };
524
    if ($query->param('uid')) {
525
        $$allParams{'uid'} = $query->param('uid');
526
    }
527
    if ($query->param('o')) {
528
        $$allParams{'o'} = $query->param('o');
529
        my $o = $query->param('o');
530
        
531
        $searchBase = $ldapConfig->{$o}{'base'};
532
        $ldapUsername = $ldapConfig->{$o}{'user'};
533
        $ldapPassword = $ldapConfig->{$o}{'password'};
534
    }
535

    
536
    # Check that all required fields are provided and not null
537
    my @requiredParams = ( 'uid', 'o' );
538
    if (! paramsAreValid(@requiredParams)) {
539
        my $errorMessage = "Required information is missing. " .
540
            "Please fill in all required fields and submit the form.";
541
        fullTemplate( ['resetPass'],  { stage => "resetpass",
542
                                        allParams => $allParams,
543
                                        errorMessage => $errorMessage });
544
        exit();
545
    }
546

    
547
    # We have all of the info we need, so try to change the password
548
    my $o = $query->param('o');
549
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
550
    debug("handleResetPassword: dn: $dn");
551
    if ($query->param('o') =~ "LTER") {
552
        fullTemplate( ['registerLter'] );
553
        exit();
554
    } else {
555
        my $errorMessage = "";
556
        my $recipient;
557
        my $userPass;
558
        my $entry = getLdapEntry($ldapurl, $searchBase, 
559
                $query->param('uid'), $query->param('o'));
560

    
561
        if ($entry) {
562
            $recipient = $entry->get_value('mail');
563
            $userPass = getRandomPassword();
564
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
565
        } else {
566
            $errorMessage = "User not found in database.  Please try again.";
567
        }
568

    
569
        if ($errorMessage) {
570
            fullTemplate( ['resetPass'], { stage => "resetpass",
571
                                           allParams => $allParams,
572
                                           errorMessage => $errorMessage });
573
            exit();
574
        } else {
575
            my $errorMessage = sendPasswordNotification($query->param('uid'),
576
                    $query->param('o'), $userPass, $recipient, $cfg);
577
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
578
                                                  allParams => $allParams,
579
                                                  errorMessage => $errorMessage });
580
            exit();
581
        }
582
    }
583
}
584

    
585
#
586
# reset a user's password upon request- no initial params
587
# only display resetpass template without any error
588
#
589
sub handleInitialResetPassword {
590
    print "Content-type: text/html\n\n";
591
    my $errorMessage = "";
592
    fullTemplate( ['resetPass'], { stage => "resetpass",
593
                                   errorMessage => $errorMessage });
594
    exit();
595
}
596

    
597
#
598
# Construct a random string to use for a newly reset password
599
#
600
sub getRandomPassword {
601
    my $length = shift;
602
    if (!$length) {
603
        $length = 8;
604
    }
605
    my $newPass = "";
606

    
607
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
608
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
609
    return $newPass;
610
}
611

    
612
#
613
# Change a password to a new value, binding as the provided user
614
#
615
sub changePassword {
616
    my $userDN = shift;
617
    my $userPass = shift;
618
    my $bindDN = shift;
619
    my $bindPass = shift;
620
    my $o = shift;
621

    
622
    my $searchBase = $ldapConfig->{$o}{'base'};
623

    
624
    my $errorMessage = 0;
625
    my $ldap;
626

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

    
643
    	# Find the user here and change their entry
644
    	my $newpass = createSeededPassHash($userPass);
645
    	my $modifications = { userPassword => $newpass };
646
      debug("changePass: setting password for $userDN to $newpass");
647
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
648
    
649
    	if ($result->code()) {
650
            debug("changePass: error changing password: " . $result->error);
651
        	$errorMessage = "There was an error changing the password:" .
652
                           "<br />\n" . $result->error;
653
    	} 
654
    	$ldap->unbind;   # take down session
655
    }
656

    
657
    return $errorMessage;
658
}
659

    
660
#
661
# generate a Seeded SHA1 hash of a plaintext password
662
#
663
sub createSeededPassHash {
664
    my $secret = shift;
665

    
666
    my $salt = "";
667
    for (my $i=0; $i < 4; $i++) {
668
        $salt .= int(rand(10));
669
    }
670

    
671
    my $ctx = Digest::SHA1->new;
672
    $ctx->add($secret);
673
    $ctx->add($salt);
674
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
675

    
676
    return $hashedPasswd;
677
}
678

    
679
#
680
# Look up an ldap entry for a user
681
#
682
sub getLdapEntry {
683
    my $ldapurl = shift;
684
    my $base = shift;
685
    my $username = shift;
686
    my $org = shift;
687

    
688
    my $entry = "";
689
    my $mesg;
690
    my $ldap;
691
    debug("ldap server: $ldapurl");
692

    
693
    #if main ldap server is down, a html file containing warning message will be returned
694
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
695
    
696
    if ($ldap) {
697
    	$ldap->start_tls( verify => 'none');
698
    	my $bindresult = $ldap->bind;
699
    	if ($bindresult->code) {
700
        	return $entry;
701
    	}
702

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

    
736
# 
737
# send an email message notifying the user of the pw change
738
#
739
sub sendPasswordNotification {
740
    my $username = shift;
741
    my $org = shift;
742
    my $newPass = shift;
743
    my $recipient = shift;
744
    my $cfg = shift;
745

    
746
    my $errorMessage = "";
747
    if ($recipient) {
748
        my $mailhost = $properties->getProperty('email.mailhost');
749
        my $sender;
750
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
751
        # Send the email message to them
752
        my $smtp = Net::SMTP->new($mailhost);
753
        $smtp->mail($sender);
754
        $smtp->to($recipient);
755

    
756
        my $message = <<"        ENDOFMESSAGE";
757
        To: $recipient
758
        From: $sender
759
        Subject: KNB Password Reset
760
        
761
        Somebody (hopefully you) requested that your KNB password be reset.  
762
        This is generally done when somebody forgets their password.  Your 
763
        password can be changed by visiting the following URL:
764

    
765
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
766

    
767
            Username: $username
768
        Organization: $org
769
        New Password: $newPass
770

    
771
        Thanks,
772
            The KNB Development Team
773
    
774
        ENDOFMESSAGE
775
        $message =~ s/^[ \t\r\f]+//gm;
776
    
777
        $smtp->data($message);
778
        $smtp->quit;
779
    } else {
780
        $errorMessage = "Failed to send password because I " .
781
                        "couldn't find a valid email address.";
782
    }
783
    return $errorMessage;
784
}
785

    
786
#
787
# search the LDAP directory to see if a similar account already exists
788
#
789
sub findExistingAccounts {
790
    my $ldapurl = shift;
791
    my $base = shift;
792
    my $filter = shift;
793
    my $attref = shift;
794
    my $ldap;
795
    my $mesg;
796

    
797
    my $foundAccounts = 0;
798

    
799
    #if main ldap server is down, a html file containing warning message will be returned
800
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
801
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
802
    if ($ldap) {
803
    	$ldap->start_tls( verify => 'none');
804
    	$ldap->bind( version => 3, anonymous => 1);
805
		$mesg = $ldap->search (
806
			base   => $base,
807
			filter => $filter,
808
			attrs => @$attref,
809
		);
810

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

    
833
    	# Follow references
834
    	my @references = $mesg->references();
835
    	for (my $i = 0; $i <= $#references; $i++) {
836
        	my $uri = URI->new($references[$i]);
837
        	my $host = $uri->host();
838
        	my $path = $uri->path();
839
        	$path =~ s/^\///;
840
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
841
        	if ($refFound) {
842
            	$foundAccounts .= $refFound;
843
        	}
844
    	}
845
    }
846

    
847
    #print "<p>Checking referrals...</p>\n";
848
    #my @referrals = $mesg->referrals();
849
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
850
    #for (my $i = 0; $i <= $#referrals; $i++) {
851
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
852
    #}
853

    
854
    return $foundAccounts;
855
}
856

    
857
#
858
# Validate that we have the proper set of input parameters
859
#
860
sub paramsAreValid {
861
    my @pnames = @_;
862

    
863
    my $allValid = 1;
864
    foreach my $parameter (@pnames) {
865
        if (!defined($query->param($parameter)) || 
866
            ! $query->param($parameter) ||
867
            $query->param($parameter) =~ /^\s+$/) {
868
            $allValid = 0;
869
        }
870
    }
871

    
872
    return $allValid;
873
}
874

    
875
#
876
# Create a temporary account for a user and send an email with a link which can click for the
877
# verification. This is used to protect the ldap server against spams.
878
#
879
sub createTemporaryAccount {
880
    my $allParams = shift;
881
    my $org = $query->param('o'); 
882
    my $ou = $query->param('ou');
883

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

    
957
    } 
958
    
959
    ################create an account under tmp subtree 
960
    
961
    #generate a randomstr for matching the email.
962
    my $randomStr = getRandomPassword(16);
963
    # Create a hashed version of the password
964
    my $shapass = createSeededPassHash($query->param('userPassword'));
965
    my $additions = [ 
966
                'uid'   => $query->param('uid'),
967
                'cn'   => join(" ", $query->param('givenName'), 
968
                                    $query->param('sn')),
969
                'sn'   => $query->param('sn'),
970
                'givenName'   => $query->param('givenName'),
971
                'mail' => $query->param('mail'),
972
                'userPassword' => $shapass,
973
                'employeeNumber' => $randomStr,
974
                'objectclass' => ['top', 'person', 'organizationalPerson', 
975
                                'inetOrgPerson', 'uidObject' ]
976
                ];
977
    if (defined($query->param('telephoneNumber')) && 
978
                $query->param('telephoneNumber') &&
979
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
980
                $$additions[$#$additions + 1] = 'telephoneNumber';
981
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
982
    }
983
    if (defined($query->param('title')) && 
984
                $query->param('title') &&
985
                ! $query->param('title') =~ /^\s+$/) {
986
                $$additions[$#$additions + 1] = 'title';
987
                $$additions[$#$additions + 1] = $query->param('title');
988
    }
989
    my $dn;
990
    my $orgStr;
991
    if($org) {
992
        $$additions[$#$additions + 1] = 'o';
993
        $$additions[$#$additions + 1] = $org;
994
        $dn='uid=' . $query->param('uid') . ',' . 'o=' . $org . ',' . $tmpSearchBase;
995
        $orgStr='o=' . $org;
996
    } else {
997
        $$additions[$#$additions + 1] = 'ou';
998
        $$additions[$#$additions + 1] = $ou;
999
        $dn='uid=' . $query->param('uid') . ',' . 'ou=' . $ou . ',' . $tmpSearchBase;
1000
        $orgStr='ou=' . $ou;
1001
    }
1002
    my $tmp = 1;
1003
    createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1004
    
1005
    
1006
    ####################send the verification email to the user
1007
    my $link = $contextUrl. '/cgi-bin/ldapweb.cgi?cfg=' . $skinName . '&' . 'stage=' . $emailVerification . '&' . 'dn=' . $dn . '&' . 'hash=' . $randomStr . '&' . $orgStr . '&uid=' . $query->param('uid');
1008
    
1009
    my $mailhost = $properties->getProperty('email.mailhost');
1010
    my $sender;
1011
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1012
    debug("the sender is " . $sender);
1013
    my $recipient = $query->param('mail');
1014
    # Send the email message to them
1015
    my $smtp = Net::SMTP->new($mailhost) or do {  
1016
                                                  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 " . 
1017
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1018
                                                  exit(0);
1019
                                               };
1020
    $smtp->mail($sender);
1021
    $smtp->to($recipient);
1022

    
1023
    my $message = <<"     ENDOFMESSAGE";
1024
    To: $recipient
1025
    From: $sender
1026
    Subject: Activate the New KNB Account
1027
        
1028
    Somebody (hopefully you) registered a KNB account.  
1029
    Please click the following link to activate your account.
1030
    If the link doesn't work, please copy the link to your browser:
1031
    
1032
    $link
1033

    
1034
    Thanks,
1035
        The KNB Development Team
1036
    
1037
     ENDOFMESSAGE
1038
     $message =~ s/^[ \t\r\f]+//gm;
1039
    
1040
     $smtp->data($message);
1041
     $smtp->quit;
1042
    debug("the link is " . $link);
1043
    fullTemplate( ['success'] );
1044
    
1045
}
1046

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

    
1097
#
1098
# Bind to LDAP and create a new account using the information provided
1099
# by the user
1100
#
1101
sub createAccount {
1102
    my $allParams = shift;
1103

    
1104
    if ($query->param('o') =~ "LTER") {
1105
        fullTemplate( ['registerLter'] );
1106
    } else {
1107

    
1108
        # Be sure the passwords match
1109
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
1110
            my $errorMessage = "The passwords do not match. Try again.";
1111
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
1112
                                                            allParams => $allParams,
1113
                                                            errorMessage => $errorMessage });
1114
            exit();
1115
        }
1116

    
1117
        my $o = $query->param('o');
1118

    
1119
        my $searchBase = $ldapConfig->{$o}{'base'};
1120
        my $dnBase = $ldapConfig->{$o}{'dn'};
1121
        debug("the dn is " . $dnBase);
1122
        my $ldapUsername = $ldapConfig->{$o}{'user'};
1123
        my $ldapPassword = $ldapConfig->{$o}{'password'};
1124
        debug("LDAP connection to $ldapurl...");    
1125
        #if main ldap server is down, a html file containing warning message will be returned
1126
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1127
        
1128
        if ($ldap) {
1129
        	$ldap->start_tls( verify => 'none');
1130
        	debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1131
        	$ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1132
        
1133
        	my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
1134
        	debug("Inserting new entry for: $dn");
1135

    
1136
        	# Create a hashed version of the password
1137
        	my $shapass = createSeededPassHash($query->param('userPassword'));
1138

    
1139
        	# Do the insertion
1140
        	my $additions = [ 
1141
                'uid'   => $query->param('uid'),
1142
                'o'   => $query->param('o'),
1143
                'cn'   => join(" ", $query->param('givenName'), 
1144
                                    $query->param('sn')),
1145
                'sn'   => $query->param('sn'),
1146
                'givenName'   => $query->param('givenName'),
1147
                'mail' => $query->param('mail'),
1148
                'userPassword' => $shapass,
1149
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1150
                                'inetOrgPerson', 'uidObject' ]
1151
            	];
1152
        	if (defined($query->param('telephoneNumber')) && 
1153
            	$query->param('telephoneNumber') &&
1154
            	! $query->param('telephoneNumber') =~ /^\s+$/) {
1155
            	$$additions[$#$additions + 1] = 'telephoneNumber';
1156
            	$$additions[$#$additions + 1] = $query->param('telephoneNumber');
1157
        	}
1158
        	if (defined($query->param('title')) && 
1159
            	$query->param('title') &&
1160
            	! $query->param('title') =~ /^\s+$/) {
1161
            	$$additions[$#$additions + 1] = 'title';
1162
            	$$additions[$#$additions + 1] = $query->param('title');
1163
        	}
1164
        	my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
1165
    
1166
        	if ($result->code()) {
1167
            	fullTemplate( ['registerFailed', 'register'], { stage => "register",
1168
                                                            allParams => $allParams,
1169
                                                            errorMessage => $result->error });
1170
            	# TODO SCW was included as separate errors, test this
1171
           	 	#$templateVars    = setVars({ stage => "register",
1172
           	 	#                     allParams => $allParams });
1173
            	#$template->process( $templates->{'register'}, $templateVars);
1174
        	} else {
1175
            	fullTemplate( ['success'] );
1176
        	}
1177

    
1178
        	$ldap->unbind;   # take down session
1179
        }
1180
    }
1181
}
1182

    
1183
#
1184
# This subroutine will handle a email verification:
1185
# If the hash string matches the one store in the ldap, the account will be
1186
# copied from the temporary space to the permanent tree and the account in 
1187
# the temporary space will be removed.
1188
sub handleEmailVerification {
1189

    
1190
    my $cfg = $query->param('cfg');
1191
    my $dn = $query->param('dn');
1192
    my $hash = $query->param('hash');
1193
    my $org = $query->param('o');
1194
    my $ou = $query->param('ou');
1195
    my $uid = $query->param('uid');
1196
    
1197
    my $orgAttributeName;
1198
    my $ldapUsername;
1199
    my $ldapPassword;
1200
    my $ldaporg;
1201
    my $orgAuthBase;
1202
    if($org) {
1203
        $ldapUsername = $ldapConfig->{$org}{'user'};
1204
        $ldapPassword = $ldapConfig->{$org}{'password'};
1205
        $orgAttributeName = 'o';
1206
        $ldaporg = $org;
1207
        $orgAuthBase = $ldapConfig->{$org}{'base'};
1208
    } else {
1209
        $ldapUsername = $ldapConfig->{$ou}{'user'};
1210
        $ldapPassword = $ldapConfig->{$ou}{'password'};
1211
        $orgAttributeName = 'ou';
1212
        $ldaporg = $ou;
1213
        $orgAuthBase = $ldapConfig->{$org}{'base'};
1214
    }
1215
    debug("LDAP connection to $ldapurl...");    
1216
    
1217

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

    
1271
}
1272

    
1273
sub handleResponseMessage {
1274

    
1275
  print "Content-type: text/html\n\n";
1276
  my $errorMessage = "You provided invalid input to the script. " .
1277
                     "Try again please.";
1278
  fullTemplate( [], { stage => $templates->{'stage'},
1279
                      errorMessage => $errorMessage });
1280
  exit();
1281
}
1282

    
1283
#
1284
# perform a simple search against the LDAP database using 
1285
# a small subset of attributes of each dn and return it
1286
# as a table to the calling browser.
1287
#
1288
sub handleSimpleSearch {
1289

    
1290
    my $o = $query->param('o');
1291

    
1292
    my $ldapurl = $ldapConfig->{$o}{'url'};
1293
    my $searchBase = $ldapConfig->{$o}{'base'};
1294

    
1295
    print "Content-type: text/html\n\n";
1296

    
1297
    my $allParams = { 
1298
                      'cn' => $query->param('cn'),
1299
                      'sn' => $query->param('sn'),
1300
                      'gn' => $query->param('gn'),
1301
                      'o'  => $query->param('o'),
1302
                      'facsimiletelephonenumber' 
1303
                      => $query->param('facsimiletelephonenumber'),
1304
                      'mail' => $query->param('cmail'),
1305
                      'telephonenumber' => $query->param('telephonenumber'),
1306
                      'title' => $query->param('title'),
1307
                      'uid' => $query->param('uid'),
1308
                      'ou' => $query->param('ou'),
1309
                    };
1310

    
1311
    # Search LDAP for matching entries that already exist
1312
    my $filter = "(" . 
1313
                 $query->param('searchField') . "=" .
1314
                 "*" .
1315
                 $query->param('searchValue') .
1316
                 "*" .
1317
                 ")";
1318

    
1319
    my @attrs = [ 'sn', 
1320
                  'gn', 
1321
                  'cn', 
1322
                  'o', 
1323
                  'facsimiletelephonenumber', 
1324
                  'mail', 
1325
                  'telephoneNumber', 
1326
                  'title', 
1327
                  'uid', 
1328
                  'labeledURI', 
1329
                  'ou' ];
1330

    
1331
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1332

    
1333
    # Send back the search results
1334
    if ($found) {
1335
      fullTemplate( ('searchResults'), { stage => "searchresults",
1336
                                         allParams => $allParams,
1337
                                         foundAccounts => $found });
1338
    } else {
1339
      $found = "No entries matched your criteria.  Please try again\n";
1340

    
1341
      fullTemplate( ('searchResults'), { stage => "searchresults",
1342
                                         allParams => $allParams,
1343
                                         foundAccounts => $found });
1344
    }
1345

    
1346
    exit();
1347
}
1348

    
1349
#
1350
# search the LDAP directory to see if a similar account already exists
1351
#
1352
sub searchDirectory {
1353
    my $ldapurl = shift;
1354
    my $base = shift;
1355
    my $filter = shift;
1356
    my $attref = shift;
1357

    
1358
	my $mesg;
1359
    my $foundAccounts = 0;
1360
    
1361
    #if ldap server is down, a html file containing warning message will be returned
1362
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1363
    
1364
    if ($ldap) {
1365
    	$ldap->start_tls( verify => 'none');
1366
    	$ldap->bind( version => 3, anonymous => 1);
1367
    	my $mesg = $ldap->search (
1368
        	base   => $base,
1369
        	filter => $filter,
1370
        	attrs => @$attref,
1371
    	);
1372

    
1373
    	if ($mesg->count() > 0) {
1374
        	$foundAccounts = "";
1375
        	my $entry;
1376
        	foreach $entry ($mesg->sorted(['sn'])) {
1377
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1378
          		$foundAccounts .= "<a href=\"" unless 
1379
                    (!$entry->get_value('labeledURI'));
1380
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1381
                    (!$entry->get_value('labeledURI'));
1382
          		$foundAccounts .= "\">\n" unless 
1383
                    (!$entry->get_value('labeledURI'));
1384
          		$foundAccounts .= $entry->get_value('givenName');
1385
          		$foundAccounts .= "</a>\n" unless 
1386
                    (!$entry->get_value('labeledURI'));
1387
          		$foundAccounts .= "\n</td>\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('sn');
1395
          		$foundAccounts .= "</a>\n";
1396
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1397
          		$foundAccounts .= $entry->get_value('mail');
1398
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1399
          		$foundAccounts .= $entry->get_value('telephonenumber');
1400
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1401
          		$foundAccounts .= $entry->get_value('title');
1402
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1403
          		$foundAccounts .= $entry->get_value('ou');
1404
          		$foundAccounts .= "\n</td>\n";
1405
          		$foundAccounts .= "</tr>\n";
1406
        	}
1407
    	}
1408
    	$ldap->unbind;   # take down session
1409
    }
1410
    return $foundAccounts;
1411
}
1412

    
1413
sub debug {
1414
    my $msg = shift;
1415
    
1416
    if ($debug) {
1417
        print STDERR "LDAPweb: $msg\n";
1418
    }
1419
}
1420

    
1421
sub handleLDAPBindFailure {
1422
    my $ldapAttemptUrl = shift;
1423
    my $primaryLdap =  $properties->getProperty('auth.url');
1424

    
1425
    if ($ldapAttemptUrl eq  $primaryLdap) {
1426
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1427
    } else {
1428
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1429
    }
1430
}
1431

    
1432
sub handleGeneralServerFailure {
1433
    my $errorMessage = shift;
1434
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1435
    exit(0);   
1436
   }
1437
    
1438
sub setVars {
1439
    my $paramVars = shift;
1440
    # initialize default parameters 
1441
    my $templateVars = { cfg => $cfg,
1442
                         styleSkinsPath => $contextUrl . "/style/skins",
1443
                         styleCommonPath => $contextUrl . "/style/common",
1444
                         contextUrl => $contextUrl,
1445
                         cgiPrefix => $cgiPrefix,
1446
                         orgList => \@orgList,
1447
                         config  => $config,
1448
    };
1449
    
1450
    # append customized params
1451
    while (my ($k, $v) = each (%$paramVars)) {
1452
        $templateVars->{$k} = $v;
1453
    }
1454
    
1455
    return $templateVars;
1456
} 
1457