Project

General

Profile

1 2341 sgarg
#!/usr/bin/perl -w
2
 #
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
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 4394 walbridge
use Cwd 'abs_path';
42 2341 sgarg
43 4080 daigle
# Global configuration paramters
44 4394 walbridge
# This entire block (including skin parsing) could be pushed out to a separate .pm file
45 4080 daigle
my $cgiUrl = $ENV{'SCRIPT_FILENAME'};
46
my $workingDirectory = dirname($cgiUrl);
47
my $metacatProps = "${workingDirectory}/../WEB-INF/metacat.properties";
48
my $properties = new Config::Properties();
49
unless (open (METACAT_PROPERTIES, $metacatProps)) {
50 4394 walbridge
    print "Content-type: text/html\n\n";
51 4080 daigle
    print "Unable to locate Metacat properties. Working directory is set as " .
52
        $workingDirectory .", is this correct?";
53
    exit(0);
54
}
55 2341 sgarg
56 4080 daigle
$properties->load(*METACAT_PROPERTIES);
57 4010 tao
58 4394 walbridge
# local directory configuration
59
my $skinsDir = "${workingDirectory}/../style/skins";
60
my $templatesDir = abs_path("${workingDirectory}/../style/common/templates");
61
my $tempDir = $properties->getProperty('application.tempDir');
62
63
# url configuration
64
my $server = $properties->splitToTree(qr/\./, 'server');
65
my $contextUrl = 'http://' . $properties->getProperty('server.name') . ':' .
66
                 $properties->getProperty('server.httpPort') . '/' .
67
                 $properties->getProperty('application.context');
68
69
my $metacatUrl = $contextUrl . "/metacat";
70
my $cgiPrefix = "/" . $properties->getProperty('application.context') . "/cgi-bin";
71
my $styleSkinsPath = $contextUrl . "/style/skins";
72
my $styleCommonPath = $contextUrl . "/style/common";
73
74
my @errorMessages;
75
my $error = 0;
76
77
# Import all of the HTML form fields as variables
78
import_names('FORM');
79
80
# Must have a config to use Metacat
81
my $skinName = "";
82
if ($FORM::cfg) {
83
    $skinName = $FORM::cfg;
84
} elsif ($ARGV[0]) {
85
    $skinName = $ARGV[0];
86
} else {
87 4747 walbridge
    debug("No configuration set.");
88 4394 walbridge
    print "Content-type: text/html\n\n";
89
    print 'Registry Error: The registry requires a skin name to continue.';
90
    exit();
91
}
92
93
# Metacat isn't initialized, the registry will fail in strange ways.
94
if (!($metacatUrl)) {
95 4747 walbridge
    debug("No Metacat.");
96 4394 walbridge
    print "Content-type: text/html\n\n";
97
    'Registry Error: Metacat is not initialized! Make sure' .
98
        ' MetacatUrl is set correctly in ' .  $skinName . '.cfg';
99
    exit();
100
}
101
102
my $skinProperties = new Config::Properties();
103
if (!($skinName)) {
104
    $error = "Application misconfigured.  Please contact the administrator.";
105
    push(@errorMessages, $error);
106
} else {
107
    my $skinProps = "$skinsDir/$skinName/$skinName.properties";
108
    unless (open (SKIN_PROPERTIES, $skinProps)) {
109
        print "Content-type: text/html\n\n";
110
        print "Unable to locate skin properties at $skinProps.  Is this path correct?";
111
        exit(0);
112
    }
113
    $skinProperties->load(*SKIN_PROPERTIES);
114
}
115
116
my $config = $skinProperties->splitToTree(qr/\./, 'registry.config');
117
118
my $searchBase;
119
my $ldapUsername;
120
my $ldapPassword;
121 4728 walbridge
# TODO: when should we use surl instead? Is there a setting promoting one over the other?
122
# TODO: the default tree for accounts should be exposed somewhere, defaulting to unaffiliated
123
my $ldapurl = $properties->getProperty('auth.url');
124 4080 daigle
125
# Java uses miliseconds, Perl expects whole seconds
126 4728 walbridge
my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;
127
my $ldapdownmessage = "The main ldap server $ldapurl is down!";
128 4080 daigle
129 2341 sgarg
# Get the CGI input variables
130
my $query = new CGI;
131 4747 walbridge
my $debug = 1;
132 2341 sgarg
133
#--------------------------------------------------------------------------80c->
134
# Set up the Template Toolkit to read html form templates
135
136 4080 daigle
# templates hash, imported from ldap.templates tree in metacat.properties
137
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
138 4394 walbridge
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
139
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
140 2341 sgarg
141
# set some configuration options for the template object
142 4394 walbridge
my $ttConfig = {
143
             INCLUDE_PATH => $templatesDir,
144
             INTERPOLATE  => 0,
145
             POST_CHOMP   => 1,
146
             DEBUG        => 1,
147 2341 sgarg
             };
