Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8220

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-17 10:36:13 -0700 (Tue, 17 Sep 2013) $'
8
# '$Revision: 8220 $' 
9
# 
10
# This program is free software; you can redistribute it and/or modify
11
# it under the terms of the GNU General Public License as published by
12
# the Free Software Foundation; either version 2 of the License, or
13
# (at your option) any later version.
14
#
15
# This program is distributed in the hope that it will be useful,
16
# but WITHOUT ANY WARRANTY; without even the implied warranty of
17
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
# GNU General Public License for more details.
19
#
20
# You should have received a copy of the GNU General Public License
21
# along with this program; if not, write to the Free Software
22
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
23
#
24

    
25
#
26
# This is a web-based application for allowing users to register a new
27
# account for Metacat access.  We currently only support LDAP even
28
# though metacat could potentially support other types of directories.
29

    
30
use lib '../WEB-INF/lib';
31
use strict;             # turn on strict syntax checking
32
use Template;           # load the template-toolkit module
33
use CGI qw/:standard :html3/; # load the CGI module 
34
use Net::LDAP;          # load the LDAP net libraries
35
use Net::SMTP;          # load the SMTP net libraries
36
use Digest::SHA1;       # for creating the password hash
37
use MIME::Base64;       # for creating the password hash
38
use URI;                # for parsing URL syntax
39
use Config::Properties; # for parsing Java .properties files
40
use File::Basename;     # for path name parsing
41
use Captcha::reCAPTCHA; # for protection against spams
42
use Cwd 'abs_path';
43

    
44
# Global configuration paramters
45
# This entire block (including skin parsing) could be pushed out to a separate .pm file
46
my $cgiUrl = $ENV{'SCRIPT_FILENAME'};
47
my $workingDirectory = dirname($cgiUrl);
48
my $metacatProps = "${workingDirectory}/../WEB-INF/metacat.properties";
49
my $properties = new Config::Properties();
50
unless (open (METACAT_PROPERTIES, $metacatProps)) {
51
    print "Content-type: text/html\n\n";
52
    print "Unable to locate Metacat properties. Working directory is set as " . 
53
        $workingDirectory .", is this correct?";
54
    exit(0);
55
}
56

    
57
$properties->load(*METACAT_PROPERTIES);
58

    
59
# local directory configuration
60
my $skinsDir = "${workingDirectory}/../style/skins";
61
my $templatesDir = abs_path("${workingDirectory}/../style/common/templates");
62
my $tempDir = $properties->getProperty('application.tempDir');
63

    
64
# url configuration
65
my $server = $properties->splitToTree(qr/\./, 'server');
66
my $protocol = 'http://';
67
if ( $properties->getProperty('server.httpPort') eq '443' ) {
68
	$protocol = 'https://';
69
}
70
my $contextUrl = $protocol . $properties->getProperty('server.name');
71
if ($properties->getProperty('server.httpPort') ne '80') {
72
        $contextUrl = $contextUrl . ':' . $properties->getProperty('server.httpPort');
73
}
74
$contextUrl = $contextUrl . '/' .  $properties->getProperty('application.context');
75

    
76
my $metacatUrl = $contextUrl . "/metacat";
77
my $cgiPrefix = "/" . $properties->getProperty('application.context') . "/cgi-bin";
78
my $styleSkinsPath = $contextUrl . "/style/skins";
79
my $styleCommonPath = $contextUrl . "/style/common";
80

    
81
#recaptcha key information
82
my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');
83
my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');
84

    
85
my @errorMessages;
86
my $error = 0;
87

    
88
my $emailVerification= 'emailverification';
89

    
90
# Import all of the HTML form fields as variables
91
import_names('FORM');
92

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

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

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

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

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

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

    
147
# XXX END HACK
148

    
149

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

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

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

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

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

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

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

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

    
186
# This is a hash which has the keys of the organization's properties 'name', 'base', 'organization'.
187
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
188

    
189
#This is a hash which has the keys of the ldap sub tree names of the organizations, such as 'NCEAS', 'LTER' and 'KU', and values are real name of the organization.
190
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
191
# pull out properties available e.g. 'name', 'base'
192
my @orgData = keys(%$orgProps);
193

    
194
my @orgList; #An array has the names (i.e, sub tree names, such as 'NCEAS', 'LTER' and 'KU')  of the all organizations in the metacat.properties. 
195
while (my ($oKey, $oVal) = each(%$orgNames)) {
196
    push(@orgList, $oKey);
197
}
198

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

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

    
213
    # set default base
214
    if (!$ldapConfig->{$o}{'base'}) {
215
        $ldapConfig->{$o}{'base'} = $authBase;
216
    }
217

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

    
248
    if (!$ldapConfig->{$o}{'password'}) {
249
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
250
    }
