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-20 12:26:08 -0800 (Tue, 20 Jan 2009) $'
8
 # '$Revision: 4767 $' 
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 'LDAPweb 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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
303
    exit();
304
}
305

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

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

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

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

    
345

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
542
    return $errorMessage;
543
}
544

    
545
#
546
# generate a Seeded SHA1 hash of a plaintext password
547
#
548
sub createSeededPassHash {
549
    my $secret = shift;
550

    
551
    my $salt = "";
552
    for (my $i=0; $i < 4; $i++) {
553
        $salt .= int(rand(10));
554
    }
555

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

    
561
    return $hashedPasswd;
562
}
563

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

    
573
    my $entry = "";
574
    my $mesg;
575
    my $ldap;
576
    debug("ldap server: $ldapurl");
577

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

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

    
614
# 
615
# send an email message notifying the user of the pw change
616
#
617
sub sendPasswordNotification {
618
    my $username = shift;
619
    my $org = shift;
620
    my $newPass = shift;
621
    my $recipient = shift;
622
    my $cfg = shift;
623

    
624
    my $errorMessage = "";
625
    if ($recipient) {
626
				my $mailhost = $properties->getProperty('email.mailhost');
627
				my $sender =  $properties->getProperty('email.sender');
628
        # Send the email message to them
629
        my $smtp = Net::SMTP->new($mailhost);
630
        $smtp->mail($sender);
631
        $smtp->to($recipient);
632

    
633
        my $message = <<"        ENDOFMESSAGE";
634
        To: $recipient
635
        From: $sender
636
        Subject: KNB Password Reset
637
        
638
        Somebody (hopefully you) requested that your KNB password be reset.  
639
        This is generally done when somebody forgets their password.  Your 
640
        password can be changed by visiting the following URL:
641

    
642
        $cgiUrl?stage=changepass&cfg=$cfg
643

    
644
            Username: $username
645
        Organization: $org
646
        New Password: $newPass
647

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

    
663
#
664
# search the LDAP directory to see if a similar account already exists
665
#
666
sub findExistingAccounts {
667
    my $ldapurl = shift;
668
    my $base = shift;
669
    my $filter = shift;
670
    my $attref = shift;
671
    my $ldap;
672

    
673
    my $foundAccounts = 0;
674

    
675
    #if main ldap server is down, a html file containing warning message will be returned
676
    debug("connecting to LDAP in findExistingAccounts with settings $ldapurl, $timeout");
677
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure($ldapdownmessage);
678
    $ldap->start_tls( verify => 'none');
679
    $ldap->bind( version => 3, anonymous => 1);
680
    my $mesg = $ldap->search (
681
        base   => $base,
682
        filter => $filter,
683
        attrs => @$attref,
684
    );
685

    
686
    if ($mesg->count() > 0) {
687
        $foundAccounts = "";
688
        my $entry;
689
        foreach $entry ($mesg->all_entries) { 
690
            $foundAccounts .= "<p>\n<b><u>Account:</u> ";
691
            $foundAccounts .= $entry->dn();
692
            $foundAccounts .= "</b><br />\n";
693
            foreach my $attribute ($entry->attributes()) {
694
                $foundAccounts .= "$attribute: ";
695
                $foundAccounts .= $entry->get_value($attribute);
696
                $foundAccounts .= "<br />\n";
697
            }
698
            $foundAccounts .= "</p>\n";
699
        }
700
    }
701
    $ldap->unbind;   # take down session
702

    
703
    # Follow references
704
    my @references = $mesg->references();
705
    for (my $i = 0; $i <= $#references; $i++) {
706
        my $uri = URI->new($references[$i]);
707
        my $host = $uri->host();
708
        my $path = $uri->path();
709
        $path =~ s/^\///;
710
        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
711
        if ($refFound) {
712
            $foundAccounts .= $refFound;
713
        }
714
    }
715

    
716
    #print "<p>Checking referrals...</p>\n";
717
    #my @referrals = $mesg->referrals();
718
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
719
    #for (my $i = 0; $i <= $#referrals; $i++) {
720
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
721
    #}
722

    
723
    return $foundAccounts;
724
}
725

    
726
#
727
# Validate that we have the proper set of input parameters
728
#
729
sub paramsAreValid {
730
    my @pnames = @_;
731

    
732
    my $allValid = 1;
733
    foreach my $parameter (@pnames) {
734
        if (!defined($query->param($parameter)) || 
735
            ! $query->param($parameter) ||
736
            $query->param($parameter) =~ /^\s+$/) {
737
            $allValid = 0;
738
        }
739
    }
740

    
741
    return $allValid;
742
}
743

    
744
#
745
# Bind to LDAP and create a new account using the information provided
746
# by the user
747
#
748
sub createAccount {
749
    my $allParams = shift;
750

    
751
    if ($query->param('o') =~ "LTER") {
752
        fullTemplate( ['registerLter'] );
753
    } else {
754

    
755
        # Be sure the passwords match
756
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
757
            my $errorMessage = "The passwords do not match. Try again.";
758
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
759
                                                            allParams => $allParams,
760
                                                            errorMessage => $errorMessage });
761
            exit();
762
        }
763

    
764
        my $o = $query->param('o');
765

    
766
        my $searchBase = $ldapConfig->{$o}{'base'};
767
        my $dnBase = $ldapConfig->{$o}{'dn'};
768
        my $ldapUsername = $ldapConfig->{$o}{'user'} . ',' . $searchBase;
769
        my $ldapPassword = $ldapConfig->{$o}{'password'};
770
    		debug("LDAP connection to $ldapurl...");    
771
        #if main ldap server is down, a html file containing warning message will be returned
772
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
773
        
774
        
775
        $ldap->start_tls( verify => 'none');
776
				debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
777
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
778
        
779
        my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
780
				debug("Inserting new entry for: $dn");
781

    
782
        # Create a hashed version of the password
783
        my $shapass = createSeededPassHash($query->param('userPassword'));
784

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

    
824
        $ldap->unbind;   # take down session
825
    }