148
149
# create an instance of the template
150 4394 walbridge
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
151 2341 sgarg
152 4080 daigle
# custom LDAP properties hash
153
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
154 2341 sgarg
155 4394 walbridge
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
156
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
157
# pull out properties available e.g. 'name', 'base'
158
my @orgData = keys(%$orgProps);
159
my @orgList;
160
while (my ($oKey, $oVal) = each(%$orgNames)) {
161
    push(@orgList, $oKey);
162
}
163
164 4080 daigle
my $ldapConfig;
165
foreach my $o (@orgList) {
166 4394 walbridge
    foreach my $d (@orgData) {
167
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
168 4080 daigle
    }
169 4394 walbridge
    # also include DN, which is just org + base
170
    if ($ldapConfig->{$o}{'org'}) {
171
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'org'} . "," . $ldapConfig->{$o}{'base'};
172
    } else {
173
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
174
    }
175 2341 sgarg
}
176 4747 walbridge
# XXX
177
#use Data::Dumper;
178
#print "Content-type: text/plain\n\n";
179
#print Dumper($ldapConfig);
180
#exit;
181 2341 sgarg
182
#--------------------------------------------------------------------------80c->
183
# Define the main program logic that calls subroutines to do the work
184
#--------------------------------------------------------------------------80c->
185
186
187
# The processing step we are handling
188 4080 daigle
my $stage = $query->param('stage') || $templates->{'stage'};
189 2341 sgarg
190
my $cfg = $query->param('cfg');
191
192
# define the possible stages
193
my %stages = (
194
              'initregister'      => \&handleInitRegister,
195
              'register'          => \&handleRegister,
196
              'registerconfirmed' => \&handleRegisterConfirmed,
197
              'simplesearch'      => \&handleSimpleSearch,
198
              'initaddentry'      => \&handleInitAddEntry,
199
              'addentry'          => \&handleAddEntry,
200
              'initmodifyentry'   => \&handleInitModifyEntry,
201
              'modifyentry'       => \&handleModifyEntry,
202 2972 jones
              'changepass'        => \&handleChangePassword,
203
              'initchangepass'    => \&handleInitialChangePassword,
204 2341 sgarg
              'resetpass'         => \&handleResetPassword,
205 2414 sgarg
              'initresetpass'     => \&handleInitialResetPassword,
206 2341 sgarg
             );
207 4394 walbridge
208 2341 sgarg
# call the appropriate routine based on the stage
209
if ( $stages{$stage} ) {
210
  $stages{$stage}->();
211
} else {
212
  &handleResponseMessage();
213
}
214
215
#--------------------------------------------------------------------------80c->
216
# Define the subroutines to do the work
217
#--------------------------------------------------------------------------80c->
218
219 4728 walbridge
sub fullTemplate {
220
    my $templateList = shift;
221
    my $templateVars = setVars(shift);
222 2341 sgarg
223 4728 walbridge
    $template->process( $templates->{'header'}, $templateVars );
224
    foreach my $tmpl (@{$templateList}) {
225
        $template->process( $templates->{$tmpl}, $templateVars );
226
    }
227
    $template->process( $templates->{'footer'}, $templateVars );
228
}
229
230 2341 sgarg
#
231
# create the initial registration form
232
#
233
sub handleInitRegister {
234
  my $vars = shift;
235
236
  print "Content-type: text/html\n\n";
237
  # process the template files:
238 4080 daigle
  fullTemplate(['register'], {stage => "register"});
239 2341 sgarg
  exit();
240
}
241
242
#
243
# process input from the register stage, which occurs when
244
# a user submits form data to create a new account
245
#
246
sub handleRegister {
247
248
    print "Content-type: text/html\n\n";
249
250
    my $allParams = { 'givenName' => $query->param('givenName'),
251
                      'sn' => $query->param('sn'),
252
                      'o' => $query->param('o'),
253
                      'mail' => $query->param('mail'),
254
                      'uid' => $query->param('uid'),
255
                      'userPassword' => $query->param('userPassword'),
256
                      'userPassword2' => $query->param('userPassword2'),
257
                      'title' => $query->param('title'),
258
                      'telephoneNumber' => $query->param('telephoneNumber') };
259
    # Check that all required fields are provided and not null
260
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail',
261
                           'uid', 'userPassword', 'userPassword2');
