Project

General

Profile

1 2341 sgarg
#!/usr/bin/perl -w
2 4865 walbridge
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California
5
#
6
#   '$Author$'
7
#     '$Date$'
8
# '$Revision$'
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 2341 sgarg
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 4394 walbridge
30
use lib '../WEB-INF/lib';
31 4080 daigle
use strict;             # turn on strict syntax checking
32
use Template;           # load the template-toolkit module
33 4394 walbridge
use CGI qw/:standard :html3/; # load the CGI module
34 4080 daigle
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 8166 tao
use Captcha::reCAPTCHA; # for protection against spams
42 4394 walbridge
use Cwd 'abs_path';
43 2341 sgarg
44 4080 daigle
# Global configuration paramters
45 4394 walbridge
# This entire block (including skin parsing) could be pushed out to a separate .pm file
46 4080 daigle
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 4394 walbridge
    print "Content-type: text/html\n\n";
52 4080 daigle
    print "Unable to locate Metacat properties. Working directory is set as " .
53
        $workingDirectory .", is this correct?";
54
    exit(0);
55
}
56 2341 sgarg
57 4080 daigle
$properties->load(*METACAT_PROPERTIES);
58 4010 tao
59 4394 walbridge
# 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 7199 leinfelder
my $protocol = 'http://';
67
if ( $properties->getProperty('server.httpPort') eq '443' ) {
68
	$protocol = 'https://';
69
}
70
my $contextUrl = $protocol . $properties->getProperty('server.name');
71 4864 walbridge
if ($properties->getProperty('server.httpPort') ne '80') {
72
        $contextUrl = $contextUrl . ':' . $properties->getProperty('server.httpPort');
73
}
74
$contextUrl = $contextUrl . '/' .  $properties->getProperty('application.context');
75 4394 walbridge
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 8169 tao
#recaptcha key information
82
my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');
83
my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');
84
85 4394 walbridge
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 4747 walbridge
    debug("No configuration set.");
99 4394 walbridge
    print "Content-type: text/html\n\n";
100 4749 walbridge
    print 'LDAPweb Error: The registry requires a skin name to continue.';
101 4394 walbridge
    exit();
102
}
103
104
# Metacat isn't initialized, the registry will fail in strange ways.
105
if (!($metacatUrl)) {
106 4747 walbridge
    debug("No Metacat.");
107 4394 walbridge
    print "Content-type: text/html\n\n";
108
    'Registry Error: Metacat is not initialized! Make sure' .
109 5214 walbridge
        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';
110 4394 walbridge
    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 4870 walbridge
# 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 4394 walbridge
my $searchBase;
149
my $ldapUsername;
150
my $ldapPassword;
151 4728 walbridge
# 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 4080 daigle
155
# Java uses miliseconds, Perl expects whole seconds
156 4728 walbridge
my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;
157 4080 daigle
158 2341 sgarg
# Get the CGI input variables
159
my $query = new CGI;
160 4747 walbridge
my $debug = 1;
161 2341 sgarg
162
#--------------------------------------------------------------------------80c->
163
# Set up the Template Toolkit to read html form templates
164
165 4080 daigle
# templates hash, imported from ldap.templates tree in metacat.properties
166
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
167 4394 walbridge
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
168
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
169 2341 sgarg
170
# set some configuration options for the template object
171 4394 walbridge
my $ttConfig = {
172
             INCLUDE_PATH => $templatesDir,
173
             INTERPOLATE  => 0,
174
             POST_CHOMP   => 1,
175
             DEBUG        => 1,
176 2341 sgarg
             };
177
178
# create an instance of the template
179 4394 walbridge
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
180 2341 sgarg
181 4080 daigle
# custom LDAP properties hash
182
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
183 2341 sgarg
184 4394 walbridge
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 4870 walbridge
189 4394 walbridge
my @orgList;
190
while (my ($oKey, $oVal) = each(%$orgNames)) {
191
    push(@orgList, $oKey);
192
}
193
194 4866 walbridge
my $authBase = $properties->getProperty("auth.base");
195 4080 daigle
my $ldapConfig;
196
foreach my $o (@orgList) {
197 4394 walbridge
    foreach my $d (@orgData) {
198
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
199 4080 daigle
    }
200 4866 walbridge
201 4870 walbridge
    # 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 4866 walbridge
    # 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 4394 walbridge
    } else {
229
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
230
    }
231 4868 walbridge
232
    # set LDAP administrator user account
233 4866 walbridge
    if (!$ldapConfig->{$o}{'user'}) {
234
        $ldapConfig->{$o}{'user'} = $ldapConfig->{'unaffiliated'}{'user'};
235 4865 walbridge
    }
236 4868 walbridge
    # 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 4866 walbridge
242
    if (!$ldapConfig->{$o}{'password'}) {
243
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
244
    }
245 2341 sgarg
}
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 4080 daigle
my $stage = $query->param('stage') || $templates->{'stage'};
253 2341 sgarg
254
my $cfg = $query->param('cfg');
255 4767 walbridge
debug("started with stage $stage, cfg $cfg");
256 2341 sgarg
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 2972 jones
              'changepass'        => \&handleChangePassword,
