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: 2008-07-06 21:25:34 -0700 (Sun, 06 Jul 2008) $'
8
 # '$Revision: 4080 $' 
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 strict;             # turn on strict syntax checking
31
use Template;           # load the template-toolkit module
32
use CGI;                # load the CGI module 
33
use Net::LDAP;          # load the LDAP net libraries
34
use Net::SMTP;          # load the SMTP net libraries
35
use Digest::SHA1;       # for creating the password hash
36
use MIME::Base64;       # for creating the password hash
37
use URI;                # for parsing URL syntax
38
use Config::Properties; # for parsing Java .properties files
39
use File::Basename;     # for path name parsing
40

    
41
# Global configuration paramters
42
my $cgiUrl = $ENV{'SCRIPT_FILENAME'};
43
my $workingDirectory = dirname($cgiUrl);
44
my $metacatProps = "${workingDirectory}/../WEB-INF/metacat.properties";
45
my $properties = new Config::Properties();
46
unless (open (METACAT_PROPERTIES, $metacatProps)) {
47
    #print "Content-type: text/html\n\n";
48
    print "Unable to locate Metacat properties. Working directory is set as " . 
49
        $workingDirectory .", is this correct?";
50
    exit(0);
51
}
52

    
53
$properties->load(*METACAT_PROPERTIES);
54

    
55
## Set up our default configuration
56
my $ldapProps = $properties->splitToTree(qr/\./, 'ldap');
57
my $ldapurl = $ldapProps->{'url'};
58
my $mainldapurl = $ldapProps->{'mainurl'};
59
my $ldapUsername = $ldapProps->{'user'};
60
my $ldapPassword = $ldapProps->{'password'};
61
my $searchBase = $ldapProps->{'searchbase'};
62
my $mailhost = $properties->getProperty('email.mailhost');
63
my $sender = $properties->getProperty('email.sender');
64

    
65
# Java uses miliseconds, Perl expects whole seconds
66
my $TIMEOUT = $ldapProps->{'connectTimeLimit'} / 1000;
67
my $mainldapdownmessage = "The main ldap server $mainldapurl is down!";
68

    
69
# Get the CGI input variables
70
my $query = new CGI;
71

    
72
my $debug = 0;
73

    
74
#--------------------------------------------------------------------------80c->
75
# Set up the Template Toolkit to read html form templates
76

    
77
# templates hash, imported from ldap.templates tree in metacat.properties
78
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
79

    
80
# set some configuration options for the template object
81
my $config_templates = {
82
             INCLUDE_PATH => $properties->getProperty('templates-dir'),
83
             INTERPOLATE  => 0,                    
84
             POST_CHOMP   => 1,                   
85
             };
86

    
87
# create an instance of the template
88
my $template = Template->new($config_templates) || handleGeneralServerFailure($Template::ERROR);
89

    
90
# custom LDAP properties hash
91
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
92

    
93
my @orgList = split(/,/, $properties->getProperty('ldap.organizations'));
94
my $ldapConfig;
95

    
96
foreach my $o (@orgList) {
97
    debug($o);
98
    # pull the raw tree in to prevent Perl pass-by-value shenanigans
99
    $ldapConfig->{$o} = $properties->splitToTree(qr/\./, 'ldap');
100

    
101
    # override the defaults set in ldap with the custom values
102
    if (defined $ldapCustom->{$o}) {
103
        my $custom = $ldapCustom->{$o};
104
        while (my ($key, $value) = each(%$custom)) {
105
            $ldapConfig->{$o}{$key} = $value;
106
        }
107
    }
108
}
109

    
110
#--------------------------------------------------------------------------80c->
111
# Define the main program logic that calls subroutines to do the work
112
#--------------------------------------------------------------------------80c->
113

    
114

    
115
# The processing step we are handling
116
my $stage = $query->param('stage') || $templates->{'stage'};
117

    
118
my $cfg = $query->param('cfg');
119

    
120
# define the possible stages
121
my %stages = (
122
              'initregister'      => \&handleInitRegister,
123
              'register'          => \&handleRegister,
124
              'registerconfirmed' => \&handleRegisterConfirmed,
125
              'simplesearch'      => \&handleSimpleSearch,
126
              'initaddentry'      => \&handleInitAddEntry,
127
              'addentry'          => \&handleAddEntry,
128
              'initmodifyentry'   => \&handleInitModifyEntry,
129
              'modifyentry'       => \&handleModifyEntry,
130
              'changepass'        => \&handleChangePassword,
131
              'initchangepass'    => \&handleInitialChangePassword,
132
              'resetpass'         => \&handleResetPassword,
133
              'initresetpass'     => \&handleInitialResetPassword,
134
             );