262
    if (! paramsAreValid(@requiredParams)) {
263
        my $errorMessage = "Required information is missing. " .
264
            "Please fill in all required fields and resubmit the form.";
265 4080 daigle
        fullTemplate(['register'], { stage => "register",
266
                                     allParams => $allParams,
267
                                     errorMessage => $errorMessage });
268
        exit();
269 2341 sgarg
    } else {
270 2972 jones
        my $o = $query->param('o');
271 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
272 2341 sgarg
    }
273
274
    # Search LDAP for matching entries that already exist
275
    # Some forms use a single text search box, whereas others search per
276
    # attribute.
277
    my $filter;
278
    if ($query->param('searchField')) {
279
280
      $filter = "(|" .
281
                "(uid=" . $query->param('searchField') . ") " .
282
                "(mail=" . $query->param('searchField') . ")" .
283
                "(&(sn=" . $query->param('searchField') . ") " .
284
                "(givenName=" . $query->param('searchField') . "))" .
285
                ")";
286
    } else {
287
      $filter = "(|" .
288
                "(uid=" . $query->param('uid') . ") " .
289
                "(mail=" . $query->param('mail') . ")" .
290
                "(&(sn=" . $query->param('sn') . ") " .
291
                "(givenName=" . $query->param('givenName') . "))" .
292
                ")";
293
    }
294
295
    my @attrs = [ 'uid', 'o', 'cn', 'mail', 'telephoneNumber', 'title' ];
296
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
297
298
    # If entries match, send back a request to confirm new-user creation
299
    if ($found) {
300 4080 daigle
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
301
                                                     allParams => $allParams,
302
                                                     foundAccounts => $found });
303 2341 sgarg
    # Otherwise, create a new user in the LDAP directory
304
    } else {
305 3175 tao
        #print("ingore create account\n");
306 2341 sgarg
        createAccount($allParams);
307
    }
308
309
    exit();
310
}
311
312
#
313
# process input from the registerconfirmed stage, which occurs when
314
# a user chooses to create an account despite similarities to other
315
# existing accounts
316
#
317
sub handleRegisterConfirmed {
318
319
    my $allParams = { 'givenName' => $query->param('givenName'),
320
                      'sn' => $query->param('sn'),
321 4080 daigle
                      'o' => 'unaffiliated', # only accept unaffiliated registration
322 2341 sgarg
                      'mail' => $query->param('mail'),
323
                      'uid' => $query->param('uid'),
324
                      'userPassword' => $query->param('userPassword'),
325
                      'userPassword2' => $query->param('userPassword2'),
326
                      'title' => $query->param('title'),
327
                      'telephoneNumber' => $query->param('telephoneNumber') };
328
    print "Content-type: text/html\n\n";
329
    createAccount($allParams);
330
    exit();
331
}
332
333
#
334
# change a user's password upon request
335
#
336
sub handleChangePassword {
337
338
    print "Content-type: text/html\n\n";
339
340
    my $allParams = { 'test' => "1", };
341
    if ($query->param('uid')) {
342
        $$allParams{'uid'} = $query->param('uid');
343
    }
344
    if ($query->param('o')) {
345
        $$allParams{'o'} = $query->param('o');
346 2972 jones
        my $o = $query->param('o');
347
348 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
349 2341 sgarg
    }
350
351
352
    # Check that all required fields are provided and not null
353
    my @requiredParams = ( 'uid', 'o', 'oldpass',
354
                           'userPassword', 'userPassword2');
355
    if (! paramsAreValid(@requiredParams)) {
356
        my $errorMessage = "Required information is missing. " .
357
            "Please fill in all required fields and submit the form.";
358 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
359
                                        allParams => $allParams,
360
                                        errorMessage => $errorMessage });
361
        exit();
362 2341 sgarg
    }
363
364
    # We have all of the info we need, so try to change the password
