Project

General

Profile

1
#!/usr/bin/perl -w
2
 #
3
 #  '$RCSfile$'
4
 #  Copyright: 2001 Regents of the University of California 
5
 #
6
 #   '$Author: walbridge $'
7
 #     '$Date: 2009-03-25 15:42:04 -0700 (Wed, 25 Mar 2009) $'
8
 # '$Revision: 4864 $' 
9
 # 
10
 # This program is free software; you can redistribute it and/or modify
11
 # it under the terms of the GNU General Public License as published by
12
 # the Free Software Foundation; either version 2 of the License, or
13
 # (at your option) any later version.
14
 #
15
 # This program is distributed in the hope that it will be useful,
16
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
 # GNU General Public License for more details.
19
 #
20
 # You should have received a copy of the GNU General Public License
21
 # along with this program; if not, write to the Free Software
22
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
23
 #
24

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

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

    
43
# Global configuration paramters
44
# This entire block (including skin parsing) could be pushed out to a separate .pm file
45
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
    print "Content-type: text/html\n\n";
51
    print "Unable to locate Metacat properties. Working directory is set as " . 
52
        $workingDirectory .", is this correct?";
53
    exit(0);
54
}
55

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

    
58
# 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
if ($properties->getProperty('server.httpPort') ne '80') {
67
        $contextUrl = $contextUrl . ':' . $properties->getProperty('server.httpPort');
68
}
69
$contextUrl = $contextUrl . '/' .  $properties->getProperty('application.context');
70

    
71
my $metacatUrl = $contextUrl . "/metacat";
72
my $cgiPrefix = "/" . $properties->getProperty('application.context') . "/cgi-bin";
73
my $styleSkinsPath = $contextUrl . "/style/skins";
74
my $styleCommonPath = $contextUrl . "/style/common";
75

    
76
my @errorMessages;
77
my $error = 0;
78

    
79
# Import all of the HTML form fields as variables
80
import_names('FORM');
81

    
82
# Must have a config to use Metacat
83
my $skinName = "";
84
if ($FORM::cfg) {
85
    $skinName = $FORM::cfg;
86
} elsif ($ARGV[0]) {
87
    $skinName = $ARGV[0];
88
} else {
89
    debug("No configuration set.");
90
    print "Content-type: text/html\n\n";
91
    print 'LDAPweb Error: The registry requires a skin name to continue.';
92
    exit();
93
}
94

    
95
# Metacat isn't initialized, the registry will fail in strange ways.
96
if (!($metacatUrl)) {
97
    debug("No Metacat.");
98
    print "Content-type: text/html\n\n";
99
    'Registry Error: Metacat is not initialized! Make sure' .
100
        ' MetacatUrl is set correctly in ' .  $skinName . '.cfg';
101
    exit();
102
}
103

    
104
my $skinProperties = new Config::Properties();
105
if (!($skinName)) {
106
    $error = "Application misconfigured.  Please contact the administrator.";
107
    push(@errorMessages, $error);
108
} else {
109
    my $skinProps = "$skinsDir/$skinName/$skinName.properties";
110
    unless (open (SKIN_PROPERTIES, $skinProps)) {
111
        print "Content-type: text/html\n\n";
112
        print "Unable to locate skin properties at $skinProps.  Is this path correct?";
113
        exit(0);
114
    }
115
    $skinProperties->load(*SKIN_PROPERTIES);
116
}
117

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

    
120
my $searchBase;
121
my $ldapUsername;
122
my $ldapPassword;
123
# TODO: when should we use surl instead? Is there a setting promoting one over the other?
124
# TODO: the default tree for accounts should be exposed somewhere, defaulting to unaffiliated
125
my $ldapurl = $properties->getProperty('auth.url');
126

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

    
130
# Get the CGI input variables
131
my $query = new CGI;
132
my $debug = 1;
133

    
134
#--------------------------------------------------------------------------80c->
135
# Set up the Template Toolkit to read html form templates
136

    
137
# templates hash, imported from ldap.templates tree in metacat.properties
138
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
139
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
140
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
141

    
142
# set some configuration options for the template object
143
my $ttConfig = {
144
             INCLUDE_PATH => $templatesDir,
145
             INTERPOLATE  => 0,
146
             POST_CHOMP   => 1,
147
             DEBUG        => 1, 
148
             };
