Project

General

Profile

1
#!/usr/bin/perl -w
2
 #
3
 #  '$RCSfile$'
4
 #  Copyright: 2001 Regents of the University of California 
5
 #
6
 #   '$Author: walbridge $'
7
 #     '$Date: 2008-09-26 10:28:04 -0700 (Fri, 26 Sep 2008) $'
8
 # '$Revision: 4394 $' 
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
## Set up our default configuration
59
my $ldapProps = $properties->splitToTree(qr/\./, 'ldap');
60
# local directory configuration
61
my $skinsDir = "${workingDirectory}/../style/skins";
62
my $templatesDir = abs_path("${workingDirectory}/../style/common/templates");
63
my $tempDir = $properties->getProperty('application.tempDir');
64

    
65
# url configuration
66
my $server = $properties->splitToTree(qr/\./, 'server');
67
my $contextUrl = 'http://' . $properties->getProperty('server.name') . ':' .
68
                 $properties->getProperty('server.httpPort') . '/' .
69
                 $properties->getProperty('application.context');
70

    
71
my $metacatUrl = $contextUrl . "/metacat";
72
my $cgiPrefix = "/" . $properties->getProperty('application.context') . "/cgi-bin";
73
my $styleSkinsPath = $contextUrl . "/style/skins";
74
my $styleCommonPath = $contextUrl . "/style/common";
75

    
76
my @errorMessages;
77
my $error = 0;
78

    
79
# Import all of the HTML form fields as variables
80
import_names('FORM');
81

    
82
# Must have a config to use Metacat
83
my $skinName = "";
84
if ($FORM::cfg) {
85
    $skinName = $FORM::cfg;
86
} elsif ($ARGV[0]) {
87
    $skinName = $ARGV[0];
88
} else {
89
    debug("Registry: No configuration set.");
90
    print "Content-type: text/html\n\n";
91
    print 'Registry Error: The registry requires a skin name to continue.';
92
    exit();
93
}
94

    
95
# Metacat isn't initialized, the registry will fail in strange ways.
96
if (!($metacatUrl)) {
97
    debug("Registry: No Metacat.");
98
    print "Content-type: text/html\n\n";
99
    'Registry Error: Metacat is not initialized! Make sure' .
100
        ' MetacatUrl is set correctly in ' .  $skinName . '.cfg';
101
    exit();
102
}
103

    
104
my $skinProperties = new Config::Properties();
105
if (!($skinName)) {
106
    $error = "Application misconfigured.  Please contact the administrator.";
107
    push(@errorMessages, $error);
108
} else {
109
    my $skinProps = "$skinsDir/$skinName/$skinName.properties";
110
    unless (open (SKIN_PROPERTIES, $skinProps)) {
111
        print "Content-type: text/html\n\n";
112
        print "Unable to locate skin properties at $skinProps.  Is this path correct?";
113
        exit(0);
114
    }
115
    $skinProperties->load(*SKIN_PROPERTIES);
116
}
117

    
118
my $config = $skinProperties->splitToTree(qr/\./, 'registry.config');
119

    
120
my $searchBase;
121
my $ldapUsername;
122
my $ldapPassword;
123
my $ldapurl = $ldapProps->{'url'};
124

    
125
# Java uses miliseconds, Perl expects whole seconds
126
my $timeout = $ldapProps->{'connectTimeLimit'} / 1000;
127
my $ldapdownmessage = "The main ldap server $ldapProps->{'url'} is down!";
128

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

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

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

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

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

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

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

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

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

    
181

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

    
185
my $cfg = $query->param('cfg');
186

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

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

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

    
214

    
215
#
216
# create the initial registration form 
217
#
218
sub handleInitRegister {
219
  my $vars = shift;
220

    
221
  print "Content-type: text/html\n\n";
222
  # process the template files:
223
  fullTemplate(['register'], {stage => "register"}); 
224
  exit();
225
}
226

    
227
#
228
# process input from the register stage, which occurs when
229
# a user submits form data to create a new account
230
#
231
sub handleRegister {
232
    
233
    print "Content-type: text/html\n\n";
234

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

    
259
    # Search LDAP for matching entries that already exist
260
    # Some forms use a single text search box, whereas others search per
261
    # attribute.
262
    my $filter;
263
    if ($query->param('searchField')) {
264

    
265
      $filter = "(|" . 
266
                "(uid=" . $query->param('searchField') . ") " .
267
                "(mail=" . $query->param('searchField') . ")" .
268
                "(&(sn=" . $query->param('searchField') . ") " . 
269
                "(givenName=" . $query->param('searchField') . "))" . 
270
                ")";
271
    } else {
272
      $filter = "(|" . 
273
                "(uid=" . $query->param('uid') . ") " .
274
                "(mail=" . $query->param('mail') . ")" .
275
                "(&(sn=" . $query->param('sn') . ") " . 
276
                "(givenName=" . $query->param('givenName') . "))" . 
277
                ")";
278
    }
279

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

    
283
    # If entries match, send back a request to confirm new-user creation
284
    if ($found) {
285
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
286
                                                     allParams => $allParams,
287
                                                     foundAccounts => $found });