251
}
252

    
253
### Determine the display organization list (such as NCEAS, Account ) in the ldap template files
254
my $displayOrgListStr;
255
$displayOrgListStr = $skinProperties->getProperty("ldap.templates.organizationList") or $displayOrgListStr = $properties->getProperty('ldap.templates.organizationList');
256
debug("the string of the org from properties : " . $displayOrgListStr);
257
my @displayOrgList = split(';', $displayOrgListStr);
258

    
259
my @validDisplayOrgList; #this array contains the org list which will be shown in the templates files.
260

    
261
my %orgNamesHash = %$orgNames;
262
foreach my $element (@displayOrgList) {
263
    if(exists $orgNamesHash{$element}) {
264
         debug("push the organization " . $element . " into the dispaly array");
265
         #if the name is found in the organization part of metacat.properties, put it into the valid array
266
         push(@validDisplayOrgList, $element);
267
    } 
268
    
269
}
270

    
271
if(!@validDisplayOrgList) {
272
     my $sender;
273
     $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
274
    print "Content-type: text/html\n\n";
275
    print "The value of property ldap.templates.organizationList in " 
276
     . $skinName . ".properties file or metacat.properties file (if the property doesn't exist in the " 
277
     . $skinName . ".properties file) is invalid. Please send the information to ". $sender;
278
    exit(0);
279
}
280

    
281

    
282
#--------------------------------------------------------------------------80c->
283
# Define the main program logic that calls subroutines to do the work
284
#--------------------------------------------------------------------------80c->
285

    
286
# The processing step we are handling
287
my $stage = $query->param('stage') || $templates->{'stage'};
288

    
289
my $cfg = $query->param('cfg');
290
debug("started with stage $stage, cfg $cfg");
291

    
292
# define the possible stages
293
my %stages = (
294
              'initregister'      => \&handleInitRegister,
295
              'register'          => \&handleRegister,
296
              'registerconfirmed' => \&handleRegisterConfirmed,
297
              'simplesearch'      => \&handleSimpleSearch,
298
              'initaddentry'      => \&handleInitAddEntry,
299
              'addentry'          => \&handleAddEntry,
300
              'initmodifyentry'   => \&handleInitModifyEntry,
301
              'modifyentry'       => \&handleModifyEntry,
302
              'changepass'        => \&handleChangePassword,
303
              'initchangepass'    => \&handleInitialChangePassword,
304
              'resetpass'         => \&handleResetPassword,
305
              'initresetpass'     => \&handleInitialResetPassword,
306
              'emailverification' => \&handleEmailVerification,
307
             );
308

    
309
# call the appropriate routine based on the stage
310
if ( $stages{$stage} ) {
311
  $stages{$stage}->();
312
} else {
313
  &handleResponseMessage();
314
}
315

    
316
#--------------------------------------------------------------------------80c->
317
# Define the subroutines to do the work
318
#--------------------------------------------------------------------------80c->
319

    
320
sub fullTemplate {
321
    my $templateList = shift;
322
    my $templateVars = setVars(shift);
323
    my $c = Captcha::reCAPTCHA->new;
324
    my $captcha = 'captcha';
325
    #my $error=null;
326
    my $use_ssl= 1;
327
    #my $options=null;
328
    $templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
329
    $template->process( $templates->{'header'}, $templateVars );
330
    foreach my $tmpl (@{$templateList}) {
331
        $template->process( $templates->{$tmpl}, $templateVars );
332
    }
333
    $template->process( $templates->{'footer'}, $templateVars );
334
}
335

    
336
#
337
# create the initial registration form 
338
#
339
sub handleInitRegister {
340
  my $vars = shift;
341
  print "Content-type: text/html\n\n";
342
  # process the template files:
343
  fullTemplate(['register'], {stage => "register"}); 
344
  exit();
345
}
346

    
347
#
348
# process input from the register stage, which occurs when
349
# a user submits form data to create a new account
350
#
351
sub handleRegister {
352
    
353
    print "Content-type: text/html\n\n";
354
    if ($query->param('o') =~ "LTER") {
355
      fullTemplate( ['registerLter'] );
356
      exit(0);
357
    } 
358
    
359
    my $allParams = { 'givenName' => $query->param('givenName'), 
360
                      'sn' => $query->param('sn'),
361
                      'o' => $query->param('o'), 
362
                      'mail' => $query->param('mail'), 
363
                      'uid' => $query->param('uid'), 
364
                      'userPassword' => $query->param('userPassword'), 
365
                      'userPassword2' => $query->param('userPassword2'), 
366
                      'title' => $query->param('title'), 
367
                      'telephoneNumber' => $query->param('telephoneNumber') };
368
    
369
    # Check the recaptcha
370
    my $c = Captcha::reCAPTCHA->new;
371
    my $challenge = $query->param('recaptcha_challenge_field');
372
    my $response = $query->param('recaptcha_response_field');
373
    # Verify submission
374
    my $result = $c->check_answer(
375
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
376
        $challenge, $response
377
    );
378

    
379
    if ( $result->{is_valid} ) {
380
        #print "Yes!";
381
        #exit();
382
    }
383
    else {
384
        my $errorMessage = "The verification code is wrong. Please input again.";
385
        fullTemplate(['register'], { stage => "register",
386
                                     allParams => $allParams,
387
                                     errorMessage => $errorMessage });
388
        exit();
389
    }
390
    
391
    
392
    # Check that all required fields are provided and not null
393
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
394
                           'uid', 'userPassword', 'userPassword2');