149

    
150
# create an instance of the template
151
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
152

    
153
# custom LDAP properties hash
154
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
155

    
156
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
157
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
158
# pull out properties available e.g. 'name', 'base'
159
my @orgData = keys(%$orgProps);
160
my @orgList;
161
while (my ($oKey, $oVal) = each(%$orgNames)) {
162
    push(@orgList, $oKey);
163
}
164

    
165
my $ldapConfig;
166
foreach my $o (@orgList) {
167
    foreach my $d (@orgData) {
168
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
169
    }
170
    # also include DN, which is just org + base
171
    if ($ldapConfig->{$o}{'org'}) {
172
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'org'} . "," . $ldapConfig->{$o}{'base'};
173
    } else {
174
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
175
    }
176
}
177

    
178
#--------------------------------------------------------------------------80c->
179
# Define the main program logic that calls subroutines to do the work
180
#--------------------------------------------------------------------------80c->
181

    
182
# The processing step we are handling
183
my $stage = $query->param('stage') || $templates->{'stage'};
184

    
185
my $cfg = $query->param('cfg');
186
debug("started with stage $stage, cfg $cfg");
187

    
188
# define the possible stages
189
my %stages = (
190
              'initregister'      => \&handleInitRegister,
191
              'register'          => \&handleRegister,
192
              'registerconfirmed' => \&handleRegisterConfirmed,
193
              'simplesearch'      => \&handleSimpleSearch,
194
              'initaddentry'      => \&handleInitAddEntry,
195
              'addentry'          => \&handleAddEntry,
196
              'initmodifyentry'   => \&handleInitModifyEntry,
197
              'modifyentry'       => \&handleModifyEntry,
198
              'changepass'        => \&handleChangePassword,
199
              'initchangepass'    => \&handleInitialChangePassword,
200
              'resetpass'         => \&handleResetPassword,
201
              'initresetpass'     => \&handleInitialResetPassword,
202
             );
203

    
204
# call the appropriate routine based on the stage
205
if ( $stages{$stage} ) {
206
  $stages{$stage}->();
207
} else {
208
  &handleResponseMessage();
209
}
210

    
211
#--------------------------------------------------------------------------80c->
212
# Define the subroutines to do the work
213
#--------------------------------------------------------------------------80c->
214

    
215
sub fullTemplate {
216
    my $templateList = shift;
217
    my $templateVars = setVars(shift);
218

    
219
    $template->process( $templates->{'header'}, $templateVars );
220
    foreach my $tmpl (@{$templateList}) {
221
        $template->process( $templates->{$tmpl}, $templateVars );
222
    }
223
    $template->process( $templates->{'footer'}, $templateVars );
224
}
225

    
226
#
227
# create the initial registration form 
228
#
229
sub handleInitRegister {
230
  my $vars = shift;
231

    
232
  print "Content-type: text/html\n\n";
233
  # process the template files:
234
  fullTemplate(['register'], {stage => "register"}); 
235
  exit();
236
}
237

    
238
#
239
# process input from the register stage, which occurs when
240
# a user submits form data to create a new account
241
#
242
sub handleRegister {
243
    
244
    print "Content-type: text/html\n\n";
245

    
246
    my $allParams = { 'givenName' => $query->param('givenName'), 
247
                      'sn' => $query->param('sn'),
248
                      'o' => $query->param('o'), 
249
                      'mail' => $query->param('mail'), 
250
                      'uid' => $query->param('uid'), 
251
                      'userPassword' => $query->param('userPassword'), 
252
                      'userPassword2' => $query->param('userPassword2'), 
253
                      'title' => $query->param('title'), 
254
                      'telephoneNumber' => $query->param('telephoneNumber') };
255
    # Check that all required fields are provided and not null
256
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
257
                           'uid', 'userPassword', 'userPassword2');
258
    if (! paramsAreValid(@requiredParams)) {
259
        my $errorMessage = "Required information is missing. " .
260
            "Please fill in all required fields and resubmit the form.";
261
        fullTemplate(['register'], { stage => "register",
262
                                     allParams => $allParams,
263
                                     errorMessage => $errorMessage });
264
        exit();
265
    } else {
266
        my $o = $query->param('o');    
267
        $searchBase = $ldapConfig->{$o}{'base'};  
268
    }