365
    if ($query->param('userPassword') =~ $query->param('userPassword2')) {
366
367 2972 jones
        my $o = $query->param('o');
368 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
369
        $ldapUsername = $ldapConfig->{$o}{'user'};
370
        $ldapPassword = $ldapConfig->{$o}{'password'};
371 2341 sgarg
372 4080 daigle
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
373 2341 sgarg
        if ($query->param('o') =~ "LTER") {
374 4080 daigle
            fullTemplate( ['registerLter'] );
375 2341 sgarg
        } else {
376
            my $errorMessage = changePassword(
377
                    $dn, $query->param('userPassword'),
378
                    $dn, $query->param('oldpass'), $query->param('o'));
379 2972 jones
            if ($errorMessage) {
380 4080 daigle
                fullTemplate( ['changePass'], { stage => "changepass",
381
                                                allParams => $allParams,
382
                                                errorMessage => $errorMessage });
383
                exit();
384 2341 sgarg
            } else {
385 4080 daigle
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
386
                                                       allParams => $allParams });
387
                exit();
388 2341 sgarg
            }
389
        }
390
    } else {
391
        my $errorMessage = "The passwords do not match. Try again.";
392 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
393
                                        allParams => $allParams,
394
                                        errorMessage => $errorMessage });
395
        exit();
396 2341 sgarg
    }
397
}
398
399
#
400 2414 sgarg
# change a user's password upon request - no input params
401
# only display chagepass template without any error
402
#
403
sub handleInitialChangePassword {
404
    print "Content-type: text/html\n\n";
405
406
    my $allParams = { 'test' => "1", };
407
    my $errorMessage = "";
408 4080 daigle
    fullTemplate( ['changePass'], { stage => "changepass",
409
                                    errorMessage => $errorMessage });
410
    exit();
411 2414 sgarg
}
412
413
#
414 2341 sgarg
# reset a user's password upon request
415
#
416
sub handleResetPassword {
417
418
    print "Content-type: text/html\n\n";
419
420
    my $allParams = { 'test' => "1", };
421
    if ($query->param('uid')) {
422
        $$allParams{'uid'} = $query->param('uid');
423
    }
424
    if ($query->param('o')) {
425
        $$allParams{'o'} = $query->param('o');
426 2972 jones
        my $o = $query->param('o');
427
428 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
429
        $ldapUsername = $ldapConfig->{$o}{'user'};
430
        $ldapPassword = $ldapConfig->{$o}{'password'};
431 2341 sgarg
    }
432
433
    # Check that all required fields are provided and not null
434
    my @requiredParams = ( 'uid', 'o' );
435
    if (! paramsAreValid(@requiredParams)) {
436
        my $errorMessage = "Required information is missing. " .
437
            "Please fill in all required fields and submit the form.";
438 4080 daigle
        fullTemplate( ['resetPass'],  { stage => "resetpass",
439
                                        allParams => $allParams,
440
                                        errorMessage => $errorMessage });
441
        exit();
442 2341 sgarg
    }
443
444
    # We have all of the info we need, so try to change the password
445
    my $o = $query->param('o');
446 4080 daigle
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
447 2341 sgarg
    if ($query->param('o') =~ "LTER") {
448 4080 daigle
        fullTemplate( ['registerLter'] );
449
        exit();
450 2341 sgarg
    } else {
451
        my $errorMessage = "";
452
        my $recipient;
453
        my $userPass;
454
        my $entry = getLdapEntry($ldapurl, $searchBase,
455
                $query->param('uid'), $query->param('o'));
456
457
        if ($entry) {
458
            $recipient = $entry->get_value('mail');
459
            $userPass = getRandomPassword();
460 4080 daigle
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
461 2341 sgarg
        } else {
462
            $errorMessage = "User not found in database.  Please try again.";
463
        }
464
465
        if ($errorMessage) {
466 4080 daigle
            fullTemplate( ['resetPass'], { stage => "resetpass",
467
                                           allParams => $allParams,
468
                                           errorMessage => $errorMessage });
469
            exit();
470 2341 sgarg
        } else {
471
            my $errorMessage = sendPasswordNotification($query->param('uid'),
472 2972 jones
                    $query->param('o'), $userPass, $recipient, $cfg);
473 4080 daigle
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
474
                                                  allParams => $allParams,
475
                                                  errorMessage => $errorMessage });
476
            exit();
477 2341 sgarg
        }
478
    }