395
    if (! paramsAreValid(@requiredParams)) {
396
        my $errorMessage = "Required information is missing. " .
397
            "Please fill in all required fields and resubmit the form.";
398
        fullTemplate(['register'], { stage => "register",
399
                                     allParams => $allParams,
400
                                     errorMessage => $errorMessage });
401
        exit();
402
    } else {
403
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
404
            my $errorMessage = "The passwords do not match. Try again.";
405
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
406
                                                            allParams => $allParams,
407
                                                            errorMessage => $errorMessage });
408
            exit();
409
        }
410
        my $o = $query->param('o');    
411
        $searchBase = $ldapConfig->{$o}{'base'};  
412
    }
413

    
414
    # Search LDAP for matching entries that already exist
415
    # Some forms use a single text search box, whereas others search per
416
    # attribute.
417
    my $filter;
418
    if ($query->param('searchField')) {
419

    
420
      $filter = "(|" . 
421
                "(uid=" . $query->param('searchField') . ") " .
422
                "(mail=" . $query->param('searchField') . ")" .
423
                "(&(sn=" . $query->param('searchField') . ") " . 
424
                "(givenName=" . $query->param('searchField') . "))" . 
425
                ")";
426
    } else {
427
      $filter = "(|" . 
428
                "(uid=" . $query->param('uid') . ") " .
429
                "(mail=" . $query->param('mail') . ")" .
430
                "(&(sn=" . $query->param('sn') . ") " . 
431
                "(givenName=" . $query->param('givenName') . "))" . 
432
                ")";
433
    }
434

    
435
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
436
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
437

    
438
    # If entries match, send back a request to confirm new-user creation
439
    if ($found) {
440
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
441
                                                     allParams => $allParams,
442
                                                     foundAccounts => $found });
443
    # Otherwise, create a new user in the LDAP directory
444
    } else {
445
        createTemporaryAccount($allParams);
446
    }
447

    
448
    exit();
449
}
450

    
451
#
452
# process input from the registerconfirmed stage, which occurs when
453
# a user chooses to create an account despite similarities to other
454
# existing accounts
455
#
456
sub handleRegisterConfirmed {
457
  
458
    my $allParams = { 'givenName' => $query->param('givenName'), 
459
                      'sn' => $query->param('sn'),
460
                      'o' => $query->param('o'), 
461
                      'mail' => $query->param('mail'), 
462
                      'uid' => $query->param('uid'), 
463
                      'userPassword' => $query->param('userPassword'), 
464
                      'userPassword2' => $query->param('userPassword2'), 
465
                      'title' => $query->param('title'), 
466
                      'telephoneNumber' => $query->param('telephoneNumber') };
467
    print "Content-type: text/html\n\n";
468
    createTemporaryAccount($allParams);
469
    exit();
470
}
471

    
472
#
473
# change a user's password upon request
474
#
475
sub handleChangePassword {
476

    
477
    print "Content-type: text/html\n\n";
478

    
479
    my $allParams = { 'test' => "1", };
480
    if ($query->param('uid')) {
481
        $$allParams{'uid'} = $query->param('uid');
482
    }
483
    if ($query->param('o')) {
484
        $$allParams{'o'} = $query->param('o');
485
        my $o = $query->param('o');
486
        
487
        $searchBase = $ldapConfig->{$o}{'base'};
488
    }
489

    
490

    
491
    # Check that all required fields are provided and not null
492
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
493
                           'userPassword', 'userPassword2');
494
    if (! paramsAreValid(@requiredParams)) {
495
        my $errorMessage = "Required information is missing. " .
496
            "Please fill in all required fields and submit the form.";
497
        fullTemplate( ['changePass'], { stage => "changepass",
498
                                        allParams => $allParams,
499
                                        errorMessage => $errorMessage });
500
        exit();
501
    }
502

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

    
506
        my $o = $query->param('o');
507
        $searchBase = $ldapConfig->{$o}{'base'};
508
        $ldapUsername = $ldapConfig->{$o}{'user'};
509
        $ldapPassword = $ldapConfig->{$o}{'password'};
510

    
511
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
512
        if ($query->param('o') =~ "LTER") {
513
            fullTemplate( ['registerLter'] );
514
        } else {
515
            my $errorMessage = changePassword(
516
                    $dn, $query->param('userPassword'), 
517
                    $dn, $query->param('oldpass'), $query->param('o'));
518
            if ($errorMessage) {
519
                fullTemplate( ['changePass'], { stage => "changepass",
520
                                                allParams => $allParams,
521
                                                errorMessage => $errorMessage });
522
                exit();
523
            } else {
524
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
525
                                                       allParams => $allParams });
526
                exit();
527
            }
528
        }
529
    } else {
530
        my $errorMessage = "The passwords do not match. Try again.";
531
        fullTemplate( ['changePass'], { stage => "changepass",
532
                                        allParams => $allParams,
533
                                        errorMessage => $errorMessage });
534
        exit();
535
    }
