Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8180

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-10 17:58:41 -0700 (Tue, 10 Sep 2013) $'
8
# '$Revision: 8180 $' 
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
# Import all of the HTML form fields as variables
89
import_names('FORM');
90

    
91
# Must have a config to use Metacat
92
my $skinName = "";
93
if ($FORM::cfg) {
94
    $skinName = $FORM::cfg;
95
} elsif ($ARGV[0]) {
96
    $skinName = $ARGV[0];
97
} else {
98
    debug("No configuration set.");
99
    print "Content-type: text/html\n\n";
100
    print 'LDAPweb Error: The registry requires a skin name to continue.';
101
    exit();
102
}
103

    
104
# Metacat isn't initialized, the registry will fail in strange ways.
105
if (!($metacatUrl)) {
106
    debug("No Metacat.");
107
    print "Content-type: text/html\n\n";
108
    'Registry Error: Metacat is not initialized! Make sure' .
109
        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';
110
    exit();
111
}
112

    
113
my $skinProperties = new Config::Properties();
114
if (!($skinName)) {
115
    $error = "Application misconfigured.  Please contact the administrator.";
116
    push(@errorMessages, $error);
117
} else {
118
    my $skinProps = "$skinsDir/$skinName/$skinName.properties";
119
    unless (open (SKIN_PROPERTIES, $skinProps)) {
120
        print "Content-type: text/html\n\n";
121
        print "Unable to locate skin properties at $skinProps.  Is this path correct?";
122
        exit(0);
123
    }
124
    $skinProperties->load(*SKIN_PROPERTIES);
125
}
126

    
127
my $config = $skinProperties->splitToTree(qr/\./, 'registry.config');
128

    
129
# XXX HACK: this is a temporary fix to pull out the UCNRS password property from the
130
#           NRS skin instead of metacat.properties. The intent is to prevent editing
131
#           of our core properties file, which is manipulated purely through the web.
132
#           Once organizations are editable, this section should be removed as should
133
#           the properties within nrs/nrs.properties.
134
my $nrsProperties = new Config::Properties();
135
my $nrsProps = "$skinsDir/nrs/nrs.properties";
136
unless (open (NRS_PROPERTIES, $nrsProps)) {
137
    print "Content-type: text/html\n\n";
138
    print "Unable to locate skin properties at $nrsProps.  Is this path correct?";
139
    exit(0);
140
}
141
$nrsProperties->load(*NRS_PROPERTIES);
142

    
143
my $nrsConfig = $nrsProperties->splitToTree(qr/\./, 'registry.config');
144

    
145
# XXX END HACK
146

    
147

    
148
my $searchBase;
149
my $ldapUsername;
150
my $ldapPassword;
151
# TODO: when should we use surl instead? Is there a setting promoting one over the other?
152
# TODO: the default tree for accounts should be exposed somewhere, defaulting to unaffiliated
153
my $ldapurl = $properties->getProperty('auth.url');
154

    
155
# Java uses miliseconds, Perl expects whole seconds
156
my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;
157

    
158
# Get the CGI input variables
159
my $query = new CGI;
160
my $debug = 1;
161

    
162
#--------------------------------------------------------------------------80c->
163
# Set up the Template Toolkit to read html form templates
164

    
165
# templates hash, imported from ldap.templates tree in metacat.properties
166
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
167
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
168
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
169

    
170
# set some configuration options for the template object
171
my $ttConfig = {
172
             INCLUDE_PATH => $templatesDir,
173
             INTERPOLATE  => 0,
174
             POST_CHOMP   => 1,
175
             DEBUG        => 1, 
176
             };
177

    
178
# create an instance of the template
179
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
180

    
181
# custom LDAP properties hash
182
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
183

    
184
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
185
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
186
# pull out properties available e.g. 'name', 'base'
187
my @orgData = keys(%$orgProps);
188

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

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

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

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

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

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

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

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

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

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

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

    
280
#--------------------------------------------------------------------------80c->
281
# Define the subroutines to do the work
282
#--------------------------------------------------------------------------80c->
283

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

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

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

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

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

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

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

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

    
402
    exit();