826
}
827

    
828
sub handleResponseMessage {
829

    
830
  print "Content-type: text/html\n\n";
831
  my $errorMessage = "You provided invalid input to the script. " .
832
                     "Try again please.";
833
  fullTemplate( [], { stage => $templates->{'stage'},
834
                      errorMessage => $errorMessage });
835
  exit();
836
}
837

    
838
#
839
# perform a simple search against the LDAP database using 
840
# a small subset of attributes of each dn and return it
841
# as a table to the calling browser.
842
#
843
sub handleSimpleSearch {
844

    
845
    my $o = $query->param('o');
846

    
847
    my $ldapurl = $ldapConfig->{$o}{'url'};
848
    my $searchBase = $ldapConfig->{$o}{'base'};
849

    
850
    print "Content-type: text/html\n\n";
851

    
852
    my $allParams = { 
853
                      'cn' => $query->param('cn'),
854
                      'sn' => $query->param('sn'),
855
                      'gn' => $query->param('gn'),
856
                      'o'  => $query->param('o'),
857
                      'facsimiletelephonenumber' 
858
                      => $query->param('facsimiletelephonenumber'),
859
                      'mail' => $query->param('cmail'),
860
                      'telephonenumber' => $query->param('telephonenumber'),
861
                      'title' => $query->param('title'),
862
                      'uid' => $query->param('uid'),
863
                      'ou' => $query->param('ou'),
864
                    };
865

    
866
    # Search LDAP for matching entries that already exist
867
    my $filter = "(" . 
868
                 $query->param('searchField') . "=" .
869
                 "*" .
870
                 $query->param('searchValue') .
871
                 "*" .
872
                 ")";
873

    
874
    my @attrs = [ 'sn', 
875
                  'gn', 
876
                  'cn', 
877
                  'o', 
878
                  'facsimiletelephonenumber', 
879
                  'mail', 
880
                  'telephoneNumber', 
881
                  'title', 
882
                  'uid', 
883
                  'labeledURI', 
884
                  'ou' ];
885

    
886
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
887

    
888
    # Send back the search results
889
    if ($found) {
890
      fullTemplate( ('searchResults'), { stage => "searchresults",
891
                                         allParams => $allParams,
892
                                         foundAccounts => $found });
893
    } else {
894
      $found = "No entries matched your criteria.  Please try again\n";
895

    
896
      fullTemplate( ('searchResults'), { stage => "searchresults",
897
                                         allParams => $allParams,
898
                                         foundAccounts => $found });
899
    }
900

    
901
    exit();
902
}
903

    
904
#
905
# search the LDAP directory to see if a similar account already exists
906
#
907
sub searchDirectory {
908
    my $ldapurl = shift;
909
    my $base = shift;
910
    my $filter = shift;
911
    my $attref = shift;
912

    
913
    my $foundAccounts = 0;
914
    
915
    #if ldap server is down, a html file containing warning message will be returned
916
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
917
    
918
    $ldap->start_tls( verify => 'none');
919
    $ldap->bind( version => 3, anonymous => 1);
920
    my $mesg = $ldap->search (
921
        base   => $base,
922
        filter => $filter,
923
        attrs => @$attref,
924
    );
925

    
926
    if ($mesg->count() > 0) {
927
        $foundAccounts = "";
928
        my $entry;
929
        foreach $entry ($mesg->sorted(['sn'])) {
930
          $foundAccounts .= "<tr>\n<td class=\"main\">\n";
931
          $foundAccounts .= "<a href=\"" unless 
932
                    (!$entry->get_value('labeledURI'));
933
          $foundAccounts .= $entry->get_value('labeledURI') unless
934
                    (!$entry->get_value('labeledURI'));
935
          $foundAccounts .= "\">\n" unless 
936
                    (!$entry->get_value('labeledURI'));
937
          $foundAccounts .= $entry->get_value('givenName');
938
          $foundAccounts .= "</a>\n" unless 
939
                    (!$entry->get_value('labeledURI'));
940
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
941
          $foundAccounts .= "<a href=\"" unless 
942
                    (!$entry->get_value('labeledURI'));
943
          $foundAccounts .= $entry->get_value('labeledURI') unless
944
                    (!$entry->get_value('labeledURI'));
945
          $foundAccounts .= "\">\n" unless 
946
                    (!$entry->get_value('labeledURI'));
947
          $foundAccounts .= $entry->get_value('sn');
948
          $foundAccounts .= "</a>\n";
949
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
950
          $foundAccounts .= $entry->get_value('mail');
951
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
952
          $foundAccounts .= $entry->get_value('telephonenumber');
953
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
954
          $foundAccounts .= $entry->get_value('title');
955
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
956
          $foundAccounts .= $entry->get_value('ou');
957
          $foundAccounts .= "\n</td>\n";
958
          $foundAccounts .= "</tr>\n";
959
        }
960
    }
961
    $ldap->unbind;   # take down session
962
    return $foundAccounts;
963
}
964

    
965
sub debug {
966
    my $msg = shift;
967
    
968
    if ($debug) {
969
        print STDERR "LDAPweb: $msg\n";
970
    }
971
}
972

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