536
}
537

    
538
#
539
# change a user's password upon request - no input params
540
# only display chagepass template without any error
541
#
542
sub handleInitialChangePassword {
543
    print "Content-type: text/html\n\n";
544

    
545
    my $allParams = { 'test' => "1", };
546
    my $errorMessage = "";
547
    fullTemplate( ['changePass'], { stage => "changepass",
548
                                    errorMessage => $errorMessage });
549
    exit();
550
}
551

    
552
#
553
# reset a user's password upon request
554
#
555
sub handleResetPassword {
556

    
557
    print "Content-type: text/html\n\n";
558

    
559
    my $allParams = { 'test' => "1", };
560
    if ($query->param('uid')) {
561
        $$allParams{'uid'} = $query->param('uid');
562
    }
563
    if ($query->param('o')) {
564
        $$allParams{'o'} = $query->param('o');
565
        my $o = $query->param('o');
566
        
567
        $searchBase = $ldapConfig->{$o}{'base'};
568
        $ldapUsername = $ldapConfig->{$o}{'user'};
569
        $ldapPassword = $ldapConfig->{$o}{'password'};
570
    }
571

    
572
    # Check that all required fields are provided and not null
573
    my @requiredParams = ( 'uid', 'o' );
574
    if (! paramsAreValid(@requiredParams)) {
575
        my $errorMessage = "Required information is missing. " .
576
            "Please fill in all required fields and submit the form.";
577
        fullTemplate( ['resetPass'],  { stage => "resetpass",
578
                                        allParams => $allParams,
579
                                        errorMessage => $errorMessage });
580
        exit();
581
    }
582

    
583
    # We have all of the info we need, so try to change the password
584
    my $o = $query->param('o');
585
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
586
    debug("handleResetPassword: dn: $dn");
587
    if ($query->param('o') =~ "LTER") {
588
        fullTemplate( ['registerLter'] );
589
        exit();
590
    } else {
591
        my $errorMessage = "";
592
        my $recipient;
593
        my $userPass;
594
        my $entry = getLdapEntry($ldapurl, $searchBase, 
595
                $query->param('uid'), $query->param('o'));
596

    
597
        if ($entry) {
598
            $recipient = $entry->get_value('mail');
599
            $userPass = getRandomPassword();
600
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
601
        } else {
602
            $errorMessage = "User not found in database.  Please try again.";
603
        }
604

    
605
        if ($errorMessage) {
606
            fullTemplate( ['resetPass'], { stage => "resetpass",
607
                                           allParams => $allParams,
608
                                           errorMessage => $errorMessage });
609
            exit();
610
        } else {
611
            my $errorMessage = sendPasswordNotification($query->param('uid'),
612
                    $query->param('o'), $userPass, $recipient, $cfg);
613
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
614
                                                  allParams => $allParams,
615
                                                  errorMessage => $errorMessage });
616
            exit();
617
        }
618
    }
619
}
620

    
621
#
622
# reset a user's password upon request- no initial params
623
# only display resetpass template without any error
624
#
625
sub handleInitialResetPassword {
626
    print "Content-type: text/html\n\n";
627
    my $errorMessage = "";
628
    fullTemplate( ['resetPass'], { stage => "resetpass",
629
                                   errorMessage => $errorMessage });
630
    exit();
631
}
632

    
633
#
634
# Construct a random string to use for a newly reset password
635
#
636
sub getRandomPassword {
637
    my $length = shift;
638
    if (!$length) {
639
        $length = 8;
640
    }
641
    my $newPass = "";
642

    
643
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
644
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
645
    return $newPass;
646
}
647

    
648
#
649
# Change a password to a new value, binding as the provided user
650
#
651
sub changePassword {
652
    my $userDN = shift;
653
    my $userPass = shift;
654
    my $bindDN = shift;
655
    my $bindPass = shift;
656
    my $o = shift;
657

    
658
    my $searchBase = $ldapConfig->{$o}{'base'};
659

    
660
    my $errorMessage = 0;
661
    my $ldap;
662

    
663
    #if main ldap server is down, a html file containing warning message will be returned
664
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
665
    
666
    if ($ldap) {
667
        #$ldap->start_tls( verify => 'require',
668
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
669
        $ldap->start_tls( verify => 'none');
670
        debug("changePassword: attempting to bind to $bindDN");
671
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
672
                                  password => $bindPass );
673
        if ($bindresult->code) {
674
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
675
                            "correct? Please correct and try again...";
676
            return $errorMessage;
677
        }
678

    
679
    	# Find the user here and change their entry
680
    	my $newpass = createSeededPassHash($userPass);
681
    	my $modifications = { userPassword => $newpass };
682
      debug("changePass: setting password for $userDN to $newpass");
683
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
684
    
685
    	if ($result->code()) {
686
            debug("changePass: error changing password: " . $result->error);
687
        	$errorMessage = "There was an error changing the password:" .
688
                           "<br />\n" . $result->error;
689
    	} 
690
    	$ldap->unbind;   # take down session
691
    }
692

    
693
    return $errorMessage;