269

    
270
    # Search LDAP for matching entries that already exist
271
    # Some forms use a single text search box, whereas others search per
272
    # attribute.
273
    my $filter;
274
    if ($query->param('searchField')) {
275

    
276
      $filter = "(|" . 
277
                "(uid=" . $query->param('searchField') . ") " .
278
                "(mail=" . $query->param('searchField') . ")" .
279
                "(&(sn=" . $query->param('searchField') . ") " . 
280
                "(givenName=" . $query->param('searchField') . "))" . 
281
                ")";
282
    } else {
283
      $filter = "(|" . 
284
                "(uid=" . $query->param('uid') . ") " .
285
                "(mail=" . $query->param('mail') . ")" .
286
                "(&(sn=" . $query->param('sn') . ") " . 
287
                "(givenName=" . $query->param('givenName') . "))" . 
288
                ")";
289
    }
290

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

    
294
    # If entries match, send back a request to confirm new-user creation
295
    if ($found) {
296
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
297
                                                     allParams => $allParams,
298
                                                     foundAccounts => $found });
299
    # Otherwise, create a new user in the LDAP directory
300
    } else {
301
        createAccount($allParams);
302
    }
303

    
304
    exit();
305
}
306

    
307
#
308
# process input from the registerconfirmed stage, which occurs when
309
# a user chooses to create an account despite similarities to other
310
# existing accounts
311
#
312
sub handleRegisterConfirmed {
313
  
314
    my $allParams = { 'givenName' => $query->param('givenName'), 
315
                      'sn' => $query->param('sn'),
316
                      'o' => 'unaffiliated', # only accept unaffiliated registration
317
                      'mail' => $query->param('mail'), 
318
                      'uid' => $query->param('uid'), 
319
                      'userPassword' => $query->param('userPassword'), 
320
                      'userPassword2' => $query->param('userPassword2'), 
321
                      'title' => $query->param('title'), 
322
                      'telephoneNumber' => $query->param('telephoneNumber') };
323
    print "Content-type: text/html\n\n";
324
    createAccount($allParams);
325
    exit();
326
}
327

    
328
#
329
# change a user's password upon request
330
#
331
sub handleChangePassword {
332

    
333
    print "Content-type: text/html\n\n";
334

    
335
    my $allParams = { 'test' => "1", };
336
    if ($query->param('uid')) {
337
        $$allParams{'uid'} = $query->param('uid');
338
    }
339
    if ($query->param('o')) {
340
        $$allParams{'o'} = $query->param('o');
341
        my $o = $query->param('o');
342
        
343
        $searchBase = $ldapConfig->{$o}{'base'};
344
    }
345

    
346

    
347
    # Check that all required fields are provided and not null
348
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
349
                           'userPassword', 'userPassword2');
350
    if (! paramsAreValid(@requiredParams)) {
351
        my $errorMessage = "Required information is missing. " .
352
            "Please fill in all required fields and submit the form.";
353
        fullTemplate( ['changePass'], { stage => "changepass",
354
                                        allParams => $allParams,
355
                                        errorMessage => $errorMessage });
356
        exit();
357
    }
358

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

    
362
        my $o = $query->param('o');
363
        $searchBase = $ldapConfig->{$o}{'base'};
364
        $ldapUsername = $ldapConfig->{$o}{'user'};
365
        $ldapPassword = $ldapConfig->{$o}{'password'};
366

    
367
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
368
        if ($query->param('o') =~ "LTER") {
369
            fullTemplate( ['registerLter'] );
370
        } else {
371
            my $errorMessage = changePassword(
372
                    $dn, $query->param('userPassword'), 
373
                    $dn, $query->param('oldpass'), $query->param('o'));
374
            if ($errorMessage) {
375
                fullTemplate( ['changePass'], { stage => "changepass",
376
                                                allParams => $allParams,
377
                                                errorMessage => $errorMessage });
378
                exit();
379
            } else {
380
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
381
                                                       allParams => $allParams });
382
                exit();
383
            }
384
        }