135
# call the appropriate routine based on the stage
136
if ( $stages{$stage} ) {
137
  $stages{$stage}->();
138
} else {
139
  &handleResponseMessage();
140
}
141

    
142
#--------------------------------------------------------------------------80c->
143
# Define the subroutines to do the work
144
#--------------------------------------------------------------------------80c->
145

    
146

    
147
#
148
# create the initial registration form 
149
#
150
sub handleInitRegister {
151
  my $vars = shift;
152

    
153
  print "Content-type: text/html\n\n";
154
  # process the template files:
155
  fullTemplate(['register'], {stage => "register"}); 
156
  exit();
157
}
158

    
159
#
160
# process input from the register stage, which occurs when
161
# a user submits form data to create a new account
162
#
163
sub handleRegister {
164
    
165
    print "Content-type: text/html\n\n";
166

    
167
    my $allParams = { 'givenName' => $query->param('givenName'), 
168
                      'sn' => $query->param('sn'),
169
                      'o' => $query->param('o'), 
170
                      'mail' => $query->param('mail'), 
171
                      'uid' => $query->param('uid'), 
172
                      'userPassword' => $query->param('userPassword'), 
173
                      'userPassword2' => $query->param('userPassword2'), 
174
                      'title' => $query->param('title'), 
175
                      'telephoneNumber' => $query->param('telephoneNumber') };
176
    # Check that all required fields are provided and not null
177
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
178
                           'uid', 'userPassword', 'userPassword2');
179
    if (! paramsAreValid(@requiredParams)) {
180
        my $errorMessage = "Required information is missing. " .
181
            "Please fill in all required fields and resubmit the form.";
182
        fullTemplate(['register'], { stage => "register",
183
                                     allParams => $allParams,
184
                                     errorMessage => $errorMessage });
185
        exit();
186
    } else {
187
        my $o = $query->param('o');    
188
        $ldapurl = $ldapConfig->{$o}{'url'};
189
        $searchBase = $ldapConfig->{$o}{'base'};  
190
    }
191

    
192
    # Search LDAP for matching entries that already exist
193
    # Some forms use a single text search box, whereas others search per
194
    # attribute.
195
    my $filter;
196
    if ($query->param('searchField')) {
197

    
198
      $filter = "(|" . 
199
                "(uid=" . $query->param('searchField') . ") " .
200
                "(mail=" . $query->param('searchField') . ")" .
201
                "(&(sn=" . $query->param('searchField') . ") " . 
202
                "(givenName=" . $query->param('searchField') . "))" . 
203
                ")";
204
    } else {
205
      $filter = "(|" . 
206
                "(uid=" . $query->param('uid') . ") " .
207
                "(mail=" . $query->param('mail') . ")" .
208
                "(&(sn=" . $query->param('sn') . ") " . 
209
                "(givenName=" . $query->param('givenName') . "))" . 
210
                ")";
211
    }
212

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

    
216
    # If entries match, send back a request to confirm new-user creation
217
    if ($found) {
218
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
219
                                                     allParams => $allParams,
220
                                                     foundAccounts => $found });
221
    # Otherwise, create a new user in the LDAP directory
222
    } else {
223
        #print("ingore create account\n");
224
        createAccount($allParams);
225
    }
226

    
227
    exit();
