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-01-13 17:20:55 -0800 (Tue, 13 Jan 2009) $'
8
 # '$Revision: 4747 $' 
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
                 $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
    debug("No configuration set.");
88
    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
    debug("No Metacat.");
96
    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
# 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

    
125
# Java uses miliseconds, Perl expects whole seconds
126
my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;
127
my $ldapdownmessage = "The main ldap server $ldapurl is down!";
128

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

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

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

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

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

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

    
155
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
my $ldapConfig;
165
foreach my $o (@orgList) {
166
    foreach my $d (@orgData) {
167
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
168
    }
169
    # 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
}
176
# XXX
177
#use Data::Dumper;
178
#print "Content-type: text/plain\n\n";
179
#print Dumper($ldapConfig);
180
#exit;
181

    
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
my $stage = $query->param('stage') || $templates->{'stage'};
189

    
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
              'changepass'        => \&handleChangePassword,
203
              'initchangepass'    => \&handleInitialChangePassword,
204
              'resetpass'         => \&handleResetPassword,
205
              'initresetpass'     => \&handleInitialResetPassword,
206
             );
207

    
208
# 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
sub fullTemplate {
220
    my $templateList = shift;
221
    my $templateVars = setVars(shift);
222

    
223
    $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
#
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
  fullTemplate(['register'], {stage => "register"}); 
239
  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
        fullTemplate(['register'], { stage => "register",
266
                                     allParams => $allParams,
267
                                     errorMessage => $errorMessage });
268
        exit();
269
    } else {
270
        my $o = $query->param('o');    
271
        $searchBase = $ldapConfig->{$o}{'base'};  
272
    }
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
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
301
                                                     allParams => $allParams,
302
                                                     foundAccounts => $found });
303
    # Otherwise, create a new user in the LDAP directory
304
    } else {
305
        #print("ingore create account\n");
306
        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
                      'o' => 'unaffiliated', # only accept unaffiliated registration
322
                      '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
        my $o = $query->param('o');
347
        
348
        $searchBase = $ldapConfig->{$o}{'base'};
349
    }
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
        fullTemplate( ['changePass'], { stage => "changepass",
359
                                        allParams => $allParams,
360
                                        errorMessage => $errorMessage });
361
        exit();
362
    }
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
        my $o = $query->param('o');
368
        $searchBase = $ldapConfig->{$o}{'base'};
369
        $ldapUsername = $ldapConfig->{$o}{'user'};
370
        $ldapPassword = $ldapConfig->{$o}{'password'};
371

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

    
399
#
400
# 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
    fullTemplate( ['changePass'], { stage => "changepass",
409
                                    errorMessage => $errorMessage });
410
    exit();
411
}
412

    
413
#
414
# 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
        my $o = $query->param('o');
427
        
428
        $searchBase = $ldapConfig->{$o}{'base'};
429
        $ldapUsername = $ldapConfig->{$o}{'user'};
430
        $ldapPassword = $ldapConfig->{$o}{'password'};
431
    }
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
        fullTemplate( ['resetPass'],  { stage => "resetpass",
439
                                        allParams => $allParams,
440
                                        errorMessage => $errorMessage });
441
        exit();
442
    }
443

    
444
    # We have all of the info we need, so try to change the password
445
    my $o = $query->param('o');
446
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
447
    if ($query->param('o') =~ "LTER") {
448
        fullTemplate( ['registerLter'] );
449
        exit();
450
    } 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
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
461
        } else {
462
            $errorMessage = "User not found in database.  Please try again.";
463
        }
464

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

    
481
#
482
# 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
    fullTemplate( ['resetPass'], { stage => "resetpass",
489
                                   errorMessage => $errorMessage });
490
    exit();
491
}
492

    
493
#
494
# 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
    my $searchBase = $ldapConfig->{$o}{'base'};
519
    
520
    my $errorMessage = 0;
521
    my $ldap;
522
    
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
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
528
    $ldap->start_tls( verify => 'none');
529
    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
    my $ldap;
582
    print("ldap server ", $ldapurl, "\n");
583

    
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
    $ldap->start_tls( verify => 'none');
587
    my $bindresult = $ldap->bind;
588
    if ($bindresult->code) {
589
        return $entry;
590
    }
591

    
592
    if($ldapConfig->{$org}{'filter'}){
593
        $mesg = $ldap->search ( base   => $base,
594
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
595
    } else {
596
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
597
    }
598
    
599
    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
    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
        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
        $cgiUrl?stage=changepass&cfg=$cfg
649

    
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
    my $ldap;
678

    
679
    my $foundAccounts = 0;
680
    #print("the ldapurl in findExstingAccounts is ", $ldapurl, "\n");
681
    #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
    $ldap->start_tls( verify => 'none');
684
    $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
        fullTemplate( ['registerLter'] );
758
    } 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
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
764
                                                            allParams => $allParams,
765
                                                            errorMessage => $errorMessage });
766
            exit();
767
        }
768

    
769
        my $o = $query->param('o');
770

    
771
        my $ldapUsername = $ldapConfig->{$o}{'user'};
772
        my $ldapPassword = $ldapConfig->{$o}{'password'};
773
        my $searchBase = $ldapConfig->{$o}{'base'};
774
        my $dnBase = $ldapConfig->{$o}{'dn'};
775
        
776
        #if main ldap server is down, a html file containing warning message will be returned
777
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
778
        
779
        
780
        $ldap->start_tls( verify => 'none');
781
				debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
782
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
783
        #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
            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
        } else {
825
            fullTemplate( ['success'] );
826
        }
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
  fullTemplate( [], { stage => $templates->{'stage'},
838
                      errorMessage => $errorMessage });
839
  exit();
840
}
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
    my $ldapurl = $ldapConfig->{$o}{'url'};
852
    my $searchBase = $ldapConfig->{$o}{'base'};
853

    
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
      fullTemplate( ('searchResults'), { stage => "searchresults",
895
                                         allParams => $allParams,
896
                                         foundAccounts => $found });
897
    } else {
898
      $found = "No entries matched your criteria.  Please try again\n";
899

    
900
      fullTemplate( ('searchResults'), { stage => "searchresults",
901
                                         allParams => $allParams,
902
                                         foundAccounts => $found });
903
    }
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
    
919
    #if ldap server is down, a html file containing warning message will be returned
920
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
921
    
922
    $ldap->start_tls( verify => 'none');
923
    $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
        print STDERR "LDAPweb: $msg\n";
974
    }
975
}
976

    
977
sub handleGeneralServerFailure {
978
    my $errorMessage = shift;
979
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
980
    exit(0);   
981
   }
982
    
983
sub setVars {
984
    my $paramVars = shift;
985
    # initialize default parameters 
986
    my $templateVars = { cfg => $cfg,
987
                         styleSkinsPath => $contextUrl . "/style/skins",
988
                         styleCommonPath => $contextUrl . "/style/common",
989
                         contextUrl => $contextUrl,
990
                         orgList => \@orgList,
991
                         config  => $config,
992
    };
993
    
994
    # append customized params
995
    while (my ($k, $v) = each (%$paramVars)) {
996
        $templateVars->{$k} = $v;
997
    }
998
    
999
    return $templateVars;
1000
} 
(10-10/14)