385
    } else {
386
        my $errorMessage = "The passwords do not match. Try again.";
387
        fullTemplate( ['changePass'], { stage => "changepass",
388
                                        allParams => $allParams,
389
                                        errorMessage => $errorMessage });
390
        exit();
391
    }
392
}
393

    
394
#
395
# change a user's password upon request - no input params
396
# only display chagepass template without any error
397
#
398
sub handleInitialChangePassword {
399
    print "Content-type: text/html\n\n";
400

    
401
    my $allParams = { 'test' => "1", };
402
    my $errorMessage = "";
403
    fullTemplate( ['changePass'], { stage => "changepass",
404
                                    errorMessage => $errorMessage });
405
    exit();
406
}
407

    
408
#
409
# reset a user's password upon request
410
#
411
sub handleResetPassword {
412

    
413
    print "Content-type: text/html\n\n";
414

    
415
    my $allParams = { 'test' => "1", };
416
    if ($query->param('uid')) {
417
        $$allParams{'uid'} = $query->param('uid');
418
    }
419
    if ($query->param('o')) {
420
        $$allParams{'o'} = $query->param('o');
421
        my $o = $query->param('o');
422
        
423
        $searchBase = $ldapConfig->{$o}{'base'};
424
        $ldapUsername = $ldapConfig->{$o}{'user'} . ',' . $searchBase;
425
        $ldapPassword = $ldapConfig->{$o}{'password'};
426
    }
427

    
428
    # Check that all required fields are provided and not null
429
    my @requiredParams = ( 'uid', 'o' );
430
    if (! paramsAreValid(@requiredParams)) {
431
        my $errorMessage = "Required information is missing. " .
432
            "Please fill in all required fields and submit the form.";
433
        fullTemplate( ['resetPass'],  { stage => "resetpass",
434
                                        allParams => $allParams,
435
                                        errorMessage => $errorMessage });
436
        exit();
437
    }
438

    
439
    # We have all of the info we need, so try to change the password
440
    my $o = $query->param('o');
441
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
442
    if ($query->param('o') =~ "LTER") {
443
        fullTemplate( ['registerLter'] );
444
        exit();
445
    } else {
446
        my $errorMessage = "";
447
        my $recipient;
448
        my $userPass;
449
        my $entry = getLdapEntry($ldapurl, $searchBase, 
450
                $query->param('uid'), $query->param('o'));
451

    
452
        if ($entry) {
453
            $recipient = $entry->get_value('mail');
454
            $userPass = getRandomPassword();
455
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
456
        } else {
457
            $errorMessage = "User not found in database.  Please try again.";
458
        }
459

    
460
        if ($errorMessage) {
461
            fullTemplate( ['resetPass'], { stage => "resetpass",
462
                                           allParams => $allParams,
463
                                           errorMessage => $errorMessage });
464
            exit();
465
        } else {
466
            my $errorMessage = sendPasswordNotification($query->param('uid'),
467
                    $query->param('o'), $userPass, $recipient, $cfg);
468
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
469
                                                  allParams => $allParams,
470
                                                  errorMessage => $errorMessage });
471
            exit();
472
        }
473
    }
474
}
475

    
476
#
477
# reset a user's password upon request- no initial params
478
# only display resetpass template without any error
479
#
480
sub handleInitialResetPassword {
481
    print "Content-type: text/html\n\n";
482
    my $errorMessage = "";
483
    fullTemplate( ['resetPass'], { stage => "resetpass",
484
                                   errorMessage => $errorMessage });
485
    exit();
486
}
487

    
488
#
489
# Construct a random string to use for a newly reset password
490
#
491
sub getRandomPassword {
492
    my $length = shift;
493
    if (!$length) {
494
        $length = 8;
495
    }
496
    my $newPass = "";
497

    
498
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
499
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
500
    return $newPass;
501
}
502

    
503
#
504
# Change a password to a new value, binding as the provided user
505
#
506
sub changePassword {
507
    my $userDN = shift;
508
    my $userPass = shift;
509
    my $bindDN = shift;
510
    my $bindPass = shift;
511
    my $o = shift;
512

    
513
    my $searchBase = $ldapConfig->{$o}{'base'};
514
    
515
    my $errorMessage = 0;
516
    my $ldap;
517
    
518
    #if main ldap server is down, a html file containing warning message will be returned
519
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
520
    
521
    if ($ldap) {
522
    	#$ldap->start_tls( verify => 'require',
523
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
524
    	$ldap->start_tls( verify => 'none');
525
    	my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
526
                                  password => $bindPass );
527
    	if ($bindresult->code) {
528
        	$errorMessage = "Failed to log in. Are you sure your connection credentails are " .
529
                        "correct? Please correct and try again...";
530
       	 	return $errorMessage;
531
    	}
532

    
533
    	# Find the user here and change their entry
534
    	my $newpass = createSeededPassHash($userPass);
535
    	my $modifications = { userPassword => $newpass };
536
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
537
    
538
    	if ($result->code()) {
539
        	my $errorMessage = "There was an error changing the password." .
540
                           "<br />\n" . $result->error;
541
    	} 
542
    	$ldap->unbind;   # take down session
543
    }