479
}
480
481
#
482 2414 sgarg
# reset a user's password upon request- no initial params
483
# only display resetpass template without any error
484
#
485
sub handleInitialResetPassword {
486
    print "Content-type: text/html\n\n";
487
    my $errorMessage = "";
488 4080 daigle
    fullTemplate( ['resetPass'], { stage => "resetpass",
489
                                   errorMessage => $errorMessage });
490
    exit();
491 2414 sgarg
}
492
493
#
494 2341 sgarg
# Construct a random string to use for a newly reset password
495
#
496
sub getRandomPassword {
497
    my $length = shift;
498
    if (!$length) {
499
        $length = 8;
500
    }
501
    my $newPass = "";
502
503
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
504
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
505
    return $newPass;
506
}
507
508
#
509
# Change a password to a new value, binding as the provided user
510
#
511
sub changePassword {
512
    my $userDN = shift;
513
    my $userPass = shift;
514
    my $bindDN = shift;
515
    my $bindPass = shift;
516
    my $o = shift;
517
518 4080 daigle
    my $searchBase = $ldapConfig->{$o}{'base'};
519 2341 sgarg
520
    my $errorMessage = 0;
521 3177 tao
    my $ldap;
522 4394 walbridge
523
		#if main ldap server is down, a html file containing warning message will be returned
524
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure($ldapdownmessage);
525
526
		#$ldap->start_tls( verify => 'require',
527 2972 jones
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
528
    $ldap->start_tls( verify => 'none');
529 2341 sgarg
    my $bindresult = $ldap->bind( version => 3, dn => $bindDN,
530
                                  password => $bindPass );
531
    if ($bindresult->code) {
532
        $errorMessage = "Failed to log in. Are you sure your old " .
533
                        "password is correct? Try again...";
534
        return $errorMessage;
535
    }
536
537
    # Find the user here and change their entry
538
    my $newpass = createSeededPassHash($userPass);
539
    my $modifications = { userPassword => $newpass };
540
    my $result = $ldap->modify( $userDN, replace => { %$modifications });
541
542
    if ($result->code()) {
543
        my $errorMessage = "There was an error changing the password." .
544
                           "<br />\n" . $result->error;
545
    }
546
    $ldap->unbind;   # take down session
547
548
    return $errorMessage;
549
}
550
551
#
552
# generate a Seeded SHA1 hash of a plaintext password
553
#
554
sub createSeededPassHash {
555
    my $secret = shift;
556
557
    my $salt = "";
558
    for (my $i=0; $i < 4; $i++) {
559
        $salt .= int(rand(10));
560
    }
561
562
    my $ctx = Digest::SHA1->new;
563
    $ctx->add($secret);
564
    $ctx->add($salt);
565
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
566
567
    return $hashedPasswd;
568
}
569
570
#
571
# Look up an ldap entry for a user
572
#
573
sub getLdapEntry {
574
    my $ldapurl = shift;
575
    my $base = shift;
576
    my $username = shift;
577
    my $org = shift;
578
579
    my $entry = "";
580
    my $mesg;
581 3177 tao
    my $ldap;
582
    print("ldap server ", $ldapurl, "\n");
583 4394 walbridge
584
    #if main ldap server is down, a html file containing warning message will be returned
585
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure($ldapdownmessage);
586 2972 jones
    $ldap->start_tls( verify => 'none');
587 2341 sgarg
    my $bindresult = $ldap->bind;
588
    if ($bindresult->code) {
589
        return $entry;
590
    }
591
592 4080 daigle
    if($ldapConfig->{$org}{'filter'}){
593 2972 jones
        $mesg = $ldap->search ( base   => $base,
594 4080 daigle
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
595 2341 sgarg
    } else {
596 2972 jones
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
597 2341 sgarg
    }
598 3177 tao
599 2341 sgarg
    if ($mesg->count > 0) {
600
        $entry = $mesg->pop_entry;
601
        $ldap->unbind;   # take down session
602
    } else {
603
        $ldap->unbind;   # take down session
604
        # Follow references by recursive call to self
605
        my @references = $mesg->references();
606
        for (my $i = 0; $i <= $#references; $i++) {
607
            my $uri = URI->new($references[$i]);
608
            my $host = $uri->host();
609
            my $path = $uri->path();
610
            $path =~ s/^\///;
611
            $entry = &getLdapEntry($host, $path, $username, $org);
612
            if ($entry) {
613
                return $entry;
614
            }
615
        }
616
    }
617
    return $entry;
618
}
619
620
#
621
# send an email message notifying the user of the pw change
622
#
623
sub sendPasswordNotification {
624
    my $username = shift;
625
    my $org = shift;
626
    my $newPass = shift;
627
    my $recipient = shift;
628 2972 jones
    my $cfg = shift;
629 2341 sgarg
630
    my $errorMessage = "";
631
    if ($recipient) {
632 4394 walbridge
				my $mailhost = $properties->getProperty('email.mailhost');
633
				my $sender =  $properties->getProperty('email.sender');
634 2341 sgarg
        # Send the email message to them
635
        my $smtp = Net::SMTP->new($mailhost);
636
        $smtp->mail($sender);
637
        $smtp->to($recipient);
638
639
        my $message = <<"        ENDOFMESSAGE";
640
        To: $recipient
641
        From: $sender
642
        Subject: KNB Password Reset
643
644
        Somebody (hopefully you) requested that your KNB password be reset.
645
        This is generally done when somebody forgets their password.  Your
646
        password can be changed by visiting the following URL:
647
648 4080 daigle
        $cgiUrl?stage=changepass&cfg=$cfg
649 2341 sgarg
650
            Username: $username
651
        Organization: $org
652
        New Password: $newPass
653
654
        Thanks,
655
            The KNB Development Team
656
657
        ENDOFMESSAGE
658
        $message =~ s/^[ \t\r\f]+//gm;
659
660
        $smtp->data($message);
661
        $smtp->quit;
662
    } else {
663
        $errorMessage = "Failed to send password because I " .
664
                        "couldn't find a valid email address.";
665
    }
666
    return $errorMessage;
667
}
668
669
#
670
# search the LDAP directory to see if a similar account already exists
671
#
672
sub findExistingAccounts {
673
    my $ldapurl = shift;
674
    my $base = shift;
675
    my $filter = shift;
676
    my $attref = shift;
677 3175 tao
    my $ldap;
678 2341 sgarg
679
    my $foundAccounts = 0;
680 3175 tao
    #print("the ldapurl in findExstingAccounts is ", $ldapurl, "\n");
681 4394 walbridge
    #if main ldap server is down, a html file containing warning message will be returned
682
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure($ldapdownmessage);
683 2972 jones
    $ldap->start_tls( verify => 'none');
684 2341 sgarg
    $ldap->bind( version => 3, anonymous => 1);
685
    my $mesg = $ldap->search (
686
        base   => $base,
687
        filter => $filter,
688
        attrs => @$attref,
689
    );
690
691
    if ($mesg->count() > 0) {
692
        $foundAccounts = "";
693
        my $entry;
694
        foreach $entry ($mesg->all_entries) {
695
            $foundAccounts .= "<p>\n<b><u>Account:</u> ";
696
            $foundAccounts .= $entry->dn();
697
            $foundAccounts .= "</b><br />\n";
698
            foreach my $attribute ($entry->attributes()) {
699
                $foundAccounts .= "$attribute: ";
700
                $foundAccounts .= $entry->get_value($attribute);
701
                $foundAccounts .= "<br />\n";
702
            }
703
            $foundAccounts .= "</p>\n";
704
        }
705
    }
706
    $ldap->unbind;   # take down session
707
708
    # Follow references
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
        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
716
        if ($refFound) {
717
            $foundAccounts .= $refFound;
718
        }
719
    }
720
721
    #print "<p>Checking referrals...</p>\n";
722
    #my @referrals = $mesg->referrals();
723
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
724
    #for (my $i = 0; $i <= $#referrals; $i++) {
725
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
726
    #}
727
728
    return $foundAccounts;
729
}
730
731
#
732
# Validate that we have the proper set of input parameters
733
#
734
sub paramsAreValid {
735
    my @pnames = @_;
736
737
    my $allValid = 1;
738
    foreach my $parameter (@pnames) {
739
        if (!defined($query->param($parameter)) ||
740
            ! $query->param($parameter) ||
741
            $query->param($parameter) =~ /^\s+$/) {
742
            $allValid = 0;
743
        }
744
    }
745
746
    return $allValid;
747
}
748
749
#
750
# Bind to LDAP and create a new account using the information provided
751
# by the user
752
#
753
sub createAccount {
754
    my $allParams = shift;
755
756
    if ($query->param('o') =~ "LTER") {
757 4080 daigle
        fullTemplate( ['registerLter'] );
758 2341 sgarg
    } else {
759
760
        # Be sure the passwords match
761
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
762
            my $errorMessage = "The passwords do not match. Try again.";
763 4080 daigle
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
764
                                                            allParams => $allParams,
765
                                                            errorMessage => $errorMessage });