288
    # Otherwise, create a new user in the LDAP directory
289
    } else {
290
        #print("ingore create account\n");
291
        createAccount($allParams);
292
    }
293

    
294
    exit();
295
}
296

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

    
318
#
319
# change a user's password upon request
320
#
321
sub handleChangePassword {
322

    
323
    print "Content-type: text/html\n\n";
324

    
325
    my $allParams = { 'test' => "1", };
326
    if ($query->param('uid')) {
327
        $$allParams{'uid'} = $query->param('uid');
328
    }
329
    if ($query->param('o')) {
330
        $$allParams{'o'} = $query->param('o');
331
        my $o = $query->param('o');
332
        
333
        $searchBase = $ldapConfig->{$o}{'base'};
334
    }
335

    
336

    
337
    # Check that all required fields are provided and not null
338
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
339
                           'userPassword', 'userPassword2');
340
    if (! paramsAreValid(@requiredParams)) {
341
        my $errorMessage = "Required information is missing. " .
342
            "Please fill in all required fields and submit the form.";
343
        fullTemplate( ['changePass'], { stage => "changepass",
344
                                        allParams => $allParams,
345
                                        errorMessage => $errorMessage });
346
        exit();
347
    }
348

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

    
352
        my $o = $query->param('o');
353
        $searchBase = $ldapConfig->{$o}{'base'};
354
        $ldapUsername = $ldapConfig->{$o}{'user'};
355
        $ldapPassword = $ldapConfig->{$o}{'password'};