544

    
545
    return $errorMessage;
546
}
547

    
548
#
549
# generate a Seeded SHA1 hash of a plaintext password
550
#
551
sub createSeededPassHash {
552
    my $secret = shift;
553

    
554
    my $salt = "";
555
    for (my $i=0; $i < 4; $i++) {
556
        $salt .= int(rand(10));
557
    }
558

    
559
    my $ctx = Digest::SHA1->new;
560
    $ctx->add($secret);
561
    $ctx->add($salt);
562
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
563

    
564
    return $hashedPasswd;
565
}
566

    
567
#
568
# Look up an ldap entry for a user
569
#
570
sub getLdapEntry {
571
    my $ldapurl = shift;
572
    my $base = shift;
573
    my $username = shift;
574
    my $org = shift;
575

    
576
    my $entry = "";
577
    my $mesg;
578
    my $ldap;
579
    debug("ldap server: $ldapurl");
580

    
581
    #if main ldap server is down, a html file containing warning message will be returned
582
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
583
    
584
    if ($ldap) {
585
    	$ldap->start_tls( verify => 'none');
586
    	my $bindresult = $ldap->bind;
587
    	if ($bindresult->code) {
588
        	return $entry;
589
    	}
590

    
591
    	if($ldapConfig->{$org}{'filter'}){
592
        	$mesg = $ldap->search ( base   => $base,
593
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
594
    	} else {
595
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
596
    	}
597
    
598
    	if ($mesg->count > 0) {
599
        	$entry = $mesg->pop_entry;
600
        	$ldap->unbind;   # take down session
601
    	} else {
602
        	$ldap->unbind;   # take down session
603
        	# Follow references by recursive call to self
604
        	my @references = $mesg->references();
605
        	for (my $i = 0; $i <= $#references; $i++) {
606
            	my $uri = URI->new($references[$i]);
607
            	my $host = $uri->host();
608
            	my $path = $uri->path();
609
            	$path =~ s/^\///;
610
            	$entry = &getLdapEntry($host, $path, $username, $org);
611
            	if ($entry) {
612
                	return $entry;
613
            	}
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
    my $cfg = shift;
629

    
630
    my $errorMessage = "";
631
    if ($recipient) {
632
        my $mailhost = $properties->getProperty('email.mailhost');
633
        my $sender =  $properties->getProperty('email.sender');
634
        # Send the email message to them
635
        debug("sending notification: $mailhost, $sender, $recipient");
636
        my $smtp = Net::SMTP->new($mailhost);
637
        $smtp->mail($sender);
638
        $smtp->to($recipient);
639

    
640
        my $message = <<"        ENDOFMESSAGE";
641
        To: $recipient
642
        From: $sender
643
        Subject: KNB Password Reset
644
        
645
        Somebody (hopefully you) requested that your KNB password be reset.  
646
        This is generally done when somebody forgets their password.  Your 
647
        password can be changed by visiting the following URL:
648

    
649
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
650

    
651
            Username: $username
652
        Organization: $org
653
        New Password: $newPass
654

    
655
        Thanks,
656
            The KNB Development Team
657
    
658
        ENDOFMESSAGE
659
        $message =~ s/^[ \t\r\f]+//gm;
660
    
661
        $smtp->data($message);
662
        $smtp->quit;
663
    } else {
664
        $errorMessage = "Failed to send password because I " .
665
                        "couldn't find a valid email address.";
666
    }
667
    return $errorMessage;
668
}
669

    
670
#
671
# search the LDAP directory to see if a similar account already exists
672
#
673
sub findExistingAccounts {
674
    my $ldapurl = shift;
675
    my $base = shift;
676
    my $filter = shift;
677
    my $attref = shift;
678
    my $ldap;
679
    my $mesg;
680

    
681
    my $foundAccounts = 0;
682

    
683
    #if main ldap server is down, a html file containing warning message will be returned
684
    debug("connecting to LDAP in findExistingAccounts with settings $ldapurl, $timeout");
685
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
686
    if ($ldap) {
687
    	$ldap->start_tls( verify => 'none');
688
    	$ldap->bind( version => 3, anonymous => 1);
689
		$mesg = $ldap->search (
690
			base   => $base,
691
			filter => $filter,
692
			attrs => @$attref,
693
		);
694

    
695
	    if ($mesg->count() > 0) {
696
			$foundAccounts = "";
697
			my $entry;
698
			foreach $entry ($mesg->all_entries) { 
699
				$foundAccounts .= "<p>\n<b><u>Account:</u> ";
700
				$foundAccounts .= $entry->dn();
701
				$foundAccounts .= "</b><br />\n";
702
				foreach my $attribute ($entry->attributes()) {
703
					$foundAccounts .= "$attribute: ";
704
					$foundAccounts .= $entry->get_value($attribute);
705
					$foundAccounts .= "<br />\n";
706
				}
707
				$foundAccounts .= "</p>\n";
708
			}
709
        }
710
    	$ldap->unbind;   # take down session
711

    
712
    	# Follow references
713
    	my @references = $mesg->references();
714
    	for (my $i = 0; $i <= $#references; $i++) {
715
        	my $uri = URI->new($references[$i]);
716
        	my $host = $uri->host();
717
        	my $path = $uri->path();
718
        	$path =~ s/^\///;
719
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
720
        	if ($refFound) {
721
            	$foundAccounts .= $refFound;
722
        	}
723
    	}
724
    }
725

    
726
    #print "<p>Checking referrals...</p>\n";
727
    #my @referrals = $mesg->referrals();
728
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
729
    #for (my $i = 0; $i <= $#referrals; $i++) {
730
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
731
    #}
732

    
733
    return $foundAccounts;
734
}
735

    
736
#
737
# Validate that we have the proper set of input parameters
738
#
739
sub paramsAreValid {
740
    my @pnames = @_;
741

    
742
    my $allValid = 1;
743
    foreach my $parameter (@pnames) {
744
        if (!defined($query->param($parameter)) || 
745
            ! $query->param($parameter) ||
746
            $query->param($parameter) =~ /^\s+$/) {
747
            $allValid = 0;
748
        }
749
    }
750

    
751
    return $allValid;
752
}
753

    
754
#
755
# Bind to LDAP and create a new account using the information provided
756
# by the user
757
#
758
sub createAccount {
759
    my $allParams = shift;
760

    
761
    if ($query->param('o') =~ "LTER") {
762
        fullTemplate( ['registerLter'] );
763
    } else {
764

    
765
        # Be sure the passwords match
766
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
767
            my $errorMessage = "The passwords do not match. Try again.";
768
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
769
                                                            allParams => $allParams,
770
                                                            errorMessage => $errorMessage });
771
            exit();
772
        }
773

    
774
        my $o = $query->param('o');
775

    
776
        my $searchBase = $ldapConfig->{$o}{'base'};
777
        my $dnBase = $ldapConfig->{$o}{'dn'};
778
        my $ldapUsername = $ldapConfig->{$o}{'user'} . ',' . $searchBase;
779
        my $ldapPassword = $ldapConfig->{$o}{'password'};
780
        debug("LDAP connection to $ldapurl...");    
781
        #if main ldap server is down, a html file containing warning message will be returned
782
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
783
        
784
        if ($ldap) {
785
        	$ldap->start_tls( verify => 'none');
786
        	debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
787
        	$ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
788
        
789
        	my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
790
        	debug("Inserting new entry for: $dn");
791

    
792
        	# Create a hashed version of the password
793
        	my $shapass = createSeededPassHash($query->param('userPassword'));
794

    
795
        	# Do the insertion
796
        	my $additions = [ 
797
                'uid'   => $query->param('uid'),
798
                'o'   => $query->param('o'),
799
                'cn'   => join(" ", $query->param('givenName'), 
800
                                    $query->param('sn')),
801
                'sn'   => $query->param('sn'),
802
                'givenName'   => $query->param('givenName'),
803
                'mail' => $query->param('mail'),
804
                'userPassword' => $shapass,
805
                'objectclass' => ['top', 'person', 'organizationalPerson', 
806
                                'inetOrgPerson', 'uidObject' ]
807
            	];
808
        	if (defined($query->param('telephoneNumber')) && 
809
            	$query->param('telephoneNumber') &&
810
            	! $query->param('telephoneNumber') =~ /^\s+$/) {
811
            	$$additions[$#$additions + 1] = 'telephoneNumber';
812
            	$$additions[$#$additions + 1] = $query->param('telephoneNumber');
813
        	}
814
        	if (defined($query->param('title')) && 
815
            	$query->param('title') &&
816
            	! $query->param('title') =~ /^\s+$/) {
817
            	$$additions[$#$additions + 1] = 'title';
818
            	$$additions[$#$additions + 1] = $query->param('title');
819
        	}
820
        	my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
821
    
822
        	if ($result->code()) {
823
            	fullTemplate( ['registerFailed', 'register'], { stage => "register",
824
                                                            allParams => $allParams,
825
                                                            errorMessage => $result->error });
826
            	# TODO SCW was included as separate errors, test this
827
           	 	#$templateVars    = setVars({ stage => "register",
828
           	 	#                     allParams => $allParams });
829
            	#$template->process( $templates->{'register'}, $templateVars);
830
        	} else {
831
            	fullTemplate( ['success'] );
832
        	}
833

    
834
        	$ldap->unbind;   # take down session
835
        }
836
    }
837
}
838

    
839
sub handleResponseMessage {
840

    
841
  print "Content-type: text/html\n\n";
842
  my $errorMessage = "You provided invalid input to the script. " .
843
                     "Try again please.";
844
  fullTemplate( [], { stage => $templates->{'stage'},
845
                      errorMessage => $errorMessage });
846
  exit();
847
}
848

    
849
#
850
# perform a simple search against the LDAP database using 
851
# a small subset of attributes of each dn and return it
852
# as a table to the calling browser.
853
#
854
sub handleSimpleSearch {
855

    
856
    my $o = $query->param('o');
857

    
858
    my $ldapurl = $ldapConfig->{$o}{'url'};
859
    my $searchBase = $ldapConfig->{$o}{'base'};
860

    
861
    print "Content-type: text/html\n\n";
862

    
863
    my $allParams = { 
864
                      'cn' => $query->param('cn'),
865
                      'sn' => $query->param('sn'),
866
                      'gn' => $query->param('gn'),
867
                      'o'  => $query->param('o'),
868
                      'facsimiletelephonenumber' 
869
                      => $query->param('facsimiletelephonenumber'),
870
                      'mail' => $query->param('cmail'),
871
                      'telephonenumber' => $query->param('telephonenumber'),
872
                      'title' => $query->param('title'),
873
                      'uid' => $query->param('uid'),
874
                      'ou' => $query->param('ou'),
875
                    };
876

    
877
    # Search LDAP for matching entries that already exist
878
    my $filter = "(" . 
879
                 $query->param('searchField') . "=" .
880
                 "*" .
881
                 $query->param('searchValue') .
882
                 "*" .
883
                 ")";
884

    
885
    my @attrs = [ 'sn', 
886
                  'gn', 
887
                  'cn', 
888
                  'o', 
889
                  'facsimiletelephonenumber', 
890
                  'mail', 
891
                  'telephoneNumber', 
892
                  'title', 
893
                  'uid', 
894
                  'labeledURI', 
895
                  'ou' ];
896

    
897
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
898

    
899
    # Send back the search results
900
    if ($found) {
901
      fullTemplate( ('searchResults'), { stage => "searchresults",
902
                                         allParams => $allParams,
903
                                         foundAccounts => $found });
904
    } else {
905
      $found = "No entries matched your criteria.  Please try again\n";
906

    
907
      fullTemplate( ('searchResults'), { stage => "searchresults",
908
                                         allParams => $allParams,
909
                                         foundAccounts => $found });
910
    }
911

    
912
    exit();
913
}
914

    
915
#
916
# search the LDAP directory to see if a similar account already exists
917
#
918
sub searchDirectory {
919
    my $ldapurl = shift;
920
    my $base = shift;
921
    my $filter = shift;
922
    my $attref = shift;
923

    
924
	my $mesg;
925
    my $foundAccounts = 0;
926
    
927
    #if ldap server is down, a html file containing warning message will be returned
928
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
929
    
930
    if ($ldap) {
931
    	$ldap->start_tls( verify => 'none');
932
    	$ldap->bind( version => 3, anonymous => 1);
933
    	my $mesg = $ldap->search (
934
        	base   => $base,
935
        	filter => $filter,
936
        	attrs => @$attref,
937
    	);
938

    
939
    	if ($mesg->count() > 0) {
940
        	$foundAccounts = "";
941
        	my $entry;
942
        	foreach $entry ($mesg->sorted(['sn'])) {
943
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
944
          		$foundAccounts .= "<a href=\"" unless 
945
                    (!$entry->get_value('labeledURI'));
946
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
947
                    (!$entry->get_value('labeledURI'));
948
          		$foundAccounts .= "\">\n" unless 
949
                    (!$entry->get_value('labeledURI'));
950
          		$foundAccounts .= $entry->get_value('givenName');
951
          		$foundAccounts .= "</a>\n" unless 
952
                    (!$entry->get_value('labeledURI'));
953
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
954
          		$foundAccounts .= "<a href=\"" unless 
955
                    (!$entry->get_value('labeledURI'));
956
          		$foundAccounts .= $entry->get_value('labeledURI') unless
957
                    (!$entry->get_value('labeledURI'));
958
          		$foundAccounts .= "\">\n" unless 
959
                    (!$entry->get_value('labeledURI'));
960
          		$foundAccounts .= $entry->get_value('sn');
961
          		$foundAccounts .= "</a>\n";
962
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
963
          		$foundAccounts .= $entry->get_value('mail');
964
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
965
          		$foundAccounts .= $entry->get_value('telephonenumber');
966
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
967
          		$foundAccounts .= $entry->get_value('title');
968
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
969
          		$foundAccounts .= $entry->get_value('ou');
970
          		$foundAccounts .= "\n</td>\n";
971
          		$foundAccounts .= "</tr>\n";
972
        	}
973
    	}
974
    	$ldap->unbind;   # take down session
975
    }
976
    return $foundAccounts;
977
}
978

    
979
sub debug {
980
    my $msg = shift;
981
    
982
    if ($debug) {
983
        print STDERR "LDAPweb: $msg\n";
984
    }
985
}
986

    
987
sub handleLDAPBindFailure {
988
    my $ldapAttemptUrl = shift;
989
    my $primaryLdap =  $properties->getProperty('auth.url');
990

    
991
    if ($ldapAttemptUrl eq  $primaryLdap) {
992
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
993
    } else {
994
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
995
    }
996
}
997

    
998
sub handleGeneralServerFailure {
999
    my $errorMessage = shift;
1000
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1001
    exit(0);   
1002
   }
1003
    
1004
sub setVars {
1005
    my $paramVars = shift;
1006
    # initialize default parameters 
1007
    my $templateVars = { cfg => $cfg,
1008
                         styleSkinsPath => $contextUrl . "/style/skins",
1009
                         styleCommonPath => $contextUrl . "/style/common",
1010
                         contextUrl => $contextUrl,
1011
                         cgiPrefix => $cgiPrefix,
1012
                         orgList => \@orgList,
1013
                         config  => $config,
1014
    };
1015
    
1016
    # append customized params
1017
    while (my ($k, $v) = each (%$paramVars)) {
1018
        $templateVars->{$k} = $v;
1019
    }
1020
    
1021
    return $templateVars;
1022
} 
(10-10/14)