694
}
695

    
696
#
697
# generate a Seeded SHA1 hash of a plaintext password
698
#
699
sub createSeededPassHash {
700
    my $secret = shift;
701

    
702
    my $salt = "";
703
    for (my $i=0; $i < 4; $i++) {
704
        $salt .= int(rand(10));
705
    }
706

    
707
    my $ctx = Digest::SHA1->new;
708
    $ctx->add($secret);
709
    $ctx->add($salt);
710
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
711

    
712
    return $hashedPasswd;
713
}
714

    
715
#
716
# Look up an ldap entry for a user
717
#
718
sub getLdapEntry {
719
    my $ldapurl = shift;
720
    my $base = shift;
721
    my $username = shift;
722
    my $org = shift;
723

    
724
    my $entry = "";
725
    my $mesg;
726
    my $ldap;
727
    debug("ldap server: $ldapurl");
728

    
729
    #if main ldap server is down, a html file containing warning message will be returned
730
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
731
    
732
    if ($ldap) {
733
    	$ldap->start_tls( verify => 'none');
734
    	my $bindresult = $ldap->bind;
735
    	if ($bindresult->code) {
736
        	return $entry;
737
    	}
738

    
739
    	if($ldapConfig->{$org}{'filter'}){
740
            debug("getLdapEntry: filter set, searching for base=$base, " .
741
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
742
        	$mesg = $ldap->search ( base   => $base,
743
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
744
    	} else {
745
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
746
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
747
    	}
748
    
749
    	if ($mesg->count > 0) {
750
        	$entry = $mesg->pop_entry;
751
        	$ldap->unbind;   # take down session
752
    	} else {
753
        	$ldap->unbind;   # take down session
754
        	# Follow references by recursive call to self
755
        	my @references = $mesg->references();
756
        	for (my $i = 0; $i <= $#references; $i++) {
757
            	my $uri = URI->new($references[$i]);
758
            	my $host = $uri->host();
759
            	my $path = $uri->path();
760
            	$path =~ s/^\///;
761
            	$entry = &getLdapEntry($host, $path, $username, $org);
762
            	if ($entry) {
763
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
764
                	return $entry;
765
            	}
766
        	}
767
    	}
768
    }
769
    return $entry;
770
}
771

    
772
# 
773
# send an email message notifying the user of the pw change
774
#
775
sub sendPasswordNotification {
776
    my $username = shift;
777
    my $org = shift;
778
    my $newPass = shift;
779
    my $recipient = shift;
780
    my $cfg = shift;
781

    
782
    my $errorMessage = "";
783
    if ($recipient) {
784
        my $mailhost = $properties->getProperty('email.mailhost');
785
        my $sender;
786
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
787
        # Send the email message to them
788
        my $smtp = Net::SMTP->new($mailhost);
789
        $smtp->mail($sender);
790
        $smtp->to($recipient);
791

    
792
        my $message = <<"        ENDOFMESSAGE";
793
        To: $recipient
794
        From: $sender
795
        Subject: KNB Password Reset
796
        
797
        Somebody (hopefully you) requested that your KNB password be reset.  
798
        This is generally done when somebody forgets their password.  Your 
799
        password can be changed by visiting the following URL:
800

    
801
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
802

    
803
            Username: $username
804
        Organization: $org
805
        New Password: $newPass
806

    
807
        Thanks,
808
            The KNB Development Team
809
    
810
        ENDOFMESSAGE
811
        $message =~ s/^[ \t\r\f]+//gm;
812
    
813
        $smtp->data($message);
814
        $smtp->quit;
815
    } else {
816
        $errorMessage = "Failed to send password because I " .
817
                        "couldn't find a valid email address.";
818
    }
819
    return $errorMessage;
820
}
821

    
822
#
823
# search the LDAP directory to see if a similar account already exists
824
#
825
sub findExistingAccounts {
826
    my $ldapurl = shift;
827
    my $base = shift;
828
    my $filter = shift;
829
    my $attref = shift;
830
    my $ldap;
831
    my $mesg;
832

    
833
    my $foundAccounts = 0;
834

    
835
    #if main ldap server is down, a html file containing warning message will be returned
836
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
837
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
838
    if ($ldap) {
839
    	$ldap->start_tls( verify => 'none');
840
    	$ldap->bind( version => 3, anonymous => 1);
841
		$mesg = $ldap->search (
842
			base   => $base,
843
			filter => $filter,
844
			attrs => @$attref,
845
		);
846

    
847
	    if ($mesg->count() > 0) {
848
			$foundAccounts = "";
849
			my $entry;
850
			foreach $entry ($mesg->all_entries) { 
851
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
852
                # this could be done directly with filters on the LDAP connection, instead.
853
                #if ($entry->dn !~ /ou=Account/) {
854
                    $foundAccounts .= "<p>\n<b><u>Account:</u> ";
855
                    $foundAccounts .= $entry->dn();
856
                    $foundAccounts .= "</b><br />\n";
857
                    foreach my $attribute ($entry->attributes()) {
858
                        my $value = $entry->get_value($attribute);
859
                        $foundAccounts .= "$attribute: ";
860
                        $foundAccounts .= $value;
861
                        $foundAccounts .= "<br />\n";
862
                    }
863
                    $foundAccounts .= "</p>\n";
864
                #}
865
			}
866
        }
867
    	$ldap->unbind;   # take down session
868

    
869
    	# Follow references
870
    	my @references = $mesg->references();
871
    	for (my $i = 0; $i <= $#references; $i++) {
872
        	my $uri = URI->new($references[$i]);
873
        	my $host = $uri->host();
874
        	my $path = $uri->path();
875
        	$path =~ s/^\///;
876
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
877
        	if ($refFound) {
878
            	$foundAccounts .= $refFound;
879
        	}
880
    	}
881
    }
882

    
883
    #print "<p>Checking referrals...</p>\n";
884
    #my @referrals = $mesg->referrals();
885
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
886
    #for (my $i = 0; $i <= $#referrals; $i++) {
887
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
888
    #}
889

    
890
    return $foundAccounts;
891
}
892

    
893
#
894
# Validate that we have the proper set of input parameters
895
#
896
sub paramsAreValid {
897
    my @pnames = @_;
898

    
899
    my $allValid = 1;
900
    foreach my $parameter (@pnames) {
901
        if (!defined($query->param($parameter)) || 
902
            ! $query->param($parameter) ||
903
            $query->param($parameter) =~ /^\s+$/) {
904
            $allValid = 0;
905
        }
906
    }
907

    
908
    return $allValid;
909
}
910

    
911
#
912
# Create a temporary account for a user and send an email with a link which can click for the
913
# verification. This is used to protect the ldap server against spams.
914
#
915
sub createTemporaryAccount {
916
    my $allParams = shift;
917
    my $org = $query->param('o'); 
918
    my $ldapUsername = $ldapConfig->{$org}{'user'};
919
    my $ldapPassword = $ldapConfig->{$org}{'password'};
920
    my $tmp = 1;
921

    
922
    ################## Search LDAP to see if the dc=tmp which stores the inactive accounts exist or not. If it doesn't exist, it will be generated
923
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
924
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
925
    my $tmpFilter = "dc=tmp";
926
    my @attributes=['dc'];
927
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
928
    if (!$foundTmp) {
929
        my $dn = $tmpSearchBase;
930
        my $additions = [ 
931
                    'dc' => 'tmp',
932
                    'o'  => 'tmp',
933
                    'objectclass' => ['top', 'dcObject', 'organization']
934
                    ];
935
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
936
    } else {
937
     debug("found the tmp space");
938
    }
939
    
940
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
941
    my $filter = $ldapConfig->{$org}{'filter'};   
942
    
943
    debug("search filer " . $filter);
944
    debug("ldap server ". $ldapurl);
945
    debug("sesarch base " . $tmpSearchBase);
946
    print "Content-type: text/html\n\n";
947
    my @attrs = ['o', 'ou' ];
948
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
949

    
950
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
951
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
952
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
953
        
954
    if(!$found) {
955
        debug("generate the subtree in the dc=tmp===========================");
956
        #need to generate the subtree o or ou
957
        my $additions;
958
            if($organization eq 'ou') {
959
                $additions = [ 
960
                    $organization   => $organizationName,
961
                    'objectclass' => ['top', 'organizationalUnit']
962
                    ];
963
            
964
            } else {
965
                $additions = [ 
966
                    $organization   => $organizationName,
967
                    'objectclass' => ['top', 'organization']
968
                    ];
969
            
970
            } 
971
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
972
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
973
    } 
974
    
975
    ################create an account under tmp subtree 
976
    
977
    #generate a randomstr for matching the email.
978
    my $randomStr = getRandomPassword(16);
979
    # Create a hashed version of the password
980
    my $shapass = createSeededPassHash($query->param('userPassword'));
981
    my $additions = [ 
982
                'uid'   => $query->param('uid'),
983
                'cn'   => join(" ", $query->param('givenName'), 
984
                                    $query->param('sn')),
985
                'sn'   => $query->param('sn'),
986
                'givenName'   => $query->param('givenName'),
987
                'mail' => $query->param('mail'),
988
                'userPassword' => $shapass,
989
                'employeeNumber' => $randomStr,
990
                'objectclass' => ['top', 'person', 'organizationalPerson', 
991
                                'inetOrgPerson', 'uidObject' ],
992
                $organization   => $organizationName
993
                ];
994
    if (defined($query->param('telephoneNumber')) && 
995
                $query->param('telephoneNumber') &&
996
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
997
                $$additions[$#$additions + 1] = 'telephoneNumber';
998
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
999
    }
1000
    if (defined($query->param('title')) && 
1001
                $query->param('title') &&
1002
                ! $query->param('title') =~ /^\s+$/) {
1003
                $$additions[$#$additions + 1] = 'title';
1004
                $$additions[$#$additions + 1] = $query->param('title');
1005
    }
1006

    
1007
    
1008
    #$$additions[$#$additions + 1] = 'o';
1009
    #$$additions[$#$additions + 1] = $org;
1010
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1011
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1012
    
1013
    
1014
    ####################send the verification email to the user
1015
    my $link = $contextUrl. '/cgi-bin/ldapweb.cgi?cfg=' . $skinName . '&' . 'stage=' . $emailVerification . '&' . 'dn=' . $dn . '&' . 'hash=' . $randomStr . '&o=' . $org . '&uid=' . $query->param('uid'); #even though we use o=something. The emailVerification will figure the real o= or ou=something.
1016
    
1017
    my $mailhost = $properties->getProperty('email.mailhost');
1018
    my $sender;
1019
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1020
    debug("the sender is " . $sender);
1021
    my $recipient = $query->param('mail');
1022
    # Send the email message to them
1023
    my $smtp = Net::SMTP->new($mailhost) or do {  
1024
                                                  fullTemplate( ['registerFailed'], {errorMessage => "The temporary account " . $dn . " was created successfully. However, the vertification email can't be sent to you because the email server has some issues. Please contact " . 
1025
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1026
                                                  exit(0);
1027
                                               };
1028
    $smtp->mail($sender);
1029
    $smtp->to($recipient);
1030

    
1031
    my $message = <<"     ENDOFMESSAGE";
1032
    To: $recipient
1033
    From: $sender
1034
    Subject: Activate the New KNB Account
1035
        
1036
    Somebody (hopefully you) registered a KNB account.  
1037
    Please click the following link to activate your account.
1038
    If the link doesn't work, please copy the link to your browser:
1039
    
1040
    $link
1041

    
1042
    Thanks,
1043
        The KNB Development Team
1044
    
1045
     ENDOFMESSAGE
1046
     $message =~ s/^[ \t\r\f]+//gm;
1047
    
1048
     $smtp->data($message);
1049
     $smtp->quit;
1050
    debug("the link is " . $link);
1051
    fullTemplate( ['success'] );
1052
    
1053
}
1054

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

    
1106

    
1107

    
1108

    
1109

    
1110

    
1111
#
1112
# This subroutine will handle a email verification:
1113
# If the hash string matches the one store in the ldap, the account will be
1114
# copied from the temporary space to the permanent tree and the account in 
1115
# the temporary space will be removed.
1116
sub handleEmailVerification {
1117

    
1118
    my $cfg = $query->param('cfg');
1119
    my $dn = $query->param('dn');
1120
    my $hash = $query->param('hash');
1121
    my $org = $query->param('o');
1122
    my $uid = $query->param('uid');
1123
    
1124
    my $ldapUsername;
1125
    my $ldapPassword;
1126
    #my $orgAuthBase;
1127

    
1128
    $ldapUsername = $ldapConfig->{$org}{'user'};
1129
    $ldapPassword = $ldapConfig->{$org}{'password'};
1130
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1131
    
1132
    debug("LDAP connection to $ldapurl...");    
1133
    
1134

    
1135
   print "Content-type: text/html\n\n";
1136
   #if main ldap server is down, a html file containing warning message will be returned
1137
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1138
   if ($ldap) {
1139
        $ldap->start_tls( verify => 'none');
1140
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1141
        my $mesg = $ldap->search(base => $dn, scope => 'base', filter => '(objectClass=*)'); #This dn is with the dc=tmp. So it will find out the temporary account registered in registration step.
1142
        my $max = $mesg->count;
1143
        debug("the count is " . $max);
1144
        if($max < 1) {
1145
            $ldap->unbind;   # take down session
1146
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1147
            #handleLDAPBindFailure($ldapurl);
1148
            exit(0);
1149
        } else {
1150
            #check if the hash string match
1151
            my $entry = $mesg->entry (0);
1152
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1153
            if( $hashStrFromLdap eq $hash) {
1154
                #my $additions = [ ];
1155
                #foreach my $attr ( $entry->attributes ) {
1156
                    #if($attr ne 'employeeNumber') {
1157
                        #$$additions[$#$additions + 1] = $attr;
1158
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1159
                    #}
1160
                #}
1161

    
1162
                
1163
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1164
                $mesg = $ldap->moddn(
1165
                            dn => $dn,
1166
                            deleteoldrdn => 1,
1167
                            newrdn => "uid=" . $uid,
1168
                            newsuperior  =>  $orgDn);
1169
                $ldap->unbind;   # take down session
1170
                if($mesg->code()) {
1171
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1172
                    exit(0);
1173
                } else {
1174
                    fullTemplate( ['verificationSuccess'] );
1175
                }
1176
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1177
            } else {
1178
                $ldap->unbind;   # take down session
1179
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1180
                exit(0);
1181
            }
1182
            
1183
        }
1184
    } else {   
1185
        handleLDAPBindFailure($ldapurl);
1186
        exit(0);
1187
    }
1188

    
1189
}
1190

    
1191
sub handleResponseMessage {
1192

    
1193
  print "Content-type: text/html\n\n";
1194
  my $errorMessage = "You provided invalid input to the script. " .
1195
                     "Try again please.";
1196
  fullTemplate( [], { stage => $templates->{'stage'},
1197
                      errorMessage => $errorMessage });
1198
  exit();
1199
}
1200

    
1201
#
1202
# perform a simple search against the LDAP database using 
1203
# a small subset of attributes of each dn and return it
1204
# as a table to the calling browser.
1205
#
1206
sub handleSimpleSearch {
1207

    
1208
    my $o = $query->param('o');
1209

    
1210
    my $ldapurl = $ldapConfig->{$o}{'url'};
1211
    my $searchBase = $ldapConfig->{$o}{'base'};
1212

    
1213
    print "Content-type: text/html\n\n";
1214

    
1215
    my $allParams = { 
1216
                      'cn' => $query->param('cn'),
1217
                      'sn' => $query->param('sn'),
1218
                      'gn' => $query->param('gn'),
1219
                      'o'  => $query->param('o'),
1220
                      'facsimiletelephonenumber' 
1221
                      => $query->param('facsimiletelephonenumber'),
1222
                      'mail' => $query->param('cmail'),
1223
                      'telephonenumber' => $query->param('telephonenumber'),
1224
                      'title' => $query->param('title'),
1225
                      'uid' => $query->param('uid'),
1226
                      'ou' => $query->param('ou'),
1227
                    };
1228

    
1229
    # Search LDAP for matching entries that already exist
1230
    my $filter = "(" . 
1231
                 $query->param('searchField') . "=" .
1232
                 "*" .
1233
                 $query->param('searchValue') .
1234
                 "*" .
1235
                 ")";
1236

    
1237
    my @attrs = [ 'sn', 
1238
                  'gn', 
1239
                  'cn', 
1240
                  'o', 
1241
                  'facsimiletelephonenumber', 
1242
                  'mail', 
1243
                  'telephoneNumber', 
1244
                  'title', 
1245
                  'uid', 
1246
                  'labeledURI', 
1247
                  'ou' ];
1248

    
1249
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1250

    
1251
    # Send back the search results
1252
    if ($found) {
1253
      fullTemplate( ('searchResults'), { stage => "searchresults",
1254
                                         allParams => $allParams,
1255
                                         foundAccounts => $found });
1256
    } else {
1257
      $found = "No entries matched your criteria.  Please try again\n";
1258

    
1259
      fullTemplate( ('searchResults'), { stage => "searchresults",
1260
                                         allParams => $allParams,
1261
                                         foundAccounts => $found });
1262
    }
1263

    
1264
    exit();
1265
}
1266

    
1267
#
1268
# search the LDAP directory to see if a similar account already exists
1269
#
1270
sub searchDirectory {
1271
    my $ldapurl = shift;
1272
    my $base = shift;
1273
    my $filter = shift;
1274
    my $attref = shift;
1275

    
1276
	my $mesg;
1277
    my $foundAccounts = 0;
1278
    
1279
    #if ldap server is down, a html file containing warning message will be returned
1280
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1281
    
1282
    if ($ldap) {
1283
    	$ldap->start_tls( verify => 'none');
1284
    	$ldap->bind( version => 3, anonymous => 1);
1285
    	my $mesg = $ldap->search (
1286
        	base   => $base,
1287
        	filter => $filter,
1288
        	attrs => @$attref,
1289
    	);
1290

    
1291
    	if ($mesg->count() > 0) {
1292
        	$foundAccounts = "";
1293
        	my $entry;
1294
        	foreach $entry ($mesg->sorted(['sn'])) {
1295
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1296
          		$foundAccounts .= "<a href=\"" unless 
1297
                    (!$entry->get_value('labeledURI'));
1298
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1299
                    (!$entry->get_value('labeledURI'));
1300
          		$foundAccounts .= "\">\n" unless 
1301
                    (!$entry->get_value('labeledURI'));
1302
          		$foundAccounts .= $entry->get_value('givenName');
1303
          		$foundAccounts .= "</a>\n" unless 
1304
                    (!$entry->get_value('labeledURI'));
1305
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1306
          		$foundAccounts .= "<a href=\"" unless 
1307
                    (!$entry->get_value('labeledURI'));
1308
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1309
                    (!$entry->get_value('labeledURI'));
1310
          		$foundAccounts .= "\">\n" unless 
1311
                    (!$entry->get_value('labeledURI'));
1312
          		$foundAccounts .= $entry->get_value('sn');
1313
          		$foundAccounts .= "</a>\n";
1314
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1315
          		$foundAccounts .= $entry->get_value('mail');
1316
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1317
          		$foundAccounts .= $entry->get_value('telephonenumber');
1318
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1319
          		$foundAccounts .= $entry->get_value('title');
1320
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1321
          		$foundAccounts .= $entry->get_value('ou');
1322
          		$foundAccounts .= "\n</td>\n";
1323
          		$foundAccounts .= "</tr>\n";
1324
        	}
1325
    	}
1326
    	$ldap->unbind;   # take down session
1327
    }
1328
    return $foundAccounts;
1329
}
1330

    
1331
sub debug {
1332
    my $msg = shift;
1333
    
1334
    if ($debug) {
1335
        print STDERR "LDAPweb: $msg\n";
1336
    }
1337
}
1338

    
1339
sub handleLDAPBindFailure {
1340
    my $ldapAttemptUrl = shift;
1341
    my $primaryLdap =  $properties->getProperty('auth.url');
1342

    
1343
    if ($ldapAttemptUrl eq  $primaryLdap) {
1344
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1345
    } else {
1346
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1347
    }
1348
}
1349

    
1350
sub handleGeneralServerFailure {
1351
    my $errorMessage = shift;
1352
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1353
    exit(0);   
1354
   }
1355
    
1356
sub setVars {
1357
    my $paramVars = shift;
1358
    # initialize default parameters 
1359
    my $templateVars = { cfg => $cfg,
1360
                         styleSkinsPath => $contextUrl . "/style/skins",
1361
                         styleCommonPath => $contextUrl . "/style/common",
1362
                         contextUrl => $contextUrl,
1363
                         cgiPrefix => $cgiPrefix,
1364
                         orgList => \@validDisplayOrgList,
1365
                         config  => $config,
1366
    };
1367
    
1368
    # append customized params
1369
    while (my ($k, $v) = each (%$paramVars)) {
1370
        $templateVars->{$k} = $v;
1371
    }
1372
    
1373
    return $templateVars;
1374
} 
1375