356

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

    
384
#
385
# change a user's password upon request - no input params
386
# only display chagepass template without any error
387
#
388
sub handleInitialChangePassword {
389
    print "Content-type: text/html\n\n";
390

    
391
    my $allParams = { 'test' => "1", };
392
    my $errorMessage = "";
393
    fullTemplate( ['changePass'], { stage => "changepass",
394
                                    errorMessage => $errorMessage });
395
    exit();
396
}
397

    
398
#
399
# reset a user's password upon request
400
#
401
sub handleResetPassword {
402

    
403
    print "Content-type: text/html\n\n";
404

    
405
    my $allParams = { 'test' => "1", };
406
    if ($query->param('uid')) {
407
        $$allParams{'uid'} = $query->param('uid');
408
    }
409
    if ($query->param('o')) {
410
        $$allParams{'o'} = $query->param('o');
411
        my $o = $query->param('o');
412
        
413
        $searchBase = $ldapConfig->{$o}{'base'};
414
        $ldapUsername = $ldapConfig->{$o}{'user'};
415
        $ldapPassword = $ldapConfig->{$o}{'password'};
416
    }
417

    
418
    # Check that all required fields are provided and not null
419
    my @requiredParams = ( 'uid', 'o' );
420
    if (! paramsAreValid(@requiredParams)) {
421
        my $errorMessage = "Required information is missing. " .
422
            "Please fill in all required fields and submit the form.";
423
        fullTemplate( ['resetPass'],  { stage => "resetpass",
424
                                        allParams => $allParams,
425
                                        errorMessage => $errorMessage });
426
        exit();
427
    }
428

    
429
    # We have all of the info we need, so try to change the password
430
    my $o = $query->param('o');
431
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
432
    if ($query->param('o') =~ "LTER") {
433
        fullTemplate( ['registerLter'] );
434
        exit();
435
    } else {
436
        my $errorMessage = "";
437
        my $recipient;
438
        my $userPass;
439
        my $entry = getLdapEntry($ldapurl, $searchBase, 
440
                $query->param('uid'), $query->param('o'));
441

    
442
        if ($entry) {
443
            $recipient = $entry->get_value('mail');
444
            $userPass = getRandomPassword();
445
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
446
        } else {
447
            $errorMessage = "User not found in database.  Please try again.";
448
        }
449

    
450
        if ($errorMessage) {
451
            fullTemplate( ['resetPass'], { stage => "resetpass",
452
                                           allParams => $allParams,
453
                                           errorMessage => $errorMessage });
454
            exit();
455
        } else {
456
            my $errorMessage = sendPasswordNotification($query->param('uid'),
457
                    $query->param('o'), $userPass, $recipient, $cfg);
458
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
459
                                                  allParams => $allParams,
460
                                                  errorMessage => $errorMessage });
461
            exit();
462
        }
463
    }
