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 11:10:20 -0800 (Fri, 23 Jan 2009) $'
8
 # '$Revision: 4773 $' 
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'};
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
    my $ldapUsername = $ldapConfig->{$o}{'user'} . ',' . $searchBase;
517
    
518
    #if main ldap server is down, a html file containing warning message will be returned
519
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
520
    
521
    #$ldap->start_tls( verify => 'require',
522
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
523
    $ldap->start_tls( verify => 'none');
524
    my $bindresult = $ldap->bind( version => 3, dn => $ldapUsername, 
525
                                  password => $bindPass );
526
    if ($bindresult->code) {
527
        $errorMessage = "Failed to log in. Are you sure your authentication client username/password " .
528
                        "password is correct? Please check your configuration and try again...";
529
        return $errorMessage;
530
    }
531

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

    
543
    return $errorMessage;
544
}
545

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

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

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

    
562
    return $hashedPasswd;
563
}
564

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

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

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

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

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

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

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

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

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

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

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

    
674
    my $foundAccounts = 0;
675

    
676
    #if main ldap server is down, a html file containing warning message will be returned
677
    debug("connecting to LDAP in findExistingAccounts with settings $ldapurl, $timeout");
678
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
679
    $ldap->start_tls( verify => 'none');
680
    $ldap->bind( version => 3, anonymous => 1);
681
    my $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
    #print "<p>Checking referrals...</p>\n";
718
    #my @referrals = $mesg->referrals();
719
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
720
    #for (my $i = 0; $i <= $#referrals; $i++) {
721
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
722
    #}
723

    
724
    return $foundAccounts;
725
}
726

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

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

    
742
    return $allValid;
743
}
744

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

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

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

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

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

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

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

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

    
829
sub handleResponseMessage {
830

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

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

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

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

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

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

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

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

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

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

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

    
902
    exit();
903
}
904

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

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

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

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

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

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

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