268
              'initchangepass'    => \&handleInitialChangePassword,
269 2341 sgarg
              'resetpass'         => \&handleResetPassword,
270 2414 sgarg
              'initresetpass'     => \&handleInitialResetPassword,
271 2341 sgarg
             );
272 4394 walbridge
273 2341 sgarg
# 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 4728 walbridge
sub fullTemplate {
285
    my $templateList = shift;
286
    my $templateVars = setVars(shift);
287 8166 tao
    my $c = Captcha::reCAPTCHA->new;
288
    my $captcha = 'captcha';
289
    #my $error=null;
290
    my $use_ssl= 1;
291
    #my $options=null;
292 8169 tao
    $templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
293 4728 walbridge
    $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 2341 sgarg
#
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 4080 daigle
  fullTemplate(['register'], {stage => "register"});
308 2341 sgarg
  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 8166 tao
319
320 2341 sgarg
    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 8166 tao
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 8169 tao
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
337 8166 tao
        $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 2341 sgarg
    # 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 4080 daigle
        fullTemplate(['register'], { stage => "register",
360
                                     allParams => $allParams,
361
                                     errorMessage => $errorMessage });
362
        exit();
363 2341 sgarg
    } else {
364 2972 jones
        my $o = $query->param('o');
365 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
366 2341 sgarg
    }
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 4080 daigle
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
395
                                                     allParams => $allParams,
396
                                                     foundAccounts => $found });
397 2341 sgarg
    # Otherwise, create a new user in the LDAP directory
398
    } else {
399 8180 tao
        createTemporaryAccount($allParams);
400 2341 sgarg
    }
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 4080 daigle
                      'o' => 'unaffiliated', # only accept unaffiliated registration
415 2341 sgarg
                      '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 8180 tao
    createTemporaryAccount($allParams);
423 2341 sgarg
    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 2972 jones
        my $o = $query->param('o');
440
441 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
442 2341 sgarg
    }
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 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
452
                                        allParams => $allParams,
453
                                        errorMessage => $errorMessage });
454
        exit();
455 2341 sgarg
    }
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 2972 jones
        my $o = $query->param('o');
461 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
462
        $ldapUsername = $ldapConfig->{$o}{'user'};
463
        $ldapPassword = $ldapConfig->{$o}{'password'};
464 2341 sgarg
465 4080 daigle
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
466 2341 sgarg
        if ($query->param('o') =~ "LTER") {
467 4080 daigle
            fullTemplate( ['registerLter'] );
468 2341 sgarg
        } else {
469
            my $errorMessage = changePassword(
470
                    $dn, $query->param('userPassword'),
471
                    $dn, $query->param('oldpass'), $query->param('o'));
472 2972 jones
            if ($errorMessage) {
473 4080 daigle
                fullTemplate( ['changePass'], { stage => "changepass",
474
                                                allParams => $allParams,
475
                                                errorMessage => $errorMessage });
476
                exit();
477 2341 sgarg
            } else {
478 4080 daigle
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
479
                                                       allParams => $allParams });
480
                exit();
481 2341 sgarg
            }
482
        }
483
    } else {
484
        my $errorMessage = "The passwords do not match. Try again.";
485 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
486
                                        allParams => $allParams,
487
                                        errorMessage => $errorMessage });
488
        exit();
489 2341 sgarg
    }
490
}
491
492
#
493 2414 sgarg
# 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 4080 daigle
    fullTemplate( ['changePass'], { stage => "changepass",
502
                                    errorMessage => $errorMessage });
503
    exit();
504 2414 sgarg
}
505
506
#
507 2341 sgarg
# 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 2972 jones
        my $o = $query->param('o');
520
521 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
522 4868 walbridge
        $ldapUsername = $ldapConfig->{$o}{'user'};