464
}
465

    
466
#
467
# reset a user's password upon request- no initial params
468
# only display resetpass template without any error
469
#
470
sub handleInitialResetPassword {
471
    print "Content-type: text/html\n\n";
472
    my $errorMessage = "";
473
    fullTemplate( ['resetPass'], { stage => "resetpass",
474
                                   errorMessage => $errorMessage });
475
    exit();
476
}
477

    
478
#
479
# Construct a random string to use for a newly reset password
480
#
481
sub getRandomPassword {
482
    my $length = shift;
483
    if (!$length) {
484
        $length = 8;
485
    }
486
    my $newPass = "";
487

    
488
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
489
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
490
    return $newPass;
491
}
492

    
493
#
494
# Change a password to a new value, binding as the provided user
495
#
496
sub changePassword {
497
    my $userDN = shift;
498
    my $userPass = shift;
499
    my $bindDN = shift;
500
    my $bindPass = shift;
501
    my $o = shift;
502

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

    
522
    # Find the user here and change their entry
523
    my $newpass = createSeededPassHash($userPass);
524
    my $modifications = { userPassword => $newpass };
525
    my $result = $ldap->modify( $userDN, replace => { %$modifications });
526
    
527
    if ($result->code()) {
528
        my $errorMessage = "There was an error changing the password." .
529
                           "<br />\n" . $result->error;
530
    } 
531
    $ldap->unbind;   # take down session
532

    
533
    return $errorMessage;
534
}
535

    
536
#
537
# generate a Seeded SHA1 hash of a plaintext password
538
#
539
sub createSeededPassHash {
540
    my $secret = shift;
541

    
542
    my $salt = "";
543
    for (my $i=0; $i < 4; $i++) {
544
        $salt .= int(rand(10));
545
    }
546

    
547
    my $ctx = Digest::SHA1->new;
548
    $ctx->add($secret);
549
    $ctx->add($salt);
550
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
551

    
552
    return $hashedPasswd;
553
}
554

    
555
#
556
# Look up an ldap entry for a user
557
#
558
sub getLdapEntry {
559
    my $ldapurl = shift;
560
    my $base = shift;
561
    my $username = shift;
562
    my $org = shift;
563

    
564
    my $entry = "";
565
    my $mesg;
566
    my $ldap;
567
    print("ldap server ", $ldapurl, "\n");
568

    
569
    #if main ldap server is down, a html file containing warning message will be returned
570
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure($ldapdownmessage);
571
    $ldap->start_tls( verify => 'none');
572
    my $bindresult = $ldap->bind;
573
    if ($bindresult->code) {
574
        return $entry;
575
    }
576

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

    
605
# 
606
# send an email message notifying the user of the pw change
607
#
608
sub sendPasswordNotification {
609
    my $username = shift;
610
    my $org = shift;
611
    my $newPass = shift;
612
    my $recipient = shift;
613
    my $cfg = shift;
614

    
615
    my $errorMessage = "";
616
    if ($recipient) {
617
				my $mailhost = $properties->getProperty('email.mailhost');
618
				my $sender =  $properties->getProperty('email.sender');
619
        # Send the email message to them
620
        my $smtp = Net::SMTP->new($mailhost);
621
        $smtp->mail($sender);
622
        $smtp->to($recipient);
623

    
624
        my $message = <<"        ENDOFMESSAGE";
625
        To: $recipient
626
        From: $sender
627
        Subject: KNB Password Reset
628
        
629
        Somebody (hopefully you) requested that your KNB password be reset.  
630
        This is generally done when somebody forgets their password.  Your 
631
        password can be changed by visiting the following URL:
632

    
633
        $cgiUrl?stage=changepass&cfg=$cfg
634

    
635
            Username: $username
636
        Organization: $org
637
        New Password: $newPass
638

    
639
        Thanks,
640
            The KNB Development Team
641
    
642
        ENDOFMESSAGE
643
        $message =~ s/^[ \t\r\f]+//gm;
644
    
645
        $smtp->data($message);
646
        $smtp->quit;
647
    } else {
648
        $errorMessage = "Failed to send password because I " .
649
                        "couldn't find a valid email address.";
650
    }
651
    return $errorMessage;
652
}
653

    
654
#
655
# search the LDAP directory to see if a similar account already exists
656
#
657
sub findExistingAccounts {
658
    my $ldapurl = shift;
659
    my $base = shift;
660
    my $filter = shift;
661
    my $attref = shift;
662
    my $ldap;
663

    
664
    my $foundAccounts = 0;
665
    #print("the ldapurl in findExstingAccounts is ", $ldapurl, "\n");
666
    #if main ldap server is down, a html file containing warning message will be returned
667
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure($ldapdownmessage);
668
    $ldap->start_tls( verify => 'none');
669
    $ldap->bind( version => 3, anonymous => 1);
670
    my $mesg = $ldap->search (
671
        base   => $base,
672
        filter => $filter,
673
        attrs => @$attref,
674
    );
675

    
676
    if ($mesg->count() > 0) {
677
        $foundAccounts = "";
678
        my $entry;
679
        foreach $entry ($mesg->all_entries) { 
680
            $foundAccounts .= "<p>\n<b><u>Account:</u> ";
681
            $foundAccounts .= $entry->dn();
682
            $foundAccounts .= "</b><br />\n";
683
            foreach my $attribute ($entry->attributes()) {
684
                $foundAccounts .= "$attribute: ";
685
                $foundAccounts .= $entry->get_value($attribute);
686
                $foundAccounts .= "<br />\n";
687
            }
688
            $foundAccounts .= "</p>\n";
689
        }
690
    }
691
    $ldap->unbind;   # take down session
692

    
693
    # Follow references
694
    my @references = $mesg->references();
695
    for (my $i = 0; $i <= $#references; $i++) {
696
        my $uri = URI->new($references[$i]);
697
        my $host = $uri->host();
698
        my $path = $uri->path();
699
        $path =~ s/^\///;
700
        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
701
        if ($refFound) {
702
            $foundAccounts .= $refFound;
703
        }
704
    }
705

    
706
    #print "<p>Checking referrals...</p>\n";
707
    #my @referrals = $mesg->referrals();
708
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
709
    #for (my $i = 0; $i <= $#referrals; $i++) {
710
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
711
    #}
712

    
713
    return $foundAccounts;
714
}
715

    
716
#
717
# Validate that we have the proper set of input parameters
718
#
719
sub paramsAreValid {
720
    my @pnames = @_;
721

    
722
    my $allValid = 1;
723
    foreach my $parameter (@pnames) {
724
        if (!defined($query->param($parameter)) || 
725
            ! $query->param($parameter) ||
726
            $query->param($parameter) =~ /^\s+$/) {
727
            $allValid = 0;
728
        }
729
    }
730

    
731
    return $allValid;
732
}
733

    
734
#
735
# Bind to LDAP and create a new account using the information provided
736
# by the user
737
#
738
sub createAccount {
739
    my $allParams = shift;
740

    
741
    if ($query->param('o') =~ "LTER") {
742
        fullTemplate( ['registerLter'] );
743
    } else {
744

    
745
        # Be sure the passwords match
746
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
747
            my $errorMessage = "The passwords do not match. Try again.";
748
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
749
                                                            allParams => $allParams,
750
                                                            errorMessage => $errorMessage });
751
            exit();
752
        }
