Project

General

Profile

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-11 09:28:47 -0700 (Wed, 11 Sep 2013) $'
8
# '$Revision: 8182 $' 
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
             );
274

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

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

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

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

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

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

    
370
    # Search LDAP for matching entries that already exist
371
    # Some forms use a single text search box, whereas others search per
372
    # attribute.
373
    my $filter;
374
    if ($query->param('searchField')) {
375

    
376
      $filter = "(|" . 
377
                "(uid=" . $query->param('searchField') . ") " .
378
                "(mail=" . $query->param('searchField') . ")" .
379
                "(&(sn=" . $query->param('searchField') . ") " . 
380
                "(givenName=" . $query->param('searchField') . "))" . 
381
                ")";
382
    } else {
383
      $filter = "(|" . 
384
                "(uid=" . $query->param('uid') . ") " .
385
                "(mail=" . $query->param('mail') . ")" .
386
                "(&(sn=" . $query->param('sn') . ") " . 
387
                "(givenName=" . $query->param('givenName') . "))" . 
388
                ")";
389
    }
390

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

    
394
    # If entries match, send back a request to confirm new-user creation
395
    if ($found) {
396
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
397
                                                     allParams => $allParams,
398
                                                     foundAccounts => $found });
399
    # Otherwise, create a new user in the LDAP directory
400
    } else {
401
        createTemporaryAccount($allParams);
402
    }
403

    
404
    exit();
405
}
406

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

    
428
#
429
# change a user's password upon request
430
#
431
sub handleChangePassword {
432

    
433
    print "Content-type: text/html\n\n";
434

    
435
    my $allParams = { 'test' => "1", };
436
    if ($query->param('uid')) {
437
        $$allParams{'uid'} = $query->param('uid');
438
    }
439
    if ($query->param('o')) {
440
        $$allParams{'o'} = $query->param('o');
441
        my $o = $query->param('o');
442
        
443
        $searchBase = $ldapConfig->{$o}{'base'};
444
    }
445

    
446

    
447
    # Check that all required fields are provided and not null
448
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
449
                           'userPassword', 'userPassword2');
450
    if (! paramsAreValid(@requiredParams)) {
451
        my $errorMessage = "Required information is missing. " .
452
            "Please fill in all required fields and submit the form.";
453
        fullTemplate( ['changePass'], { stage => "changepass",
454
                                        allParams => $allParams,
455
                                        errorMessage => $errorMessage });
456
        exit();
457
    }
458

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

    
462
        my $o = $query->param('o');
463
        $searchBase = $ldapConfig->{$o}{'base'};
464
        $ldapUsername = $ldapConfig->{$o}{'user'};
465
        $ldapPassword = $ldapConfig->{$o}{'password'};
466

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

    
494
#
495
# change a user's password upon request - no input params
496
# only display chagepass template without any error
497
#
498
sub handleInitialChangePassword {
499
    print "Content-type: text/html\n\n";
500

    
501
    my $allParams = { 'test' => "1", };
502
    my $errorMessage = "";
503
    fullTemplate( ['changePass'], { stage => "changepass",
504
                                    errorMessage => $errorMessage });
505
    exit();
506
}
507

    
508
#
509
# reset a user's password upon request
510
#
511
sub handleResetPassword {
512

    
513
    print "Content-type: text/html\n\n";
514

    
515
    my $allParams = { 'test' => "1", };
516
    if ($query->param('uid')) {
517
        $$allParams{'uid'} = $query->param('uid');
518
    }
519
    if ($query->param('o')) {
520
        $$allParams{'o'} = $query->param('o');
521
        my $o = $query->param('o');
522
        
523
        $searchBase = $ldapConfig->{$o}{'base'};
524
        $ldapUsername = $ldapConfig->{$o}{'user'};
525
        $ldapPassword = $ldapConfig->{$o}{'password'};
526
    }
527

    
528
    # Check that all required fields are provided and not null
529
    my @requiredParams = ( 'uid', 'o' );
530
    if (! paramsAreValid(@requiredParams)) {
531
        my $errorMessage = "Required information is missing. " .
532
            "Please fill in all required fields and submit the form.";
533
        fullTemplate( ['resetPass'],  { stage => "resetpass",
534
                                        allParams => $allParams,
535
                                        errorMessage => $errorMessage });
536
        exit();
537
    }
538

    
539
    # We have all of the info we need, so try to change the password
540
    my $o = $query->param('o');
541
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
542
    debug("handleResetPassword: dn: $dn");
543
    if ($query->param('o') =~ "LTER") {
544
        fullTemplate( ['registerLter'] );
545
        exit();
546
    } else {
547
        my $errorMessage = "";
548
        my $recipient;
549
        my $userPass;
550
        my $entry = getLdapEntry($ldapurl, $searchBase, 
551
                $query->param('uid'), $query->param('o'));
552

    
553
        if ($entry) {
554
            $recipient = $entry->get_value('mail');
555
            $userPass = getRandomPassword();
556
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
557
        } else {
558
            $errorMessage = "User not found in database.  Please try again.";
559
        }
560

    
561
        if ($errorMessage) {
562
            fullTemplate( ['resetPass'], { stage => "resetpass",
563
                                           allParams => $allParams,
564
                                           errorMessage => $errorMessage });
565
            exit();
566
        } else {
567
            my $errorMessage = sendPasswordNotification($query->param('uid'),
568
                    $query->param('o'), $userPass, $recipient, $cfg);
569
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
570
                                                  allParams => $allParams,
571
                                                  errorMessage => $errorMessage });
572
            exit();
573
        }