523 4080 daigle
        $ldapPassword = $ldapConfig->{$o}{'password'};
524 2341 sgarg
    }
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 4080 daigle
        fullTemplate( ['resetPass'],  { stage => "resetpass",
532
                                        allParams => $allParams,
533
                                        errorMessage => $errorMessage });
534
        exit();
535 2341 sgarg
    }
536
537
    # We have all of the info we need, so try to change the password
538
    my $o = $query->param('o');
539 4080 daigle
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
540 4866 walbridge
    debug("handleResetPassword: dn: $dn");
541 2341 sgarg
    if ($query->param('o') =~ "LTER") {
542 4080 daigle
        fullTemplate( ['registerLter'] );
543
        exit();
544 2341 sgarg
    } 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 4080 daigle
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
555 2341 sgarg
        } else {
556
            $errorMessage = "User not found in database.  Please try again.";
557
        }
558
559
        if ($errorMessage) {
560 4080 daigle
            fullTemplate( ['resetPass'], { stage => "resetpass",
561
                                           allParams => $allParams,
562
                                           errorMessage => $errorMessage });
563
            exit();
564 2341 sgarg
        } else {
565
            my $errorMessage = sendPasswordNotification($query->param('uid'),
566 2972 jones
                    $query->param('o'), $userPass, $recipient, $cfg);
567 4080 daigle
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
568
                                                  allParams => $allParams,
569
                                                  errorMessage => $errorMessage });
570
            exit();
571 2341 sgarg
        }
572
    }
573
}
574
575
#
576 2414 sgarg
# 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 4080 daigle
    fullTemplate( ['resetPass'], { stage => "resetpass",
583
                                   errorMessage => $errorMessage });
584
    exit();
585 2414 sgarg
}
586
587
#
588 2341 sgarg
# 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 4080 daigle
    my $searchBase = $ldapConfig->{$o}{'base'};
613 4868 walbridge
614 2341 sgarg
    my $errorMessage = 0;
615 3177 tao
    my $ldap;
616 4868 walbridge
617 4771 walbridge
    #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 4394 walbridge
620 4849 daigle
    if ($ldap) {
621 4868 walbridge
        #$ldap->start_tls( verify => 'require',
622 2972 jones
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
623 4868 walbridge
        $ldap->start_tls( verify => 'none');
624
        debug("changePassword: attempting to bind to $bindDN");
625
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN,
626 2341 sgarg
                                  password => $bindPass );
627 4868 walbridge
        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 2341 sgarg
633 4849 daigle
    	# Find the user here and change their entry
634
    	my $newpass = createSeededPassHash($userPass);
635
    	my $modifications = { userPassword => $newpass };
636 4868 walbridge
      debug("changePass: setting password for $userDN to $newpass");
637 4849 daigle
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
638 2341 sgarg
639 4849 daigle
    	if ($result->code()) {
640 4866 walbridge
            debug("changePass: error changing password: " . $result->error);
641
        	$errorMessage = "There was an error changing the password:" .
642 2341 sgarg
                           "<br />\n" . $result->error;
643 4849 daigle
    	}
644
    	$ldap->unbind;   # take down session
645
    }
646 2341 sgarg
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 3177 tao
    my $ldap;
681 4749 walbridge
    debug("ldap server: $ldapurl");
682 4394 walbridge
683
    #if main ldap server is down, a html file containing warning message will be returned
684 4771 walbridge
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
685 4849 daigle
686
    if ($ldap) {
687
    	$ldap->start_tls( verify => 'none');
688
    	my $bindresult = $ldap->bind;
689
    	if ($bindresult->code) {
690
        	return $entry;
691
    	}
692 2341 sgarg
693 4849 daigle
    	if($ldapConfig->{$org}{'filter'}){
694 4865 walbridge
            debug("getLdapEntry: filter set, searching for base=$base, " .
695
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
696 4849 daigle
        	$mesg = $ldap->search ( base   => $base,
697 4080 daigle
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
698 4849 daigle
    	} else {
699 4865 walbridge
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
700 4849 daigle
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
701
    	}
702 3177 tao
703 4849 daigle
    	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 4865 walbridge
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
718 4849 daigle
                	return $entry;
719
            	}
720
        	}
721
    	}
722 2341 sgarg
    }
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 2972 jones
    my $cfg = shift;
735 2341 sgarg
736
    my $errorMessage = "";