766
            exit();
767 2341 sgarg
        }
768
769 2972 jones
        my $o = $query->param('o');
770 2341 sgarg
771 4080 daigle
        my $ldapUsername = $ldapConfig->{$o}{'user'};
772
        my $ldapPassword = $ldapConfig->{$o}{'password'};
773
        my $searchBase = $ldapConfig->{$o}{'base'};
774
        my $dnBase = $ldapConfig->{$o}{'dn'};
775 4748 walbridge
    		debug("LDAP connection to $ldapurl...");
776 3177 tao
        #if main ldap server is down, a html file containing warning message will be returned
777 4394 walbridge
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
778 3177 tao
779
780 2972 jones
        $ldap->start_tls( verify => 'none');
781 4747 walbridge
				debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
782 4080 daigle
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
783 2341 sgarg
        #print "Inserting new entry...\n";
784
        my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
785
786
        # Create a hashed version of the password
787
        my $shapass = createSeededPassHash($query->param('userPassword'));
788
789
        # Do the insertion
790
        my $additions = [
791
                'uid'   => $query->param('uid'),
792
                'o'   => $query->param('o'),
793
                'cn'   => join(" ", $query->param('givenName'),
794
                                    $query->param('sn')),
795
                'sn'   => $query->param('sn'),
796
                'givenName'   => $query->param('givenName'),
797
                'mail' => $query->param('mail'),
798
                'userPassword' => $shapass,
799
                'objectclass' => ['top', 'person', 'organizationalPerson',
800
                                'inetOrgPerson', 'uidObject' ]
801
            ];
