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-03-17 16:54:48 -0700 (Tue, 17 Mar 2009) $'
8
 # '$Revision: 4848 $' 
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
    my $mesg;
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 handleLDAPBindFailure($ldapurl);
678
    if ($ldap) {
679
    	$ldap->start_tls( verify => 'none');
680
    	$ldap->bind( version => 3, anonymous => 1);
681
		$mesg = $ldap->search (
682
			base   => $base,
683
			filter => $filter,
684
			attrs => @$attref,
685
		);
686

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

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

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

    
725
    return $foundAccounts;
726
}
727

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

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

    
743
    return $allValid;
744
}
745

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

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

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

    
766
        my $o = $query->param('o');
767

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

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

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

    
826
        $ldap->unbind;   # take down session
827
    }
828
}
829

    
830
sub handleResponseMessage {
831

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

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

    
847
    my $o = $query->param('o');
848

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

    
852
    print "Content-type: text/html\n\n";
853

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

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

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

    
888
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
889

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

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

    
903
    exit();
904
}
905

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

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

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

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

    
975
sub handleLDAPBindFailure {
976
    my $ldapAttemptUrl = shift;
977
    my $primaryLdap =  $properties->getProperty('auth.url');
978

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

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