574
    }
575
}
576

    
577
#
578
# reset a user's password upon request- no initial params
579
# only display resetpass template without any error
580
#
581
sub handleInitialResetPassword {
582
    print "Content-type: text/html\n\n";
583
    my $errorMessage = "";
584
    fullTemplate( ['resetPass'], { stage => "resetpass",
585
                                   errorMessage => $errorMessage });
586
    exit();
587
}
588

    
589
#
590
# Construct a random string to use for a newly reset password
591
#
592
sub getRandomPassword {
593
    my $length = shift;
594
    if (!$length) {
595
        $length = 8;
596
    }
597
    my $newPass = "";
598

    
599
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
600
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
601
    return $newPass;
602
}
603

    
604
#
605
# Change a password to a new value, binding as the provided user
606
#
607
sub changePassword {
608
    my $userDN = shift;
609
    my $userPass = shift;
610
    my $bindDN = shift;
611
    my $bindPass = shift;
612
    my $o = shift;
613

    
614
    my $searchBase = $ldapConfig->{$o}{'base'};
615

    
616
    my $errorMessage = 0;
617
    my $ldap;
618

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

    
635
    	# Find the user here and change their entry
636
    	my $newpass = createSeededPassHash($userPass);
637
    	my $modifications = { userPassword => $newpass };
638
      debug("changePass: setting password for $userDN to $newpass");
639
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
640
    
641
    	if ($result->code()) {
642
            debug("changePass: error changing password: " . $result->error);
643
        	$errorMessage = "There was an error changing the password:" .
644
                           "<br />\n" . $result->error;
645
    	} 
646
    	$ldap->unbind;   # take down session
647
    }
648

    
649
    return $errorMessage;