802
        if (defined($query->param('telephoneNumber')) &&
803
            $query->param('telephoneNumber') &&
804
            ! $query->param('telephoneNumber') =~ /^\s+$/) {
805
            $$additions[$#$additions + 1] = 'telephoneNumber';
806
            $$additions[$#$additions + 1] = $query->param('telephoneNumber');
807
        }
808
        if (defined($query->param('title')) &&
809
            $query->param('title') &&
810
            ! $query->param('title') =~ /^\s+$/) {
811
            $$additions[$#$additions + 1] = 'title';
812
            $$additions[$#$additions + 1] = $query->param('title');
813
        }
814
        my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
815
816
        if ($result->code()) {
817 4080 daigle
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
818
                                                            allParams => $allParams,
819
                                                            errorMessage => $result->error });
820
            # TODO SCW was included as separate errors, test this
821
            #$templateVars    = setVars({ stage => "register",
822
            #                     allParams => $allParams });
823
            #$template->process( $templates->{'register'}, $templateVars);
824 2341 sgarg
        } else {
825 4080 daigle
            fullTemplate( ['success'] );
826 2341 sgarg
        }
827
828
        $ldap->unbind;   # take down session
829
    }
830
}
831
832
sub handleResponseMessage {
833
834
  print "Content-type: text/html\n\n";
835
  my $errorMessage = "You provided invalid input to the script. " .
836
                     "Try again please.";
837 4080 daigle
  fullTemplate( [], { stage => $templates->{'stage'},
838
                      errorMessage => $errorMessage });
839
  exit();
840 2341 sgarg
}
841
842
#
843
# perform a simple search against the LDAP database using
844
# a small subset of attributes of each dn and return it
845
# as a table to the calling browser.
846
#
847
sub handleSimpleSearch {
848
849
    my $o = $query->param('o');
850
851 4080 daigle
    my $ldapurl = $ldapConfig->{$o}{'url'};
852
    my $searchBase = $ldapConfig->{$o}{'base'};
853 2341 sgarg
854
    print "Content-type: text/html\n\n";
855
856
    my $allParams = {
857
                      'cn' => $query->param('cn'),
858
                      'sn' => $query->param('sn'),
859
                      'gn' => $query->param('gn'),
860
                      'o'  => $query->param('o'),
861
                      'facsimiletelephonenumber'
862
                      => $query->param('facsimiletelephonenumber'),
863
                      'mail' => $query->param('cmail'),
864
                      'telephonenumber' => $query->param('telephonenumber'),
865
                      'title' => $query->param('title'),
866
                      'uid' => $query->param('uid'),
867
                      'ou' => $query->param('ou'),
868
                    };
869
870
    # Search LDAP for matching entries that already exist
871
    my $filter = "(" .
872
                 $query->param('searchField') . "=" .
873
                 "*" .
874
                 $query->param('searchValue') .
875
                 "*" .
876
                 ")";
877
878
    my @attrs = [ 'sn',
879
                  'gn',
880
                  'cn',
881
                  'o',
882
                  'facsimiletelephonenumber',
883
                  'mail',
884
                  'telephoneNumber',
885
                  'title',
886
                  'uid',
887
                  'labeledURI',
888
                  'ou' ];
889
890
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
891
892
    # Send back the search results
893
    if ($found) {
894 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
895
                                         allParams => $allParams,
896
                                         foundAccounts => $found });
