Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8191

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-12 17:12:46 -0700 (Thu, 12 Sep 2013) $'
8
# '$Revision: 8191 $' 
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 =  $properties->getProperty('email.sender');
750
        # Send the email message to them
751
        my $smtp = Net::SMTP->new($mailhost);
752
        $smtp->mail($sender);
753
        $smtp->to($recipient);
754

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

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

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

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

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

    
796
    my $foundAccounts = 0;
797

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

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

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

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

    
853
    return $foundAccounts;
854
}
855

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

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

    
871
    return $allValid;
872
}
873

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

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

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

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

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

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

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

    
1101
    if ($query->param('o') =~ "LTER") {
1102
        fullTemplate( ['registerLter'] );
1103
    } else {
1104

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

    
1114
        my $o = $query->param('o');
1115

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

    
1133
        	# Create a hashed version of the password
1134
        	my $shapass = createSeededPassHash($query->param('userPassword'));
1135

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

    
1175
        	$ldap->unbind;   # take down session
1176
        }
1177
    }
1178
}
1179

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

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

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

    
1268
}
1269

    
1270
sub handleResponseMessage {
1271

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

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

    
1287
    my $o = $query->param('o');
1288

    
1289
    my $ldapurl = $ldapConfig->{$o}{'url'};
1290
    my $searchBase = $ldapConfig->{$o}{'base'};
1291

    
1292
    print "Content-type: text/html\n\n";
1293

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

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

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

    
1328
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1329

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

    
1338
      fullTemplate( ('searchResults'), { stage => "searchresults",
1339
                                         allParams => $allParams,
1340
                                         foundAccounts => $found });
1341
    }
1342

    
1343
    exit();
1344
}
1345

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

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

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

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

    
1418
sub handleLDAPBindFailure {
1419
    my $ldapAttemptUrl = shift;
1420
    my $primaryLdap =  $properties->getProperty('auth.url');
1421

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

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