753

    
754
        my $o = $query->param('o');
755

    
756
        my $ldapUsername = $ldapConfig->{$o}{'user'};
757
        my $ldapPassword = $ldapConfig->{$o}{'password'};
758
        my $searchBase = $ldapConfig->{$o}{'base'};
759
        my $dnBase = $ldapConfig->{$o}{'dn'};
760
        
761
        #if main ldap server is down, a html file containing warning message will be returned
762
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
763
        
764
        
765
        $ldap->start_tls( verify => 'none');
766
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
767
        #print "Inserting new entry...\n";
768
        my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
769

    
770
        # Create a hashed version of the password
771
        my $shapass = createSeededPassHash($query->param('userPassword'));
772

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

    
812
        $ldap->unbind;   # take down session
813
    }
814
}
815

    
816
sub handleResponseMessage {
817

    
818
  print "Content-type: text/html\n\n";
819
  my $errorMessage = "You provided invalid input to the script. " .
820
                     "Try again please.";
821
  fullTemplate( [], { stage => $templates->{'stage'},
822
                      errorMessage => $errorMessage });
823
  exit();
824
}
825

    
826
#
827
# perform a simple search against the LDAP database using 
828
# a small subset of attributes of each dn and return it
829
# as a table to the calling browser.
830
#
831
sub handleSimpleSearch {
832

    
833
    my $o = $query->param('o');
834

    
835
    my $ldapurl = $ldapConfig->{$o}{'url'};
836
    my $searchBase = $ldapConfig->{$o}{'base'};
837

    
838
    print "Content-type: text/html\n\n";
839

    
840
    my $allParams = { 
841
                      'cn' => $query->param('cn'),
842
                      'sn' => $query->param('sn'),
843
                      'gn' => $query->param('gn'),
844
                      'o'  => $query->param('o'),
845
                      'facsimiletelephonenumber' 
846
                      => $query->param('facsimiletelephonenumber'),
847
                      'mail' => $query->param('cmail'),
848
                      'telephonenumber' => $query->param('telephonenumber'),
849
                      'title' => $query->param('title'),
850
                      'uid' => $query->param('uid'),
851
                      'ou' => $query->param('ou'),
852
                    };
853

    
854
    # Search LDAP for matching entries that already exist
855
    my $filter = "(" . 
856
                 $query->param('searchField') . "=" .
857
                 "*" .
858
                 $query->param('searchValue') .
859
                 "*" .
860
                 ")";
861

    
862
    my @attrs = [ 'sn', 
863
                  'gn', 
864
                  'cn', 
865
                  'o', 
866
                  'facsimiletelephonenumber', 
867
                  'mail', 
868
                  'telephoneNumber', 
869
                  'title', 
870
                  'uid', 
871
                  'labeledURI', 
872
                  'ou' ];
873

    
874
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
875

    
876
    # Send back the search results
877
    if ($found) {
878
      fullTemplate( ('searchResults'), { stage => "searchresults",
879
                                         allParams => $allParams,
880
                                         foundAccounts => $found });
881
    } else {
882
      $found = "No entries matched your criteria.  Please try again\n";
883

    
884
      fullTemplate( ('searchResults'), { stage => "searchresults",
885
                                         allParams => $allParams,
886
                                         foundAccounts => $found });
887
    }
888

    
889
    exit();
890
}
891

    
892
#
893
# search the LDAP directory to see if a similar account already exists
894
#
895
sub searchDirectory {
896
    my $ldapurl = shift;
897
    my $base = shift;
898
    my $filter = shift;
899
    my $attref = shift;
900

    
901
    my $foundAccounts = 0;
902
    
903
    #if ldap server is down, a html file containing warning message will be returned
904
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
905
    
906
    $ldap->start_tls( verify => 'none');
907
    $ldap->bind( version => 3, anonymous => 1);
908
    my $mesg = $ldap->search (
909
        base   => $base,
910
        filter => $filter,
911
        attrs => @$attref,
912
    );
913

    
914
    if ($mesg->count() > 0) {
915
        $foundAccounts = "";
916
        my $entry;
917
        foreach $entry ($mesg->sorted(['sn'])) {
918
          $foundAccounts .= "<tr>\n<td class=\"main\">\n";
919
          $foundAccounts .= "<a href=\"" unless 
920
                    (!$entry->get_value('labeledURI'));
921
          $foundAccounts .= $entry->get_value('labeledURI') unless
922
                    (!$entry->get_value('labeledURI'));
923
          $foundAccounts .= "\">\n" unless 
924
                    (!$entry->get_value('labeledURI'));
925
          $foundAccounts .= $entry->get_value('givenName');
926
          $foundAccounts .= "</a>\n" unless 
927
                    (!$entry->get_value('labeledURI'));
928
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
929
          $foundAccounts .= "<a href=\"" unless 
930
                    (!$entry->get_value('labeledURI'));
931
          $foundAccounts .= $entry->get_value('labeledURI') unless
932
                    (!$entry->get_value('labeledURI'));
933
          $foundAccounts .= "\">\n" unless 
934
                    (!$entry->get_value('labeledURI'));
935
          $foundAccounts .= $entry->get_value('sn');
936
          $foundAccounts .= "</a>\n";
937
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
938
          $foundAccounts .= $entry->get_value('mail');
939
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
940
          $foundAccounts .= $entry->get_value('telephonenumber');
941
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
942
          $foundAccounts .= $entry->get_value('title');
943
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
944
          $foundAccounts .= $entry->get_value('ou');
945
          $foundAccounts .= "\n</td>\n";
946
          $foundAccounts .= "</tr>\n";
947
        }
948
    }
949
    $ldap->unbind;   # take down session
950
    return $foundAccounts;
951
}
952

    
953
sub debug {
954
    my $msg = shift;
955
    
956
    if ($debug) {
957
        print STDERR "$msg\n";
958
    }
959
}
960

    
961
sub handleGeneralServerFailure {
962
    my $errorMessage = shift;
963
    fullTemplate( ('mainServerFailure'), { errorMessage => $errorMessage });
964
    exit(0);   
965
   }
966
    
967
sub setVars {
968
    my $paramVars = shift;
969
    # initialize default parameters 
970
    my $templateVars = { cfg => $cfg,
971
                         styleSkinsPath => $contextUrl . "/style/skins",
972
                         styleCommonPath => $contextUrl . "/style/common",
973
                         contextUrl => $contextUrl,
974
                         orgList => \@orgList,
975
                         config  => $config,
976
    };
977
    
978
    # append customized params
979
    while (my ($k, $v) = each (%$paramVars)) {
980
        $templateVars->{$k} = $v;
981
    }
982
    
983
    return $templateVars;
984
} 
985
    
986
sub fullTemplate {
987
    my $templateList = shift;
988
    my $templateVars = setVars(shift);
989
    
990
    $template->process( $templates->{'header'}, $templateVars );
991
    foreach my $tmpl (@{$templateList}) {
992
        $template->process( $templates->{$tmpl}, $templateVars );
993
    }
994
    $template->process( $templates->{'footer'}, $templateVars );
995
}
(10-10/14)