897 2341 sgarg
    } else {
898
      $found = "No entries matched your criteria.  Please try again\n";
899
900 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
901
                                         allParams => $allParams,
902
                                         foundAccounts => $found });
903 2341 sgarg
    }
904
905
    exit();
906
}
907
908
#
909
# search the LDAP directory to see if a similar account already exists
910
#
911
sub searchDirectory {
912
    my $ldapurl = shift;
913
    my $base = shift;
914
    my $filter = shift;
915
    my $attref = shift;
916
917
    my $foundAccounts = 0;
918 3177 tao
919
    #if ldap server is down, a html file containing warning message will be returned
920 4394 walbridge
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
921 3177 tao
922 2972 jones
    $ldap->start_tls( verify => 'none');
923 2341 sgarg
    $ldap->bind( version => 3, anonymous => 1);
924
    my $mesg = $ldap->search (
925
        base   => $base,
926
        filter => $filter,
927
        attrs => @$attref,
928
    );
929
930
    if ($mesg->count() > 0) {
931
        $foundAccounts = "";
932
        my $entry;
933
        foreach $entry ($mesg->sorted(['sn'])) {
934
          $foundAccounts .= "<tr>\n<td class=\"main\">\n";
935
          $foundAccounts .= "<a href=\"" unless
936
                    (!$entry->get_value('labeledURI'));
937
          $foundAccounts .= $entry->get_value('labeledURI') unless
938
                    (!$entry->get_value('labeledURI'));
939
          $foundAccounts .= "\">\n" unless
940
                    (!$entry->get_value('labeledURI'));
941
          $foundAccounts .= $entry->get_value('givenName');
942
          $foundAccounts .= "</a>\n" unless
943
                    (!$entry->get_value('labeledURI'));
944
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
945
          $foundAccounts .= "<a href=\"" unless
946
                    (!$entry->get_value('labeledURI'));
947
          $foundAccounts .= $entry->get_value('labeledURI') unless
948
                    (!$entry->get_value('labeledURI'));
949
          $foundAccounts .= "\">\n" unless
950
                    (!$entry->get_value('labeledURI'));
951
          $foundAccounts .= $entry->get_value('sn');
952
          $foundAccounts .= "</a>\n";
953
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
954
          $foundAccounts .= $entry->get_value('mail');
955
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
956
          $foundAccounts .= $entry->get_value('telephonenumber');
957
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
958
          $foundAccounts .= $entry->get_value('title');
959
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
960
          $foundAccounts .= $entry->get_value('ou');
961
          $foundAccounts .= "\n</td>\n";
962
          $foundAccounts .= "</tr>\n";
963
        }
964
    }
965
    $ldap->unbind;   # take down session
966
    return $foundAccounts;
967
}
968
969
sub debug {
970
    my $msg = shift;
971
972
    if ($debug) {
973 4747 walbridge
        print STDERR "LDAPweb: $msg\n";
974 2341 sgarg
    }
975
}
976 3175 tao
977 3177 tao
sub handleGeneralServerFailure {
978
    my $errorMessage = shift;
979 4728 walbridge
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
980 3175 tao
    exit(0);
981
   }
982
983 4080 daigle
sub setVars {
984
    my $paramVars = shift;
985
    # initialize default parameters
986
    my $templateVars = { cfg => $cfg,
987 4394 walbridge
                         styleSkinsPath => $contextUrl . "/style/skins",
988
                         styleCommonPath => $contextUrl . "/style/common",
989
                         contextUrl => $contextUrl,
990 4080 daigle
                         orgList => \@orgList,
991 4394 walbridge
                         config  => $config,
992 4080 daigle
    };
993
994
    # append customized params
995
    while (my ($k, $v) = each (%$paramVars)) {
996
        $templateVars->{$k} = $v;
997
    }
998
999
    return $templateVars;
1000
}