403
}
404

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

    
426
#
427
# change a user's password upon request
428
#
429
sub handleChangePassword {
430

    
431
    print "Content-type: text/html\n\n";
432

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

    
444

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

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

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

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

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

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

    
506
#
507
# reset a user's password upon request
508
#
509
sub handleResetPassword {
510

    
511
    print "Content-type: text/html\n\n";
512

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

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

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

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

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

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

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

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

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

    
612
    my $searchBase = $ldapConfig->{$o}{'base'};
613

    
614
    my $errorMessage = 0;
615
    my $ldap;
616

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

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

    
647
    return $errorMessage;
648
}
649

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

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

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

    
666
    return $hashedPasswd;
667
}
668

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

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

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

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

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

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

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

    
754
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
755

    
756
            Username: $username
757
        Organization: $org
758
        New Password: $newPass
759

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

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

    
786
    my $foundAccounts = 0;
787

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

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

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

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

    
843
    return $foundAccounts;
844
}
845

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

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

    
861
    return $allValid;
862
}
863

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

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

    
1003
#
1004
# Bind to LDAP and create a new account using the information provided
1005
# by the user
1006
#
1007
sub createAccount2 {
1008
    my $dn = shift;
1009
    my $ldapUsername = shift;
1010
    my $ldapPassword = shift;
1011
    my $additions = shift;
1012
    my $temp = shift; #if it is for a temporary account.
1013
    my $allParams = shift;
1014
    
1015
    my @failureTemplate;
1016
    if($temp){
1017
        @failureTemplate = ['registerFailed', 'register'];
1018
    } else {
1019
        @failureTemplate = ['registerFailed'];
1020
    }
1021
    print "Content-type: text/html\n\n";
1022
    debug("the dn is " . $dn);
1023
    debug("LDAP connection to $ldapurl...");    
1024
    #if main ldap server is down, a html file containing warning message will be returned
1025
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1026
    if ($ldap) {
1027
            $ldap->start_tls( verify => 'none');
1028
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1029
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1030
            debug(" 1 here is the additions " . $additions); 
1031
            debug(" 2 here is the additions " . @$additions);
1032
            debug(" 3 here is the additions " . [@$additions]);  
1033
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1034
            if ($result->code()) {
1035
                fullTemplate(@failureTemplate, { stage => "register",
1036
                                                            allParams => $allParams,
1037
                                                            errorMessage => $result->error });
1038
                # TODO SCW was included as separate errors, test this
1039
                #$templateVars    = setVars({ stage => "register",
1040
                #                     allParams => $allParams });
1041
                #$template->process( $templates->{'register'}, $templateVars);
1042
            } else {
1043
                fullTemplate( ['success'] );
1044
            }
1045
            $ldap->unbind;   # take down session
1046
            
1047
    } else {   
1048
         fullTemplate(@failureTemplate, { stage => "register",
1049
                                                            allParams => $allParams,
1050
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1051
         exit(0);
1052
    }
1053
  
1054
}
1055

    
1056
#
1057
# Bind to LDAP and create a new account using the information provided
1058
# by the user
1059
#
1060
sub createAccount {
1061
    my $allParams = shift;
1062

    
1063
    if ($query->param('o') =~ "LTER") {
1064
        fullTemplate( ['registerLter'] );
1065
    } else {
1066

    
1067
        # Be sure the passwords match
1068
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
1069
            my $errorMessage = "The passwords do not match. Try again.";
1070
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
1071
                                                            allParams => $allParams,
1072
                                                            errorMessage => $errorMessage });
1073
            exit();
1074
        }
1075

    
1076
        my $o = $query->param('o');
1077

    
1078
        my $searchBase = $ldapConfig->{$o}{'base'};
1079
        my $dnBase = $ldapConfig->{$o}{'dn'};
1080
        debug("the dn is " . $dnBase);
1081
        my $ldapUsername = $ldapConfig->{$o}{'user'};
1082
        my $ldapPassword = $ldapConfig->{$o}{'password'};
1083
        debug("LDAP connection to $ldapurl...");    
1084
        #if main ldap server is down, a html file containing warning message will be returned
1085
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1086
        
1087
        if ($ldap) {
1088
        	$ldap->start_tls( verify => 'none');
1089
        	debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1090
        	$ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1091
        
1092
        	my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
1093
        	debug("Inserting new entry for: $dn");
1094

    
1095
        	# Create a hashed version of the password
1096
        	my $shapass = createSeededPassHash($query->param('userPassword'));
1097

    
1098
        	# Do the insertion
1099
        	my $additions = [ 
1100
                'uid'   => $query->param('uid'),
1101
                'o'   => $query->param('o'),
1102
                'cn'   => join(" ", $query->param('givenName'), 
1103
                                    $query->param('sn')),
1104
                'sn'   => $query->param('sn'),
1105
                'givenName'   => $query->param('givenName'),
1106
                'mail' => $query->param('mail'),
1107
                'userPassword' => $shapass,
1108
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1109
                                'inetOrgPerson', 'uidObject' ]
1110
            	];
1111
        	if (defined($query->param('telephoneNumber')) && 
1112
            	$query->param('telephoneNumber') &&
1113
            	! $query->param('telephoneNumber') =~ /^\s+$/) {
1114
            	$$additions[$#$additions + 1] = 'telephoneNumber';
1115
            	$$additions[$#$additions + 1] = $query->param('telephoneNumber');
1116
        	}
1117
        	if (defined($query->param('title')) && 
1118
            	$query->param('title') &&
1119
            	! $query->param('title') =~ /^\s+$/) {
1120
            	$$additions[$#$additions + 1] = 'title';
1121
            	$$additions[$#$additions + 1] = $query->param('title');
1122
        	}
1123
        	my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
1124
    
1125
        	if ($result->code()) {
1126
            	fullTemplate( ['registerFailed', 'register'], { stage => "register",
1127
                                                            allParams => $allParams,
1128
                                                            errorMessage => $result->error });
1129
            	# TODO SCW was included as separate errors, test this
1130
           	 	#$templateVars    = setVars({ stage => "register",
1131
           	 	#                     allParams => $allParams });
1132
            	#$template->process( $templates->{'register'}, $templateVars);
1133
        	} else {
1134
            	fullTemplate( ['success'] );
1135
        	}
1136

    
1137
        	$ldap->unbind;   # take down session
1138
        }
1139
    }
1140
}
1141

    
1142
sub handleResponseMessage {
1143

    
1144
  print "Content-type: text/html\n\n";
1145
  my $errorMessage = "You provided invalid input to the script. " .
1146
                     "Try again please.";
1147
  fullTemplate( [], { stage => $templates->{'stage'},
1148
                      errorMessage => $errorMessage });
1149
  exit();
1150
}
1151

    
1152
#
1153
# perform a simple search against the LDAP database using 
1154
# a small subset of attributes of each dn and return it
1155
# as a table to the calling browser.
1156
#
1157
sub handleSimpleSearch {
1158

    
1159
    my $o = $query->param('o');
1160

    
1161
    my $ldapurl = $ldapConfig->{$o}{'url'};
1162
    my $searchBase = $ldapConfig->{$o}{'base'};
1163

    
1164
    print "Content-type: text/html\n\n";
1165

    
1166
    my $allParams = { 
1167
                      'cn' => $query->param('cn'),
1168
                      'sn' => $query->param('sn'),
1169
                      'gn' => $query->param('gn'),
1170
                      'o'  => $query->param('o'),
1171
                      'facsimiletelephonenumber' 
1172
                      => $query->param('facsimiletelephonenumber'),
1173
                      'mail' => $query->param('cmail'),
1174
                      'telephonenumber' => $query->param('telephonenumber'),
1175
                      'title' => $query->param('title'),
1176
                      'uid' => $query->param('uid'),
1177
                      'ou' => $query->param('ou'),
1178
                    };
1179

    
1180
    # Search LDAP for matching entries that already exist
1181
    my $filter = "(" . 
1182
                 $query->param('searchField') . "=" .
1183
                 "*" .
1184
                 $query->param('searchValue') .
1185
                 "*" .
1186
                 ")";
1187

    
1188
    my @attrs = [ 'sn', 
1189
                  'gn', 
1190
                  'cn', 
1191
                  'o', 
1192
                  'facsimiletelephonenumber', 
1193
                  'mail', 
1194
                  'telephoneNumber', 
1195
                  'title', 
1196
                  'uid', 
1197
                  'labeledURI', 
1198
                  'ou' ];
1199

    
1200
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1201

    
1202
    # Send back the search results
1203
    if ($found) {
1204
      fullTemplate( ('searchResults'), { stage => "searchresults",
1205
                                         allParams => $allParams,
1206
                                         foundAccounts => $found });
1207
    } else {
1208
      $found = "No entries matched your criteria.  Please try again\n";
1209

    
1210
      fullTemplate( ('searchResults'), { stage => "searchresults",
1211
                                         allParams => $allParams,
1212
                                         foundAccounts => $found });
1213
    }
1214

    
1215
    exit();
1216
}
1217

    
1218
#
1219
# search the LDAP directory to see if a similar account already exists
1220
#
1221
sub searchDirectory {
1222
    my $ldapurl = shift;
1223
    my $base = shift;
1224
    my $filter = shift;
1225
    my $attref = shift;
1226

    
1227
	my $mesg;
1228
    my $foundAccounts = 0;
1229
    
1230
    #if ldap server is down, a html file containing warning message will be returned
1231
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1232
    
1233
    if ($ldap) {
1234
    	$ldap->start_tls( verify => 'none');
1235
    	$ldap->bind( version => 3, anonymous => 1);
1236
    	my $mesg = $ldap->search (
1237
        	base   => $base,
1238
        	filter => $filter,
1239
        	attrs => @$attref,
1240
    	);
1241

    
1242
    	if ($mesg->count() > 0) {
1243
        	$foundAccounts = "";
1244
        	my $entry;
1245
        	foreach $entry ($mesg->sorted(['sn'])) {
1246
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1247
          		$foundAccounts .= "<a href=\"" unless 
1248
                    (!$entry->get_value('labeledURI'));
1249
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1250
                    (!$entry->get_value('labeledURI'));
1251
          		$foundAccounts .= "\">\n" unless 
1252
                    (!$entry->get_value('labeledURI'));
1253
          		$foundAccounts .= $entry->get_value('givenName');
1254
          		$foundAccounts .= "</a>\n" unless 
1255
                    (!$entry->get_value('labeledURI'));
1256
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1257
          		$foundAccounts .= "<a href=\"" unless 
1258
                    (!$entry->get_value('labeledURI'));
1259
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1260
                    (!$entry->get_value('labeledURI'));
1261
          		$foundAccounts .= "\">\n" unless 
1262
                    (!$entry->get_value('labeledURI'));
1263
          		$foundAccounts .= $entry->get_value('sn');
1264
          		$foundAccounts .= "</a>\n";
1265
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1266
          		$foundAccounts .= $entry->get_value('mail');
1267
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1268
          		$foundAccounts .= $entry->get_value('telephonenumber');
1269
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1270
          		$foundAccounts .= $entry->get_value('title');
1271
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1272
          		$foundAccounts .= $entry->get_value('ou');
1273
          		$foundAccounts .= "\n</td>\n";
1274
          		$foundAccounts .= "</tr>\n";
1275
        	}
1276
    	}
1277
    	$ldap->unbind;   # take down session
1278
    }
1279
    return $foundAccounts;
1280
}
1281

    
1282
sub debug {
1283
    my $msg = shift;
1284
    
1285
    if ($debug) {
1286
        print STDERR "LDAPweb: $msg\n";
1287
    }
1288
}
1289

    
1290
sub handleLDAPBindFailure {
1291
    my $ldapAttemptUrl = shift;
1292
    my $primaryLdap =  $properties->getProperty('auth.url');
1293

    
1294
    if ($ldapAttemptUrl eq  $primaryLdap) {
1295
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1296
    } else {
1297
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1298
    }
1299
}
1300

    
1301
sub handleGeneralServerFailure {
1302
    my $errorMessage = shift;
1303
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1304
    exit(0);   
1305
   }
1306
    
1307
sub setVars {
1308
    my $paramVars = shift;
1309
    # initialize default parameters 
1310
    my $templateVars = { cfg => $cfg,
1311
                         styleSkinsPath => $contextUrl . "/style/skins",
1312
                         styleCommonPath => $contextUrl . "/style/common",
1313
                         contextUrl => $contextUrl,
1314
                         cgiPrefix => $cgiPrefix,
1315
                         orgList => \@orgList,
1316
                         config  => $config,
1317
    };
1318
    
1319
    # append customized params
1320
    while (my ($k, $v) = each (%$paramVars)) {
1321
        $templateVars->{$k} = $v;
1322
    }
1323
    
1324
    return $templateVars;
1325
} 
1326