228
}
229

    
230
#
231
# process input from the registerconfirmed stage, which occurs when
232
# a user chooses to create an account despite similarities to other
233
# existing accounts
234
#
235
sub handleRegisterConfirmed {
236
  
237
    my $allParams = { 'givenName' => $query->param('givenName'), 
238
                      'sn' => $query->param('sn'),
239
                      'o' => 'unaffiliated', # only accept unaffiliated registration
240
                      'mail' => $query->param('mail'), 
241
                      'uid' => $query->param('uid'), 
242
                      'userPassword' => $query->param('userPassword'), 
243
                      'userPassword2' => $query->param('userPassword2'), 
244
                      'title' => $query->param('title'), 
245
                      'telephoneNumber' => $query->param('telephoneNumber') };
246
    print "Content-type: text/html\n\n";
247
    createAccount($allParams);
248
    exit();
249
}
250

    
251
#
252
# change a user's password upon request
253
#
254
sub handleChangePassword {
255

    
256
    print "Content-type: text/html\n\n";
257

    
258
    my $allParams = { 'test' => "1", };
259
    if ($query->param('uid')) {
260
        $$allParams{'uid'} = $query->param('uid');
261
    }
262
    if ($query->param('o')) {
263
        $$allParams{'o'} = $query->param('o');
264
        my $o = $query->param('o');
265
        
266
        $ldapurl = $ldapConfig->{$o}{'url'};
267
        $searchBase = $ldapConfig->{$o}{'base'};
268
    }
269

    
270

    
271
    # Check that all required fields are provided and not null
272
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
273
                           'userPassword', 'userPassword2');
274
    if (! paramsAreValid(@requiredParams)) {
275
        my $errorMessage = "Required information is missing. " .
276
            "Please fill in all required fields and submit the form.";
277
        fullTemplate( ['changePass'], { stage => "changepass",
278
                                        allParams => $allParams,
279
                                        errorMessage => $errorMessage });
280
        exit();
281
    }
282

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

    
286
        my $o = $query->param('o');
287
        $ldapurl = $ldapConfig->{$o}{'url'};
288
        $searchBase = $ldapConfig->{$o}{'base'};
289
        $ldapUsername = $ldapConfig->{$o}{'user'};
290
        $ldapPassword = $ldapConfig->{$o}{'password'};
291

    
292
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
293
        if ($query->param('o') =~ "LTER") {
294
            fullTemplate( ['registerLter'] );
295
        } else {
296
            my $errorMessage = changePassword(
297
                    $dn, $query->param('userPassword'), 
298
                    $dn, $query->param('oldpass'), $query->param('o'));
299
            if ($errorMessage) {
300
                fullTemplate( ['changePass'], { stage => "changepass",
301
                                                allParams => $allParams,
302
                                                errorMessage => $errorMessage });
303
                exit();
304
            } else {
305
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
306
                                                       allParams => $allParams });
307
                exit();
308
            }
309
        }
310
    } else {
311
        my $errorMessage = "The passwords do not match. Try again.";
312
        fullTemplate( ['changePass'], { stage => "changepass",
313
                                        allParams => $allParams,
314
                                        errorMessage => $errorMessage });
315
        exit();
316
    }
