Project

General

Profile

1
#!/usr/bin/perl -w
2
 #
3
 #  '$RCSfile$'
4
 #  Copyright: 2001 Regents of the University of California 
5
 #
6
 #   '$Author: daigle $'
7
 #     '$Date: 2009-01-23 15:40:47 -0800 (Fri, 23 Jan 2009) $'
8
 # '$Revision: 4774 $' 
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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
302
    exit();
303
}
304

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

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

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

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

    
344

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
541
    return $errorMessage;
542
}
543

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

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

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

    
560
    return $hashedPasswd;
561
}
562

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

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

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

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

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

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

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

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

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

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

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

    
672
    my $foundAccounts = 0;
673

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

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

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

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

    
722
    return $foundAccounts;
723
}
724

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

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

    
740
    return $allValid;
741
}
742

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

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

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

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

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

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

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

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

    
827
sub handleResponseMessage {
828

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

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

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

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

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

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

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

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

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

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

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

    
900
    exit();
901
}
902

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

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

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

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

    
972
sub handleLDAPBindFailure {
973
    my $ldapAttemptUrl = shift;
974
    my $primaryLdap =  $properties->getProperty('auth.url');
975

    
976
    if ($ldapAttemptUrl eq  $primaryLdap) {
977
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
978
    } else {
979
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
980
    }
981
}
982

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