650
}
651

    
652
#
653
# generate a Seeded SHA1 hash of a plaintext password
654
#
655
sub createSeededPassHash {
656
    my $secret = shift;
657

    
658
    my $salt = "";
659
    for (my $i=0; $i < 4; $i++) {
660
        $salt .= int(rand(10));
661
    }
662

    
663
    my $ctx = Digest::SHA1->new;
664
    $ctx->add($secret);
665
    $ctx->add($salt);
666
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
667

    
668
    return $hashedPasswd;
669
}
670

    
671
#
672
# Look up an ldap entry for a user
673
#
674
sub getLdapEntry {
675
    my $ldapurl = shift;
676
    my $base = shift;
677
    my $username = shift;
678
    my $org = shift;
679

    
680
    my $entry = "";
681
    my $mesg;
682
    my $ldap;
683
    debug("ldap server: $ldapurl");
684

    
685
    #if main ldap server is down, a html file containing warning message will be returned
686
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
687
    
688
    if ($ldap) {
689
    	$ldap->start_tls( verify => 'none');
690
    	my $bindresult = $ldap->bind;
691
    	if ($bindresult->code) {
692
        	return $entry;
693
    	}
694

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

    
728
# 
729
# send an email message notifying the user of the pw change
730
#
731
sub sendPasswordNotification {
732
    my $username = shift;
733
    my $org = shift;
734
    my $newPass = shift;
735
    my $recipient = shift;
736
    my $cfg = shift;
737

    
738
    my $errorMessage = "";
739
    if ($recipient) {
740
        my $mailhost = $properties->getProperty('email.mailhost');
741
        my $sender =  $properties->getProperty('email.sender');
742
        # Send the email message to them
743
        my $smtp = Net::SMTP->new($mailhost);
744
        $smtp->mail($sender);
745
        $smtp->to($recipient);
746

    
747
        my $message = <<"        ENDOFMESSAGE";
748
        To: $recipient
749
        From: $sender
750
        Subject: KNB Password Reset
751
        
752
        Somebody (hopefully you) requested that your KNB password be reset.  
753
        This is generally done when somebody forgets their password.  Your 
754
        password can be changed by visiting the following URL:
755

    
756
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
757

    
758
            Username: $username
759
        Organization: $org
760
        New Password: $newPass
761

    
762
        Thanks,
763
            The KNB Development Team
764
    
765
        ENDOFMESSAGE
766
        $message =~ s/^[ \t\r\f]+//gm;
767
    
768
        $smtp->data($message);
769
        $smtp->quit;
770
    } else {
771
        $errorMessage = "Failed to send password because I " .
772
                        "couldn't find a valid email address.";
773
    }
774
    return $errorMessage;
775
}
776

    
777
#
778
# search the LDAP directory to see if a similar account already exists
779
#
780
sub findExistingAccounts {
781
    my $ldapurl = shift;
782
    my $base = shift;
783
    my $filter = shift;
784
    my $attref = shift;
785
    my $ldap;
786
    my $mesg;
787

    
788
    my $foundAccounts = 0;
789

    
790
    #if main ldap server is down, a html file containing warning message will be returned
791
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
792
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
793
    if ($ldap) {
794
    	$ldap->start_tls( verify => 'none');
795
    	$ldap->bind( version => 3, anonymous => 1);
796
		$mesg = $ldap->search (
797
			base   => $base,
798
			filter => $filter,
799
			attrs => @$attref,
800
		);
801

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

    
824
    	# Follow references
825
    	my @references = $mesg->references();
826
    	for (my $i = 0; $i <= $#references; $i++) {
827
        	my $uri = URI->new($references[$i]);
828
        	my $host = $uri->host();
829
        	my $path = $uri->path();
830
        	$path =~ s/^\///;
831
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
832
        	if ($refFound) {
833
            	$foundAccounts .= $refFound;
834
        	}
835
    	}
836
    }
837

    
838
    #print "<p>Checking referrals...</p>\n";
839
    #my @referrals = $mesg->referrals();
840
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
841
    #for (my $i = 0; $i <= $#referrals; $i++) {
842
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
843
    #}
844

    
845
    return $foundAccounts;
846
}
847

    
848
#
849
# Validate that we have the proper set of input parameters
850
#
851
sub paramsAreValid {
852
    my @pnames = @_;
853

    
854
    my $allValid = 1;
855
    foreach my $parameter (@pnames) {
856
        if (!defined($query->param($parameter)) || 
857
            ! $query->param($parameter) ||
858
            $query->param($parameter) =~ /^\s+$/) {
859
            $allValid = 0;
860
        }
861
    }
862

    
863
    return $allValid;
864
}
865

    
866
#
867
# Create a temporary account for a user and send an email with a link which can click for the
868
# verification. This is used to protect the ldap server against spams.
869
#
870
sub createTemporaryAccount {
871
    my $allParams = shift;
872
    my $org = $query->param('o'); 
873
    #my $org = 'unaffiliated';
874
    my $ou = $query->param('ou');
875
    #my $ou = 'LTER';
876
    
877
    ################## Search LDAP for matching o or ou that already exist
878
    my $tmpSearchBase = 'dc=tmp,' . $authBase; 
879
    my $filter;   
880
    if($org) {
881
        $filter = "(o" 
882
                  . "=" . $org .
883
                 ")";
884
    } else {
885
        $filter = "(ou" 
886
                  . "=" . $ou .
887
                 ")";
888
    }
889
    debug("search filer " . $filter);
890
    debug("ldap server ". $ldapurl);
891
    debug("sesarch base " . $tmpSearchBase);
892
    print "Content-type: text/html\n\n";
893
    my @attrs = ['o', 'ou' ];
894
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
895
    
896
    my $ldapUsername = $ldapConfig->{$org}{'user'};
897
    my $ldapPassword = $ldapConfig->{$org}{'password'};
898
    debug("LDAP connection to $ldapurl...");    
899
    
900
        
901
    if(!$found) {
902
        debug("generate the subtree in the dc=tmp===========================");
903
        #need to generate the subtree o or ou
904
        my $dn;
905
        #if main ldap server is down, a html file containing warning message will be returned
906
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
907
        if ($ldap) {
908
            $ldap->start_tls( verify => 'none');
909
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
910
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
911
            my $additions;
912
             if($org) {
913
                $additions = [ 
914
                'o'   => $org,
915
                'objectclass' => ['top', 'organization']
916
                ];
917
                $dn='o=' . $org . ',' . $tmpSearchBase;
918
             } else {
919
                $additions = [ 
920
                'ou'   => $ou,
921
                'objectclass' => ['top', 'organizationalUnit']
922
                ];
923
                $dn='ou=' . $ou . ',' . $tmpSearchBase;
924
             }
925
            # Do the insertion
926
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
927
            if ($result->code()) {
928
                fullTemplate( ['registerFailed', 'register'], { stage => "register",
929
                                                            allParams => $allParams,
930
                                                            errorMessage => $result->error });
931
                $ldap->unbind;   # take down session
932
                exist(0)
933
                # TODO SCW was included as separate errors, test this
934
                #$templateVars    = setVars({ stage => "register",
935
                #                     allParams => $allParams });
936
                #$template->process( $templates->{'register'}, $templateVars);
937
            } 
938
            $ldap->unbind;   # take down session
939
        } else {
940
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
941
                                                            allParams => $allParams,
942
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
943
            exit(0);
944
        }
945

    
946
    } 
947
    
948
    ################create an account under tmp subtree 
949
    
950
    #generate a randomstr for matching the email.
951
    my $randomStr = getRandomPassword(16);
952
    # Create a hashed version of the password
953
    my $shapass = createSeededPassHash($query->param('userPassword'));
954
    my $additions = [ 
955
                'uid'   => $query->param('uid'),
956
                'cn'   => join(" ", $query->param('givenName'), 
957
                                    $query->param('sn')),
958
                'sn'   => $query->param('sn'),
959
                'givenName'   => $query->param('givenName'),
960
                'mail' => $query->param('mail'),
961
                'userPassword' => $shapass,
962
                'employeeNumber' => $randomStr,
963
                'objectclass' => ['top', 'person', 'organizationalPerson', 
964
                                'inetOrgPerson', 'uidObject' ]
965
                ];
966
    if (defined($query->param('telephoneNumber')) && 
967
                $query->param('telephoneNumber') &&
968
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
969
                $$additions[$#$additions + 1] = 'telephoneNumber';
970
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
971
    }
972
    if (defined($query->param('title')) && 
973
                $query->param('title') &&
974
                ! $query->param('title') =~ /^\s+$/) {
975
                $$additions[$#$additions + 1] = 'title';
976
                $$additions[$#$additions + 1] = $query->param('title');
977
    }
978
    my $dn;
979
    if($org) {
980
        $$additions[$#$additions + 1] = 'o';
981
        $$additions[$#$additions + 1] = $org;
982
        $dn='uid=' . $query->param('uid') . ',' . 'o=' . $org . ',' . $tmpSearchBase;
983
    } else {
984
        $$additions[$#$additions + 1] = 'ou';
985
        $$additions[$#$additions + 1] = $ou;
986
        $dn='uid=' . $query->param('uid') . ',' . 'ou=' . $ou . ',' . $tmpSearchBase;
987
    }
988
    my $tmp = 1;
989
    createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
990
    
991
    
992
    ####################send the verification email to the user
993
    my $link = $contextUrl. '/cgi-bin/ldapweb.cgi?cfg=' . $skinName . '&' . 'stage=' . $emailVerification . '&' . 'dn=' . $dn . '&' . 'hash=' . $randomStr;
994
    
995
    my $mailhost = $properties->getProperty('email.mailhost');
996
    my $sender =  $properties->getProperty('email.sender');
997
    my $recipient = $query->param('mail');
998
    # Send the email message to them
999
    my $smtp = Net::SMTP->new($mailhost);
1000
    $smtp->mail($sender);
1001
    $smtp->to($recipient);
1002

    
1003
    my $message = <<"     ENDOFMESSAGE";
1004
    To: $recipient
1005
    From: $sender
1006
    Subject: KNB Password Reset
1007
        
1008
    Somebody (hopefully you) registered a KNB account.  
1009
    Please click the following link to activate your account.
1010
    If the link doesn't work, please copy the link to your browser:
1011
    
1012
    $link
1013

    
1014
    Thanks,
1015
        The KNB Development Team
1016
    
1017
     ENDOFMESSAGE
1018
     $message =~ s/^[ \t\r\f]+//gm;
1019
    
1020
     $smtp->data($message);
1021
     $smtp->quit;
1022
    debug("the link is " . $link);
1023
    fullTemplate( ['success'] );
1024
    
1025
}
1026

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

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

    
1087
    if ($query->param('o') =~ "LTER") {
1088
        fullTemplate( ['registerLter'] );
1089
    } else {
1090

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

    
1100
        my $o = $query->param('o');
1101

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

    
1119
        	# Create a hashed version of the password
1120
        	my $shapass = createSeededPassHash($query->param('userPassword'));
1121

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

    
1161
        	$ldap->unbind;   # take down session
1162
        }
1163
    }
1164
}
1165

    
1166
sub handleResponseMessage {
1167

    
1168
  print "Content-type: text/html\n\n";
1169
  my $errorMessage = "You provided invalid input to the script. " .
1170
                     "Try again please.";
1171
  fullTemplate( [], { stage => $templates->{'stage'},
1172
                      errorMessage => $errorMessage });
1173
  exit();
1174
}
1175

    
1176
#
1177
# perform a simple search against the LDAP database using 
1178
# a small subset of attributes of each dn and return it
1179
# as a table to the calling browser.
1180
#
1181
sub handleSimpleSearch {
1182

    
1183
    my $o = $query->param('o');
1184

    
1185
    my $ldapurl = $ldapConfig->{$o}{'url'};
1186
    my $searchBase = $ldapConfig->{$o}{'base'};
1187

    
1188
    print "Content-type: text/html\n\n";
1189

    
1190
    my $allParams = { 
1191
                      'cn' => $query->param('cn'),
1192
                      'sn' => $query->param('sn'),
1193
                      'gn' => $query->param('gn'),
1194
                      'o'  => $query->param('o'),
1195
                      'facsimiletelephonenumber' 
1196
                      => $query->param('facsimiletelephonenumber'),
1197
                      'mail' => $query->param('cmail'),
1198
                      'telephonenumber' => $query->param('telephonenumber'),
1199
                      'title' => $query->param('title'),
1200
                      'uid' => $query->param('uid'),
1201
                      'ou' => $query->param('ou'),
1202
                    };
1203

    
1204
    # Search LDAP for matching entries that already exist
1205
    my $filter = "(" . 
1206
                 $query->param('searchField') . "=" .
1207
                 "*" .
1208
                 $query->param('searchValue') .
1209
                 "*" .
1210
                 ")";
1211

    
1212
    my @attrs = [ 'sn', 
1213
                  'gn', 
1214
                  'cn', 
1215
                  'o', 
1216
                  'facsimiletelephonenumber', 
1217
                  'mail', 
1218
                  'telephoneNumber', 
1219
                  'title', 
1220
                  'uid', 
1221
                  'labeledURI', 
1222
                  'ou' ];
1223

    
1224
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1225

    
1226
    # Send back the search results
1227
    if ($found) {
1228
      fullTemplate( ('searchResults'), { stage => "searchresults",
1229
                                         allParams => $allParams,
1230
                                         foundAccounts => $found });
1231
    } else {
1232
      $found = "No entries matched your criteria.  Please try again\n";
1233

    
1234
      fullTemplate( ('searchResults'), { stage => "searchresults",
1235
                                         allParams => $allParams,
1236
                                         foundAccounts => $found });
1237
    }
1238

    
1239
    exit();
1240
}
1241

    
1242
#
1243
# search the LDAP directory to see if a similar account already exists
1244
#
1245
sub searchDirectory {
1246
    my $ldapurl = shift;
1247
    my $base = shift;
1248
    my $filter = shift;
1249
    my $attref = shift;
1250

    
1251
	my $mesg;
1252
    my $foundAccounts = 0;
1253
    
1254
    #if ldap server is down, a html file containing warning message will be returned
1255
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1256
    
1257
    if ($ldap) {
1258
    	$ldap->start_tls( verify => 'none');
1259
    	$ldap->bind( version => 3, anonymous => 1);
1260
    	my $mesg = $ldap->search (
1261
        	base   => $base,
1262
        	filter => $filter,
1263
        	attrs => @$attref,
1264
    	);
1265

    
1266
    	if ($mesg->count() > 0) {
1267
        	$foundAccounts = "";
1268
        	my $entry;
1269
        	foreach $entry ($mesg->sorted(['sn'])) {
1270
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1271
          		$foundAccounts .= "<a href=\"" unless 
1272
                    (!$entry->get_value('labeledURI'));
1273
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1274
                    (!$entry->get_value('labeledURI'));
1275
          		$foundAccounts .= "\">\n" unless 
1276
                    (!$entry->get_value('labeledURI'));
1277
          		$foundAccounts .= $entry->get_value('givenName');
1278
          		$foundAccounts .= "</a>\n" unless 
1279
                    (!$entry->get_value('labeledURI'));
1280
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1281
          		$foundAccounts .= "<a href=\"" unless 
1282
                    (!$entry->get_value('labeledURI'));
1283
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1284
                    (!$entry->get_value('labeledURI'));
1285
          		$foundAccounts .= "\">\n" unless 
1286
                    (!$entry->get_value('labeledURI'));
1287
          		$foundAccounts .= $entry->get_value('sn');
1288
          		$foundAccounts .= "</a>\n";
1289
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1290
          		$foundAccounts .= $entry->get_value('mail');
1291
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1292
          		$foundAccounts .= $entry->get_value('telephonenumber');
1293
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1294
          		$foundAccounts .= $entry->get_value('title');
1295
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1296
          		$foundAccounts .= $entry->get_value('ou');
1297
          		$foundAccounts .= "\n</td>\n";
1298
          		$foundAccounts .= "</tr>\n";
1299
        	}
1300
    	}
1301
    	$ldap->unbind;   # take down session
1302
    }
1303
    return $foundAccounts;
1304
}
1305

    
1306
sub debug {
1307
    my $msg = shift;
1308
    
1309
    if ($debug) {
1310
        print STDERR "LDAPweb: $msg\n";
1311
    }
1312
}
1313

    
1314
sub handleLDAPBindFailure {
1315
    my $ldapAttemptUrl = shift;
1316
    my $primaryLdap =  $properties->getProperty('auth.url');
1317

    
1318
    if ($ldapAttemptUrl eq  $primaryLdap) {
1319
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1320
    } else {
1321
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1322
    }
1323
}
1324

    
1325
sub handleGeneralServerFailure {
1326
    my $errorMessage = shift;
1327
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1328
    exit(0);   
1329
   }
1330
    
1331
sub setVars {
1332
    my $paramVars = shift;
1333
    # initialize default parameters 
1334
    my $templateVars = { cfg => $cfg,
1335
                         styleSkinsPath => $contextUrl . "/style/skins",
1336
                         styleCommonPath => $contextUrl . "/style/common",
1337
                         contextUrl => $contextUrl,
1338
                         cgiPrefix => $cgiPrefix,
1339
                         orgList => \@orgList,
1340
                         config  => $config,
1341
    };
1342
    
1343
    # append customized params
1344
    while (my ($k, $v) = each (%$paramVars)) {
1345
        $templateVars->{$k} = $v;
1346
    }
1347
    
1348
    return $templateVars;
1349
} 
1350

    
(10-10/14)