317
}
318

    
319
#
320
# change a user's password upon request - no input params
321
# only display chagepass template without any error
322
#
323
sub handleInitialChangePassword {
324
    print "Content-type: text/html\n\n";
325

    
326
    my $allParams = { 'test' => "1", };
327
    my $errorMessage = "";
328
    fullTemplate( ['changePass'], { stage => "changepass",
329
                                    errorMessage => $errorMessage });
330
    exit();
331
}
332

    
333
#
334
# reset a user's password upon request
335
#
336
sub handleResetPassword {
337

    
338
    print "Content-type: text/html\n\n";
339

    
340
    my $allParams = { 'test' => "1", };
341
    if ($query->param('uid')) {
342
        $$allParams{'uid'} = $query->param('uid');
343
    }
344
    if ($query->param('o')) {
345
        $$allParams{'o'} = $query->param('o');
346
        my $o = $query->param('o');
347
        
348
        $ldapurl = $ldapConfig->{$o}{'url'};
349
        $searchBase = $ldapConfig->{$o}{'base'};
350
        $ldapUsername = $ldapConfig->{$o}{'user'};
351
        $ldapPassword = $ldapConfig->{$o}{'password'};
352
    }
353

    
354
    # Check that all required fields are provided and not null
355
    my @requiredParams = ( 'uid', 'o' );
356
    if (! paramsAreValid(@requiredParams)) {
357
        my $errorMessage = "Required information is missing. " .
358
            "Please fill in all required fields and submit the form.";
359
        fullTemplate( ['resetPass'],  { stage => "resetpass",
360
                                        allParams => $allParams,
361
                                        errorMessage => $errorMessage });
362
        exit();
363
    }
364

    
365
    # We have all of the info we need, so try to change the password
366
    my $o = $query->param('o');
367
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
368
    if ($query->param('o') =~ "LTER") {
369
        fullTemplate( ['registerLter'] );
370
        exit();
371
    } else {
372
        my $errorMessage = "";
373
        my $recipient;
374
        my $userPass;
375
        my $entry = getLdapEntry($ldapurl, $searchBase, 
376
                $query->param('uid'), $query->param('o'));
377

    
378
        if ($entry) {
379
            $recipient = $entry->get_value('mail');
380
            $userPass = getRandomPassword();
381
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
382
        } else {
383
            $errorMessage = "User not found in database.  Please try again.";
384
        }
385

    
386
        if ($errorMessage) {
387
            fullTemplate( ['resetPass'], { stage => "resetpass",
388
                                           allParams => $allParams,
389
                                           errorMessage => $errorMessage });
390
            exit();
391
        } else {
392
            my $errorMessage = sendPasswordNotification($query->param('uid'),
393
                    $query->param('o'), $userPass, $recipient, $cfg);
394
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
395
                                                  allParams => $allParams,
396
                                                  errorMessage => $errorMessage });
397
            exit();
398
        }
399
    }
400
}
401

    
402
#
403
# reset a user's password upon request- no initial params
404
# only display resetpass template without any error
405
#
406
sub handleInitialResetPassword {
407
    print "Content-type: text/html\n\n";
408
    my $errorMessage = "";
409
    fullTemplate( ['resetPass'], { stage => "resetpass",
410
                                   errorMessage => $errorMessage });
411
    exit();
412
}
413

    
414
#
415
# Construct a random string to use for a newly reset password
416
#
417
sub getRandomPassword {
418
    my $length = shift;
419
    if (!$length) {
420
        $length = 8;
421
    }
422
    my $newPass = "";
423

    
424
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
425
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
426
    return $newPass;
427
}
428

    
429
#
430
# Change a password to a new value, binding as the provided user
431
#
432
sub changePassword {
433
    my $userDN = shift;
434
    my $userPass = shift;
435
    my $bindDN = shift;
436
    my $bindPass = shift;
437
    my $o = shift;
438

    
439
    my $ldapurl = $ldapConfig->{$o}{'url'};
440
    my $searchBase = $ldapConfig->{$o}{'base'};
441
    
442
    my $errorMessage = 0;
443
    my $ldap;
444
    if ($ldapurl =~ $mainldapurl){
445
        #if main ldap server is down, a html file containing warning message will be returned
446
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
447
    }
448
    else{
449
        #if a referral ldap server is down, we will ignore it silently
450
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
451
    } 
452
    #$ldap->start_tls( verify => 'require',
453
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
454
    $ldap->start_tls( verify => 'none');
455
    my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
456
                                  password => $bindPass );
457
    if ($bindresult->code) {
458
        $errorMessage = "Failed to log in. Are you sure your old " .
459
                        "password is correct? Try again...";
460
        return $errorMessage;
461
    }
462

    
463
    # Find the user here and change their entry
464
    my $newpass = createSeededPassHash($userPass);
465
    my $modifications = { userPassword => $newpass };
466
    my $result = $ldap->modify( $userDN, replace => { %$modifications });
467
    