737
    if ($recipient) {
738 4771 walbridge
        my $mailhost = $properties->getProperty('email.mailhost');
739
        my $sender =  $properties->getProperty('email.sender');
740 2341 sgarg
        # 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 4864 walbridge
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
755 2341 sgarg
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 3175 tao
    my $ldap;
784 4847 daigle
    my $mesg;
785 2341 sgarg
786
    my $foundAccounts = 0;
787 4749 walbridge
788 4394 walbridge
    #if main ldap server is down, a html file containing warning message will be returned
789 4868 walbridge
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
790 4771 walbridge
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
791 4845 daigle
    if ($ldap) {
792
    	$ldap->start_tls( verify => 'none');
793
    	$ldap->bind( version => 3, anonymous => 1);
794 4848 daigle
		$mesg = $ldap->search (
795 4845 daigle
			base   => $base,
796
			filter => $filter,
797
			attrs => @$attref,
798
		);
799 2341 sgarg
800 4845 daigle
	    if ($mesg->count() > 0) {
801
			$foundAccounts = "";
802
			my $entry;
803
			foreach $entry ($mesg->all_entries) {
804 5650 walbridge
                # 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 4845 daigle
			}
819 2341 sgarg
        }
820 4845 daigle
    	$ldap->unbind;   # take down session
821 2341 sgarg
822 4848 daigle
    	# 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 2341 sgarg
    }
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 8175 tao
# 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 8180 tao
    my $org = $query->param('o');
871
    #my $org = 'unaffiliated';
872 8176 tao
    my $ou = $query->param('ou');
873
    #my $ou = 'LTER';
874 8175 tao
875 8180 tao
    ################## Search LDAP for matching o or ou that already exist
876 8176 tao
    my $tmpSearchBase = 'dc=tmp,' . $authBase;
877 8180 tao
    my $filter;
878 8176 tao
    if($org) {
879
        $filter = "(o"
880 8175 tao
                  . "=" . $org .
881
                 ")";
882 8176 tao
    } else {
883
        $filter = "(ou"
884
                  . "=" . $ou .
885
                 ")";
886
    }
887
    debug("search filer " . $filter);
888
    debug("ldap server ". $ldapurl);
889
    debug("sesarch base " . $tmpSearchBase);
890 8180 tao
    print "Content-type: text/html\n\n";
891 8175 tao
    my @attrs = ['o', 'ou' ];
892
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
893 8180 tao
894
    my $ldapUsername = $ldapConfig->{$org}{'user'};
895
    my $ldapPassword = $ldapConfig->{$org}{'password'};
896
    debug("LDAP connection to $ldapurl...");
897
898
899 8176 tao
    if(!$found) {
900 8180 tao
        debug("generate the subtree in the dc=tmp===========================");
901 8176 tao
        #need to generate the subtree o or ou
902 8180 tao
        my $dn;
903 8176 tao
        #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 8177 tao
                $dn='o=' . $org . ',' . $tmpSearchBase;
916 8176 tao
             } else {
917
                $additions = [
918
                'ou'   => $ou,
919
                'objectclass' => ['top', 'organizationalUnit']
920
                ];
921 8177 tao
                $dn='ou=' . $ou . ',' . $tmpSearchBase;
922 8176 tao
             }
923 8180 tao
            # 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 8177 tao
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
928 8176 tao
            if ($result->code()) {
929
                fullTemplate( ['registerFailed', 'register'], { stage => "register",
930
                                                            allParams => $allParams,
931
                                                            errorMessage => $result->error });
932 8180 tao
                $ldap->unbind;   # take down session
933
                exist(0)
934 8176 tao
                # 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 8180 tao
        } else {
941 8176 tao
            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 8180 tao
        }
946
947 8176 tao
    }
948 8175 tao
949 8180 tao
    ################create an account under tmp subtree
950 8176 tao
951 8180 tao
    #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 8176 tao
992 8180 tao
993
    ####################send the verification email to the user
994
995 8175 tao
    #$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 2341 sgarg
# Bind to LDAP and create a new account using the information provided
1005
# by the user
1006
#
1007 8180 tao
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 2341 sgarg
sub createAccount {
1061
    my $allParams = shift;
1062
1063
    if ($query->param('o') =~ "LTER") {
1064 4080 daigle
        fullTemplate( ['registerLter'] );
1065 2341 sgarg
    } 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 4080 daigle
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
1071
                                                            allParams => $allParams,
1072
                                                            errorMessage => $errorMessage });
1073
            exit();
1074 2341 sgarg
        }
1075
1076 2972 jones
        my $o = $query->param('o');