468
    if ($result->code()) {
469
        my $errorMessage = "There was an error changing the password." .
470
                           "<br />\n" . $result->error;
471
    } 
472
    $ldap->unbind;   # take down session
473

    
474
    return $errorMessage;
475
}
476

    
477
#
478
# generate a Seeded SHA1 hash of a plaintext password
479
#
480
sub createSeededPassHash {
481
    my $secret = shift;
482

    
483
    my $salt = "";
484
    for (my $i=0; $i < 4; $i++) {
485
        $salt .= int(rand(10));
486
    }
487

    
488
    my $ctx = Digest::SHA1->new;
489
    $ctx->add($secret);
490
    $ctx->add($salt);
491
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
492

    
493
    return $hashedPasswd;
494
}
495

    
496
#
497
# Look up an ldap entry for a user
498
#
499
sub getLdapEntry {
500
    my $ldapurl = shift;
501
    my $base = shift;
502
    my $username = shift;
503
    my $org = shift;
504

    
505
    my $entry = "";
506
    my $mesg;
507
    my $ldap;
508
    print("ldap server ", $ldapurl, "\n");
509
    if ($ldapurl =~ $mainldapurl){
510
        #if main ldap server is down, a html file containing warning message will be returned
511
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
512
    }
513
    else{
514
        #if a referral ldap server is down, we will ignore it silently
515
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
516
    }
517
    $ldap->start_tls( verify => 'none');
518
    my $bindresult = $ldap->bind;
519
    if ($bindresult->code) {
520
        return $entry;
521
    }
522

    
523
    if($ldapConfig->{$org}{'filter'}){
524
        $mesg = $ldap->search ( base   => $base,
525
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
526
    } else {
527
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
528
    }
529
    
530
    if ($mesg->count > 0) {
531
        $entry = $mesg->pop_entry;
532
        $ldap->unbind;   # take down session
533
    } else {
534
        $ldap->unbind;   # take down session
535
        # Follow references by recursive call to self
536
        my @references = $mesg->references();
537
        for (my $i = 0; $i <= $#references; $i++) {
538
            my $uri = URI->new($references[$i]);
539
            my $host = $uri->host();
540
            my $path = $uri->path();
541
            $path =~ s/^\///;
542
            $entry = &getLdapEntry($host, $path, $username, $org);
543
            if ($entry) {
544
                return $entry;
545
            }
546
        }
547
    }
548
    return $entry;
549
}
550

    
551
# 
552
# send an email message notifying the user of the pw change
553
#
554
sub sendPasswordNotification {
555
    my $username = shift;
556
    my $org = shift;
557
    my $newPass = shift;
558
    my $recipient = shift;
559
    my $cfg = shift;
560

    
561
    my $errorMessage = "";
562
    if ($recipient) {
563
        # Send the email message to them
564
        my $smtp = Net::SMTP->new($mailhost);
565
        $smtp->mail($sender);
566
        $smtp->to($recipient);
567

    
568
        my $message = <<"        ENDOFMESSAGE";
569
        To: $recipient
570
        From: $sender
571
        Subject: KNB Password Reset
572
        
573
        Somebody (hopefully you) requested that your KNB password be reset.  
574
        This is generally done when somebody forgets their password.  Your 
575
        password can be changed by visiting the following URL:
576

    
577
        $cgiUrl?stage=changepass&cfg=$cfg
578

    
579
            Username: $username
580
        Organization: $org
581
        New Password: $newPass
582

    
583
        Thanks,
584
            The KNB Development Team
585
    
586
        ENDOFMESSAGE
587
        $message =~ s/^[ \t\r\f]+//gm;
588
    
589
        $smtp->data($message);
590
        $smtp->quit;
591
    } else {
592
        $errorMessage = "Failed to send password because I " .
593
                        "couldn't find a valid email address.";
594
    }
595
    return $errorMessage;
596
}
597

    
598
#
599
# search the LDAP directory to see if a similar account already exists
600
#
601
sub findExistingAccounts {
602
    my $ldapurl = shift;
603
    my $base = shift;
604
    my $filter = shift;
605
    my $attref = shift;
606
    my $ldap;
607

    
608
    my $foundAccounts = 0;
609
    #print("the ldapurl in findExstingAccounts is ", $ldapurl, "\n");
610
    if ($ldapurl =~ $mainldapurl){
611
        #if main ldap server is down, a html file containing warning message will be returned
612
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
613
    }
614
    else{
615
        #if a referral ldap server is down, we will ignore it silently
616
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
617
    }
618
    $ldap->start_tls( verify => 'none');
619
    $ldap->bind( version => 3, anonymous => 1);
620
    my $mesg = $ldap->search (
621
        base   => $base,
622
        filter => $filter,
623
        attrs => @$attref,
624
    );
625

    
626
    if ($mesg->count() > 0) {
627
        $foundAccounts = "";
628
        my $entry;
629
        foreach $entry ($mesg->all_entries) { 
630
            $foundAccounts .= "<p>\n<b><u>Account:</u> ";
631
            $foundAccounts .= $entry->dn();
632
            $foundAccounts .= "</b><br />\n";
633
            foreach my $attribute ($entry->attributes()) {
634
                $foundAccounts .= "$attribute: ";
635
                $foundAccounts .= $entry->get_value($attribute);
636
                $foundAccounts .= "<br />\n";
637
            }
638
            $foundAccounts .= "</p>\n";
639
        }
640
    }
641
    $ldap->unbind;   # take down session
642

    
643
    # Follow references
644
    my @references = $mesg->references();
645
    for (my $i = 0; $i <= $#references; $i++) {
646
        my $uri = URI->new($references[$i]);
647
        my $host = $uri->host();
648
        my $path = $uri->path();
649
        $path =~ s/^\///;
650
        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
651
        if ($refFound) {
652
            $foundAccounts .= $refFound;
653
        }
654
    }
655

    
656
    #print "<p>Checking referrals...</p>\n";
657
    #my @referrals = $mesg->referrals();
658
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
659
    #for (my $i = 0; $i <= $#referrals; $i++) {
660
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
661
    #}
662

    
663
    return $foundAccounts;
664
}
665

    
666
#
667
# Validate that we have the proper set of input parameters
668
#
669
sub paramsAreValid {
670
    my @pnames = @_;
671

    
672
    my $allValid = 1;
673
    foreach my $parameter (@pnames) {
674
        if (!defined($query->param($parameter)) || 
675
            ! $query->param($parameter) ||
676
            $query->param($parameter) =~ /^\s+$/) {
677
            $allValid = 0;
678
        }
679
    }
680

    
681
    return $allValid;
682
}
683

    
684
#
685
# Bind to LDAP and create a new account using the information provided
686
# by the user
687
#
688
sub createAccount {
689
    my $allParams = shift;
690

    
691
    if ($query->param('o') =~ "LTER") {
692
        fullTemplate( ['registerLter'] );
693
    } else {
694

    
695
        # Be sure the passwords match
696
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
697
            my $errorMessage = "The passwords do not match. Try again.";
698
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
699
                                                            allParams => $allParams,
700
                                                            errorMessage => $errorMessage });
701
            exit();
702
        }
703

    
704
        my $o = $query->param('o');
705

    
706
        my $ldapurl = $ldapConfig->{$o}{'url'};
707
        my $ldapUsername = $ldapConfig->{$o}{'user'};
708
        my $ldapPassword = $ldapConfig->{$o}{'password'};
709
        my $searchBase = $ldapConfig->{$o}{'base'};
710
        my $dnBase = $ldapConfig->{$o}{'dn'};
711

    
712
        
713
        #if main ldap server is down, a html file containing warning message will be returned
714
        my $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
715
        
716
        
717
        $ldap->start_tls( verify => 'none');
718
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
719
        #print "Inserting new entry...\n";
720
        my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
721

    
722
        # Create a hashed version of the password
723
        my $shapass = createSeededPassHash($query->param('userPassword'));
724

    
725
        # Do the insertion
726
        my $additions = [ 
727
                'uid'   => $query->param('uid'),
728
                'o'   => $query->param('o'),
729
                'cn'   => join(" ", $query->param('givenName'), 
730
                                    $query->param('sn')),
731
                'sn'   => $query->param('sn'),
732
                'givenName'   => $query->param('givenName'),
733
                'mail' => $query->param('mail'),
734
                'userPassword' => $shapass,
735
                'objectclass' => ['top', 'person', 'organizationalPerson', 
736
                                'inetOrgPerson', 'uidObject' ]
737
            ];