1077 2341 sgarg
1078 4080 daigle
        my $searchBase = $ldapConfig->{$o}{'base'};
1079
        my $dnBase = $ldapConfig->{$o}{'dn'};
1080 8177 tao
        debug("the dn is " . $dnBase);
1081 4868 walbridge
        my $ldapUsername = $ldapConfig->{$o}{'user'};
1082 4749 walbridge
        my $ldapPassword = $ldapConfig->{$o}{'password'};
1083 4771 walbridge
        debug("LDAP connection to $ldapurl...");
1084 3177 tao
        #if main ldap server is down, a html file containing warning message will be returned
1085 4771 walbridge
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1086 3177 tao
1087 4849 daigle
        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 3177 tao
1092 4849 daigle
        	my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
1093
        	debug("Inserting new entry for: $dn");
1094 2341 sgarg
1095 4849 daigle
        	# Create a hashed version of the password
1096
        	my $shapass = createSeededPassHash($query->param('userPassword'));
1097 2341 sgarg
1098 4849 daigle
        	# Do the insertion
1099
        	my $additions = [
1100 2341 sgarg
                '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 4849 daigle
            	];
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 2341 sgarg
1125 4849 daigle
        	if ($result->code()) {
1126
            	fullTemplate( ['registerFailed', 'register'], { stage => "register",
1127 4080 daigle
                                                            allParams => $allParams,
1128
                                                            errorMessage => $result->error });
1129 4849 daigle
            	# 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 2341 sgarg
        }
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 4080 daigle
  fullTemplate( [], { stage => $templates->{'stage'},
1148
                      errorMessage => $errorMessage });
1149
  exit();
1150 2341 sgarg
}
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 4080 daigle
    my $ldapurl = $ldapConfig->{$o}{'url'};
1162
    my $searchBase = $ldapConfig->{$o}{'base'};
1163 2341 sgarg
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 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
1205
                                         allParams => $allParams,
1206
                                         foundAccounts => $found });
1207 2341 sgarg
    } else {
1208
      $found = "No entries matched your criteria.  Please try again\n";
1209
1210 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
1211
                                         allParams => $allParams,
1212
                                         foundAccounts => $found });
1213 2341 sgarg
    }
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 4849 daigle
	my $mesg;
1228 2341 sgarg
    my $foundAccounts = 0;
1229 3177 tao
1230
    #if ldap server is down, a html file containing warning message will be returned
1231 4771 walbridge
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1232 3177 tao
1233 4849 daigle
    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 2341 sgarg
1242 4849 daigle
    	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 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1249 4849 daigle
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1250 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1251 4849 daigle
          		$foundAccounts .= "\">\n" unless
1252 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1253 4849 daigle
          		$foundAccounts .= $entry->get_value('givenName');
1254
          		$foundAccounts .= "</a>\n" unless
1255 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1256 4849 daigle
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1257
          		$foundAccounts .= "<a href=\"" unless
1258 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1259 4849 daigle
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1260 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1261 4849 daigle
          		$foundAccounts .= "\">\n" unless
1262 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1263 4849 daigle
          		$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 2341 sgarg
    }
1279
    return $foundAccounts;
1280
}
1281
1282
sub debug {
1283
    my $msg = shift;
1284
1285
    if ($debug) {
1286 4747 walbridge
        print STDERR "LDAPweb: $msg\n";
1287 2341 sgarg
    }
1288
}
1289 3175 tao
1290 4771 walbridge
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 3177 tao
sub handleGeneralServerFailure {
1302
    my $errorMessage = shift;
1303 4728 walbridge
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1304 3175 tao
    exit(0);
1305
   }
1306
1307 4080 daigle
sub setVars {
1308
    my $paramVars = shift;
1309
    # initialize default parameters
1310
    my $templateVars = { cfg => $cfg,
1311 4394 walbridge
                         styleSkinsPath => $contextUrl . "/style/skins",
1312
                         styleCommonPath => $contextUrl . "/style/common",
1313
                         contextUrl => $contextUrl,
1314 4770 daigle
                         cgiPrefix => $cgiPrefix,
1315 4080 daigle
                         orgList => \@orgList,
1316 4394 walbridge
                         config  => $config,
1317 4080 daigle
    };
1318
1319
    # append customized params
1320
    while (my ($k, $v) = each (%$paramVars)) {
1321
        $templateVars->{$k} = $v;
1322
    }
1323
1324
    return $templateVars;
1325
}