738
        if (defined($query->param('telephoneNumber')) && 
739
            $query->param('telephoneNumber') &&
740
            ! $query->param('telephoneNumber') =~ /^\s+$/) {
741
            $$additions[$#$additions + 1] = 'telephoneNumber';
742
            $$additions[$#$additions + 1] = $query->param('telephoneNumber');
743
        }
744
        if (defined($query->param('title')) && 
745
            $query->param('title') &&
746
            ! $query->param('title') =~ /^\s+$/) {
747
            $$additions[$#$additions + 1] = 'title';
748
            $$additions[$#$additions + 1] = $query->param('title');
749
        }
750
        my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
751
    
752
        if ($result->code()) {
753
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
754
                                                            allParams => $allParams,
755
                                                            errorMessage => $result->error });
756
            # TODO SCW was included as separate errors, test this
757
            #$templateVars    = setVars({ stage => "register",
758
            #                     allParams => $allParams });
759
            #$template->process( $templates->{'register'}, $templateVars);
760
        } else {
761
            fullTemplate( ['success'] );
762
        }
763

    
764
        $ldap->unbind;   # take down session
765
    }
766
}
767

    
768
sub handleResponseMessage {
769

    
770
  print "Content-type: text/html\n\n";
771
  my $errorMessage = "You provided invalid input to the script. " .
772
                     "Try again please.";
773
  fullTemplate( [], { stage => $templates->{'stage'},
774
                      errorMessage => $errorMessage });
775
  exit();
776
}
777

    
778
#
779
# perform a simple search against the LDAP database using 
780
# a small subset of attributes of each dn and return it
781
# as a table to the calling browser.
782
#
783
sub handleSimpleSearch {
784

    
785
    my $o = $query->param('o');
786

    
787
    my $ldapurl = $ldapConfig->{$o}{'url'};
788
    my $searchBase = $ldapConfig->{$o}{'base'};
789

    
790
    print "Content-type: text/html\n\n";
791

    
792
    my $allParams = { 
793
                      'cn' => $query->param('cn'),
794
                      'sn' => $query->param('sn'),
795
                      'gn' => $query->param('gn'),
796
                      'o'  => $query->param('o'),
797
                      'facsimiletelephonenumber' 
798
                      => $query->param('facsimiletelephonenumber'),
799
                      'mail' => $query->param('cmail'),
800
                      'telephonenumber' => $query->param('telephonenumber'),
801
                      'title' => $query->param('title'),
802
                      'uid' => $query->param('uid'),
803
                      'ou' => $query->param('ou'),
804
                    };
805

    
806
    # Search LDAP for matching entries that already exist
807
    my $filter = "(" . 
808
                 $query->param('searchField') . "=" .
809
                 "*" .
810
                 $query->param('searchValue') .
811
                 "*" .
812
                 ")";
813

    
814
    my @attrs = [ 'sn', 
815
                  'gn', 
816
                  'cn', 
817
                  'o', 
818
                  'facsimiletelephonenumber', 
819
                  'mail', 
820
                  'telephoneNumber', 
821
                  'title', 
822
                  'uid', 
823
                  'labeledURI', 
824
                  'ou' ];
825

    
826
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
827

    
828
    # Send back the search results
829
    if ($found) {
830
      fullTemplate( ('searchResults'), { stage => "searchresults",
831
                                         allParams => $allParams,
832
                                         foundAccounts => $found });
833
    } else {
834
      $found = "No entries matched your criteria.  Please try again\n";
835

    
836
      fullTemplate( ('searchResults'), { stage => "searchresults",
837
                                         allParams => $allParams,
838
                                         foundAccounts => $found });
839
    }
840

    
841
    exit();
842
}
843

    
844
#
845
# search the LDAP directory to see if a similar account already exists
846
#
847
sub searchDirectory {
848
    my $ldapurl = shift;
849
    my $base = shift;
850
    my $filter = shift;
851
    my $attref = shift;
852

    
853
    my $foundAccounts = 0;
854

    
855
    
856
    
857
    #if ldap server is down, a html file containing warning message will be returned
858
    my $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
859
    
860
    $ldap->start_tls( verify => 'none');
861
    $ldap->bind( version => 3, anonymous => 1);
862
    my $mesg = $ldap->search (
863
        base   => $base,
864
        filter => $filter,
865
        attrs => @$attref,
866
    );
867

    
868
    if ($mesg->count() > 0) {
869
        $foundAccounts = "";
870
        my $entry;
871
        foreach $entry ($mesg->sorted(['sn'])) {
872
          $foundAccounts .= "<tr>\n<td class=\"main\">\n";
873
          $foundAccounts .= "<a href=\"" unless 
874
                    (!$entry->get_value('labeledURI'));
875
          $foundAccounts .= $entry->get_value('labeledURI') unless
876
                    (!$entry->get_value('labeledURI'));
877
          $foundAccounts .= "\">\n" unless 
878
                    (!$entry->get_value('labeledURI'));
879
          $foundAccounts .= $entry->get_value('givenName');
880
          $foundAccounts .= "</a>\n" unless 
881
                    (!$entry->get_value('labeledURI'));
882
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
883
          $foundAccounts .= "<a href=\"" unless 
884
                    (!$entry->get_value('labeledURI'));
885
          $foundAccounts .= $entry->get_value('labeledURI') unless
886
                    (!$entry->get_value('labeledURI'));
887
          $foundAccounts .= "\">\n" unless 
888
                    (!$entry->get_value('labeledURI'));
889
          $foundAccounts .= $entry->get_value('sn');
890
          $foundAccounts .= "</a>\n";
891
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
892
          $foundAccounts .= $entry->get_value('mail');
893
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
894
          $foundAccounts .= $entry->get_value('telephonenumber');
895
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
896
          $foundAccounts .= $entry->get_value('title');
897
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
898
          $foundAccounts .= $entry->get_value('ou');
899
          $foundAccounts .= "\n</td>\n";
900
          $foundAccounts .= "</tr>\n";
901
        }
902
    }
903
    $ldap->unbind;   # take down session
904
    return $foundAccounts;
905
}
906

    
907
sub debug {
908
    my $msg = shift;
909
    
910
    if ($debug) {
911
        print STDERR "$msg\n";
912
    }
913
}
914

    
915
sub handleGeneralServerFailure {
916
    my $errorMessage = shift;
917
    fullTemplate( ('mainServerFailure'), { errorMessage => $errorMessage });
918
    exit(0);   
919
   }
920
    
921
sub setVars {
922
    my $paramVars = shift;
923
    # initialize default parameters 
924
    my $templateVars = { cfg => $cfg,
925
                         styleSkinsPath => $properties->getProperty('style-skins-path'),
926
                         styleCommonPath => $properties->getProperty('style-common-path'),
927
                         baseUrl => $properties->getProperty('baseUrl'),
928
                         orgList => \@orgList,
929
    };
930
    
931
    # append customized params
932
    while (my ($k, $v) = each (%$paramVars)) {
933
        $templateVars->{$k} = $v;
934
    }
935
    
936
    return $templateVars;
937
} 
938
    
939
sub fullTemplate {
940
    my $templateList = shift;
941
    my $templateVars = setVars(shift);
942

    
943
    $template->process( $templates->{'header'}, $templateVars );
944
    
945
    foreach my $tmpl (@{$templateList}) {
946
        $template->process( $templates->{$tmpl}, $templateVars );
947
    }    
948
    $template->process( $templates->{'footer'}, $templateVars );
949
}
(8-8/12)