Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8185

1
#!/usr/bin/perl -w
2
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California 
5
#
6
#   '$Author: tao $'
7
#     '$Date: 2013-09-11 21:36:20 -0700 (Wed, 11 Sep 2013) $'
8
# '$Revision: 8185 $' 
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 Captcha::reCAPTCHA; # for protection against spams
42
use Cwd 'abs_path';
43

    
44
# Global configuration paramters
45
# This entire block (including skin parsing) could be pushed out to a separate .pm file
46
my $cgiUrl = $ENV{'SCRIPT_FILENAME'};
47
my $workingDirectory = dirname($cgiUrl);
48
my $metacatProps = "${workingDirectory}/../WEB-INF/metacat.properties";
49
my $properties = new Config::Properties();
50
unless (open (METACAT_PROPERTIES, $metacatProps)) {
51
    print "Content-type: text/html\n\n";
52
    print "Unable to locate Metacat properties. Working directory is set as " . 
53
        $workingDirectory .", is this correct?";
54
    exit(0);
55
}
56

    
57
$properties->load(*METACAT_PROPERTIES);
58

    
59
# local directory configuration
60
my $skinsDir = "${workingDirectory}/../style/skins";
61
my $templatesDir = abs_path("${workingDirectory}/../style/common/templates");
62
my $tempDir = $properties->getProperty('application.tempDir');
63

    
64
# url configuration
65
my $server = $properties->splitToTree(qr/\./, 'server');
66
my $protocol = 'http://';
67
if ( $properties->getProperty('server.httpPort') eq '443' ) {
68
	$protocol = 'https://';
69
}
70
my $contextUrl = $protocol . $properties->getProperty('server.name');
71
if ($properties->getProperty('server.httpPort') ne '80') {
72
        $contextUrl = $contextUrl . ':' . $properties->getProperty('server.httpPort');
73
}
74
$contextUrl = $contextUrl . '/' .  $properties->getProperty('application.context');
75

    
76
my $metacatUrl = $contextUrl . "/metacat";
77
my $cgiPrefix = "/" . $properties->getProperty('application.context') . "/cgi-bin";
78
my $styleSkinsPath = $contextUrl . "/style/skins";
79
my $styleCommonPath = $contextUrl . "/style/common";
80

    
81
#recaptcha key information
82
my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');
83
my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');
84

    
85
my @errorMessages;
86
my $error = 0;
87

    
88
my $emailVerification= 'emailverification';
89

    
90
# Import all of the HTML form fields as variables
91
import_names('FORM');
92

    
93
# Must have a config to use Metacat
94
my $skinName = "";
95
if ($FORM::cfg) {
96
    $skinName = $FORM::cfg;
97
} elsif ($ARGV[0]) {
98
    $skinName = $ARGV[0];
99
} else {
100
    debug("No configuration set.");
101
    print "Content-type: text/html\n\n";
102
    print 'LDAPweb Error: The registry requires a skin name to continue.';
103
    exit();
104
}
105

    
106
# Metacat isn't initialized, the registry will fail in strange ways.
107
if (!($metacatUrl)) {
108
    debug("No Metacat.");
109
    print "Content-type: text/html\n\n";
110
    'Registry Error: Metacat is not initialized! Make sure' .
111
        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';
112
    exit();
113
}
114

    
115
my $skinProperties = new Config::Properties();
116
if (!($skinName)) {
117
    $error = "Application misconfigured.  Please contact the administrator.";
118
    push(@errorMessages, $error);
119
} else {
120
    my $skinProps = "$skinsDir/$skinName/$skinName.properties";
121
    unless (open (SKIN_PROPERTIES, $skinProps)) {
122
        print "Content-type: text/html\n\n";
123
        print "Unable to locate skin properties at $skinProps.  Is this path correct?";
124
        exit(0);
125
    }
126
    $skinProperties->load(*SKIN_PROPERTIES);
127
}
128

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

    
131
# XXX HACK: this is a temporary fix to pull out the UCNRS password property from the
132
#           NRS skin instead of metacat.properties. The intent is to prevent editing
133
#           of our core properties file, which is manipulated purely through the web.
134
#           Once organizations are editable, this section should be removed as should
135
#           the properties within nrs/nrs.properties.
136
my $nrsProperties = new Config::Properties();
137
my $nrsProps = "$skinsDir/nrs/nrs.properties";
138
unless (open (NRS_PROPERTIES, $nrsProps)) {
139
    print "Content-type: text/html\n\n";
140
    print "Unable to locate skin properties at $nrsProps.  Is this path correct?";
141
    exit(0);
142
}
143
$nrsProperties->load(*NRS_PROPERTIES);
144

    
145
my $nrsConfig = $nrsProperties->splitToTree(qr/\./, 'registry.config');
146

    
147
# XXX END HACK
148

    
149

    
150
my $searchBase;
151
my $ldapUsername;
152
my $ldapPassword;
153
# TODO: when should we use surl instead? Is there a setting promoting one over the other?
154
# TODO: the default tree for accounts should be exposed somewhere, defaulting to unaffiliated
155
my $ldapurl = $properties->getProperty('auth.url');
156

    
157
# Java uses miliseconds, Perl expects whole seconds
158
my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;
159

    
160
# Get the CGI input variables
161
my $query = new CGI;
162
my $debug = 1;
163

    
164
#--------------------------------------------------------------------------80c->
165
# Set up the Template Toolkit to read html form templates
166

    
167
# templates hash, imported from ldap.templates tree in metacat.properties
168
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
169
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
170
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
171

    
172
# set some configuration options for the template object
173
my $ttConfig = {
174
             INCLUDE_PATH => $templatesDir,
175
             INTERPOLATE  => 0,
176
             POST_CHOMP   => 1,
177
             DEBUG        => 1, 
178
             };
179

    
180
# create an instance of the template
181
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
182

    
183
# custom LDAP properties hash
184
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
185

    
186
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
187
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
188
# pull out properties available e.g. 'name', 'base'
189
my @orgData = keys(%$orgProps);
190

    
191
my @orgList;
192
while (my ($oKey, $oVal) = each(%$orgNames)) {
193
    push(@orgList, $oKey);
194
}
195

    
196
my $authBase = $properties->getProperty("auth.base");
197
my $ldapConfig;
198
foreach my $o (@orgList) {
199
    foreach my $d (@orgData) {
200
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
201
    }
202

    
203
    # XXX hack, remove after 1.9
204
    if ($o eq 'UCNRS') {
205
        $ldapConfig->{'UCNRS'}{'base'} = $nrsConfig->{'base'};
206
        $ldapConfig->{'UCNRS'}{'user'} = $nrsConfig->{'username'};
207
        $ldapConfig->{'UCNRS'}{'password'} = $nrsConfig->{'password'};
208
    }
209

    
210
    # set default base
211
    if (!$ldapConfig->{$o}{'base'}) {
212
        $ldapConfig->{$o}{'base'} = $authBase;
213
    }
214

    
215
    # include filter information. By default, our filters are 'o=$name', e.g. 'o=NAPIER'
216
    # these can be overridden by specifying them in metacat.properties. Non-default configs
217
    # such as UCNRS must specify all LDAP properties.
218
    if ($ldapConfig->{$o}{'base'} eq $authBase) {
219
        my $filter = "o=$o";
220
        if (!$ldapConfig->{$o}{'org'}) {
221
            $ldapConfig->{$o}{'org'} = $filter;
222
        }
223
        if (!$ldapConfig->{$o}{'filter'}) {
224
            $ldapConfig->{$o}{'filter'} = $filter;
225
        }
226
        # also include DN, which is just org + base
227
        if ($ldapConfig->{$o}{'org'}) {
228
            $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'org'} . "," . $ldapConfig->{$o}{'base'};
229
        }
230
    } else {
231
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
232
    }
233
    
234
    # set LDAP administrator user account
235
    if (!$ldapConfig->{$o}{'user'}) {
236
        $ldapConfig->{$o}{'user'} = $ldapConfig->{'unaffiliated'}{'user'};
237
    }
238
    # check for a fully qualified LDAP name. If it doesn't exist, append base.
239
    my @userParts = split(',', $ldapConfig->{$o}{'user'});
240
    if (scalar(@userParts) == 1) {
241
        $ldapConfig->{$o}{'user'} = $ldapConfig->{$o}{'user'} . "," . $ldapConfig->{$o}{'base'};
242
    }
243

    
244
    if (!$ldapConfig->{$o}{'password'}) {
245
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
246
    }
247
}
248

    
249
#--------------------------------------------------------------------------80c->
250
# Define the main program logic that calls subroutines to do the work
251
#--------------------------------------------------------------------------80c->
252

    
253
# The processing step we are handling
254
my $stage = $query->param('stage') || $templates->{'stage'};
255

    
256
my $cfg = $query->param('cfg');
257
debug("started with stage $stage, cfg $cfg");
258

    
259
# define the possible stages
260
my %stages = (
261
              'initregister'      => \&handleInitRegister,
262
              'register'          => \&handleRegister,
263
              'registerconfirmed' => \&handleRegisterConfirmed,
264
              'simplesearch'      => \&handleSimpleSearch,
265
              'initaddentry'      => \&handleInitAddEntry,
266
              'addentry'          => \&handleAddEntry,
267
              'initmodifyentry'   => \&handleInitModifyEntry,
268
              'modifyentry'       => \&handleModifyEntry,
269
              'changepass'        => \&handleChangePassword,
270
              'initchangepass'    => \&handleInitialChangePassword,
271
              'resetpass'         => \&handleResetPassword,
272
              'initresetpass'     => \&handleInitialResetPassword,
273
              'emailverification' => \&handleEmailVerification,
274
             );
275

    
276
# call the appropriate routine based on the stage
277
if ( $stages{$stage} ) {
278
  $stages{$stage}->();
279
} else {
280
  &handleResponseMessage();
281
}
282

    
283
#--------------------------------------------------------------------------80c->
284
# Define the subroutines to do the work
285
#--------------------------------------------------------------------------80c->
286

    
287
sub fullTemplate {
288
    my $templateList = shift;
289
    my $templateVars = setVars(shift);
290
    my $c = Captcha::reCAPTCHA->new;
291
    my $captcha = 'captcha';
292
    #my $error=null;
293
    my $use_ssl= 1;
294
    #my $options=null;
295
    $templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
296
    $template->process( $templates->{'header'}, $templateVars );
297
    foreach my $tmpl (@{$templateList}) {
298
        $template->process( $templates->{$tmpl}, $templateVars );
299
    }
300
    $template->process( $templates->{'footer'}, $templateVars );
301
}
302

    
303
#
304
# create the initial registration form 
305
#
306
sub handleInitRegister {
307
  my $vars = shift;
308
  print "Content-type: text/html\n\n";
309
  # process the template files:
310
  fullTemplate(['register'], {stage => "register"}); 
311
  exit();
312
}
313

    
314
#
315
# process input from the register stage, which occurs when
316
# a user submits form data to create a new account
317
#
318
sub handleRegister {
319
    
320
    print "Content-type: text/html\n\n";
321
    
322
    
323
    my $allParams = { 'givenName' => $query->param('givenName'), 
324
                      'sn' => $query->param('sn'),
325
                      'o' => $query->param('o'), 
326
                      'mail' => $query->param('mail'), 
327
                      'uid' => $query->param('uid'), 
328
                      'userPassword' => $query->param('userPassword'), 
329
                      'userPassword2' => $query->param('userPassword2'), 
330
                      'title' => $query->param('title'), 
331
                      'telephoneNumber' => $query->param('telephoneNumber') };
332
    
333
    # Check the recaptcha
334
    my $c = Captcha::reCAPTCHA->new;
335
    my $challenge = $query->param('recaptcha_challenge_field');
336
    my $response = $query->param('recaptcha_response_field');
337
    # Verify submission
338
    my $result = $c->check_answer(
339
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
340
        $challenge, $response
341
    );
342

    
343
    if ( $result->{is_valid} ) {
344
        #print "Yes!";
345
        #exit();
346
    }
347
    else {
348
        my $errorMessage = "The verification code is wrong. Please input again.";
349
        fullTemplate(['register'], { stage => "register",
350
                                     allParams => $allParams,
351
                                     errorMessage => $errorMessage });
352
        exit();
353
    }
354
    
355
    
356
    # Check that all required fields are provided and not null
357
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
358
                           'uid', 'userPassword', 'userPassword2');
359
    if (! paramsAreValid(@requiredParams)) {
360
        my $errorMessage = "Required information is missing. " .
361
            "Please fill in all required fields and resubmit the form.";
362
        fullTemplate(['register'], { stage => "register",
363
                                     allParams => $allParams,
364
                                     errorMessage => $errorMessage });
365
        exit();
366
    } else {
367
        my $o = $query->param('o');    
368
        $searchBase = $ldapConfig->{$o}{'base'};  
369
    }
370

    
371
    # Search LDAP for matching entries that already exist
372
    # Some forms use a single text search box, whereas others search per
373
    # attribute.
374
    my $filter;
375
    if ($query->param('searchField')) {
376

    
377
      $filter = "(|" . 
378
                "(uid=" . $query->param('searchField') . ") " .
379
                "(mail=" . $query->param('searchField') . ")" .
380
                "(&(sn=" . $query->param('searchField') . ") " . 
381
                "(givenName=" . $query->param('searchField') . "))" . 
382
                ")";
383
    } else {
384
      $filter = "(|" . 
385
                "(uid=" . $query->param('uid') . ") " .
386
                "(mail=" . $query->param('mail') . ")" .
387
                "(&(sn=" . $query->param('sn') . ") " . 
388
                "(givenName=" . $query->param('givenName') . "))" . 
389
                ")";
390
    }
391

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

    
395
    # If entries match, send back a request to confirm new-user creation
396
    if ($found) {
397
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
398
                                                     allParams => $allParams,
399
                                                     foundAccounts => $found });
400
    # Otherwise, create a new user in the LDAP directory
401
    } else {
402
        createTemporaryAccount($allParams);
403
    }
404

    
405
    exit();
406
}
407

    
408
#
409
# process input from the registerconfirmed stage, which occurs when
410
# a user chooses to create an account despite similarities to other
411
# existing accounts
412
#
413
sub handleRegisterConfirmed {
414
  
415
    my $allParams = { 'givenName' => $query->param('givenName'), 
416
                      'sn' => $query->param('sn'),
417
                      'o' => 'unaffiliated', # only accept unaffiliated registration
418
                      'mail' => $query->param('mail'), 
419
                      'uid' => $query->param('uid'), 
420
                      'userPassword' => $query->param('userPassword'), 
421
                      'userPassword2' => $query->param('userPassword2'), 
422
                      'title' => $query->param('title'), 
423
                      'telephoneNumber' => $query->param('telephoneNumber') };
424
    print "Content-type: text/html\n\n";
425
    createTemporaryAccount($allParams);
426
    exit();
427
}
428

    
429
#
430
# change a user's password upon request
431
#
432
sub handleChangePassword {
433

    
434
    print "Content-type: text/html\n\n";
435

    
436
    my $allParams = { 'test' => "1", };
437
    if ($query->param('uid')) {
438
        $$allParams{'uid'} = $query->param('uid');
439
    }
440
    if ($query->param('o')) {
441
        $$allParams{'o'} = $query->param('o');
442
        my $o = $query->param('o');
443
        
444
        $searchBase = $ldapConfig->{$o}{'base'};
445
    }
446

    
447

    
448
    # Check that all required fields are provided and not null
449
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
450
                           'userPassword', 'userPassword2');
451
    if (! paramsAreValid(@requiredParams)) {
452
        my $errorMessage = "Required information is missing. " .
453
            "Please fill in all required fields and submit the form.";
454
        fullTemplate( ['changePass'], { stage => "changepass",
455
                                        allParams => $allParams,
456
                                        errorMessage => $errorMessage });
457
        exit();
458
    }
459

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

    
463
        my $o = $query->param('o');
464
        $searchBase = $ldapConfig->{$o}{'base'};
465
        $ldapUsername = $ldapConfig->{$o}{'user'};
466
        $ldapPassword = $ldapConfig->{$o}{'password'};
467

    
468
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
469
        if ($query->param('o') =~ "LTER") {
470
            fullTemplate( ['registerLter'] );
471
        } else {
472
            my $errorMessage = changePassword(
473
                    $dn, $query->param('userPassword'), 
474
                    $dn, $query->param('oldpass'), $query->param('o'));
475
            if ($errorMessage) {
476
                fullTemplate( ['changePass'], { stage => "changepass",
477
                                                allParams => $allParams,
478
                                                errorMessage => $errorMessage });
479
                exit();
480
            } else {
481
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
482
                                                       allParams => $allParams });
483
                exit();
484
            }
485
        }
486
    } else {
487
        my $errorMessage = "The passwords do not match. Try again.";
488
        fullTemplate( ['changePass'], { stage => "changepass",
489
                                        allParams => $allParams,
490
                                        errorMessage => $errorMessage });
491
        exit();
492
    }
493
}
494

    
495
#
496
# change a user's password upon request - no input params
497
# only display chagepass template without any error
498
#
499
sub handleInitialChangePassword {
500
    print "Content-type: text/html\n\n";
501

    
502
    my $allParams = { 'test' => "1", };
503
    my $errorMessage = "";
504
    fullTemplate( ['changePass'], { stage => "changepass",
505
                                    errorMessage => $errorMessage });
506
    exit();
507
}
508

    
509
#
510
# reset a user's password upon request
511
#
512
sub handleResetPassword {
513

    
514
    print "Content-type: text/html\n\n";
515

    
516
    my $allParams = { 'test' => "1", };
517
    if ($query->param('uid')) {
518
        $$allParams{'uid'} = $query->param('uid');
519
    }
520
    if ($query->param('o')) {
521
        $$allParams{'o'} = $query->param('o');
522
        my $o = $query->param('o');
523
        
524
        $searchBase = $ldapConfig->{$o}{'base'};
525
        $ldapUsername = $ldapConfig->{$o}{'user'};
526
        $ldapPassword = $ldapConfig->{$o}{'password'};
527
    }
528

    
529
    # Check that all required fields are provided and not null
530
    my @requiredParams = ( 'uid', 'o' );
531
    if (! paramsAreValid(@requiredParams)) {
532
        my $errorMessage = "Required information is missing. " .
533
            "Please fill in all required fields and submit the form.";
534
        fullTemplate( ['resetPass'],  { stage => "resetpass",
535
                                        allParams => $allParams,
536
                                        errorMessage => $errorMessage });
537
        exit();
538
    }
539

    
540
    # We have all of the info we need, so try to change the password
541
    my $o = $query->param('o');
542
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
543
    debug("handleResetPassword: dn: $dn");
544
    if ($query->param('o') =~ "LTER") {
545
        fullTemplate( ['registerLter'] );
546
        exit();
547
    } else {
548
        my $errorMessage = "";
549
        my $recipient;
550
        my $userPass;
551
        my $entry = getLdapEntry($ldapurl, $searchBase, 
552
                $query->param('uid'), $query->param('o'));
553

    
554
        if ($entry) {
555
            $recipient = $entry->get_value('mail');
556
            $userPass = getRandomPassword();
557
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
558
        } else {
559
            $errorMessage = "User not found in database.  Please try again.";
560
        }
561

    
562
        if ($errorMessage) {
563
            fullTemplate( ['resetPass'], { stage => "resetpass",
564
                                           allParams => $allParams,
565
                                           errorMessage => $errorMessage });
566
            exit();
567
        } else {
568
            my $errorMessage = sendPasswordNotification($query->param('uid'),
569
                    $query->param('o'), $userPass, $recipient, $cfg);
570
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
571
                                                  allParams => $allParams,
572
                                                  errorMessage => $errorMessage });
573
            exit();
574
        }
575
    }
576
}
577

    
578
#
579
# reset a user's password upon request- no initial params
580
# only display resetpass template without any error
581
#
582
sub handleInitialResetPassword {
583
    print "Content-type: text/html\n\n";
584
    my $errorMessage = "";
585
    fullTemplate( ['resetPass'], { stage => "resetpass",
586
                                   errorMessage => $errorMessage });
587
    exit();
588
}
589

    
590
#
591
# Construct a random string to use for a newly reset password
592
#
593
sub getRandomPassword {
594
    my $length = shift;
595
    if (!$length) {
596
        $length = 8;
597
    }
598
    my $newPass = "";
599

    
600
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
601
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
602
    return $newPass;
603
}
604

    
605
#
606
# Change a password to a new value, binding as the provided user
607
#
608
sub changePassword {
609
    my $userDN = shift;
610
    my $userPass = shift;
611
    my $bindDN = shift;
612
    my $bindPass = shift;
613
    my $o = shift;
614

    
615
    my $searchBase = $ldapConfig->{$o}{'base'};
616

    
617
    my $errorMessage = 0;
618
    my $ldap;
619

    
620
    #if main ldap server is down, a html file containing warning message will be returned
621
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
622
    
623
    if ($ldap) {
624
        #$ldap->start_tls( verify => 'require',
625
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
626
        $ldap->start_tls( verify => 'none');
627
        debug("changePassword: attempting to bind to $bindDN");
628
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
629
                                  password => $bindPass );
630
        if ($bindresult->code) {
631
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
632
                            "correct? Please correct and try again...";
633
            return $errorMessage;
634
        }
635

    
636
    	# Find the user here and change their entry
637
    	my $newpass = createSeededPassHash($userPass);
638
    	my $modifications = { userPassword => $newpass };
639
      debug("changePass: setting password for $userDN to $newpass");
640
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
641
    
642
    	if ($result->code()) {
643
            debug("changePass: error changing password: " . $result->error);
644
        	$errorMessage = "There was an error changing the password:" .
645
                           "<br />\n" . $result->error;
646
    	} 
647
    	$ldap->unbind;   # take down session
648
    }
649

    
650
    return $errorMessage;
651
}
652

    
653
#
654
# generate a Seeded SHA1 hash of a plaintext password
655
#
656
sub createSeededPassHash {
657
    my $secret = shift;
658

    
659
    my $salt = "";
660
    for (my $i=0; $i < 4; $i++) {
661
        $salt .= int(rand(10));
662
    }
663

    
664
    my $ctx = Digest::SHA1->new;
665
    $ctx->add($secret);
666
    $ctx->add($salt);
667
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
668

    
669
    return $hashedPasswd;
670
}
671

    
672
#
673
# Look up an ldap entry for a user
674
#
675
sub getLdapEntry {
676
    my $ldapurl = shift;
677
    my $base = shift;
678
    my $username = shift;
679
    my $org = shift;
680

    
681
    my $entry = "";
682
    my $mesg;
683
    my $ldap;
684
    debug("ldap server: $ldapurl");
685

    
686
    #if main ldap server is down, a html file containing warning message will be returned
687
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
688
    
689
    if ($ldap) {
690
    	$ldap->start_tls( verify => 'none');
691
    	my $bindresult = $ldap->bind;
692
    	if ($bindresult->code) {
693
        	return $entry;
694
    	}
695

    
696
    	if($ldapConfig->{$org}{'filter'}){
697
            debug("getLdapEntry: filter set, searching for base=$base, " .
698
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
699
        	$mesg = $ldap->search ( base   => $base,
700
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
701
    	} else {
702
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
703
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
704
    	}
705
    
706
    	if ($mesg->count > 0) {
707
        	$entry = $mesg->pop_entry;
708
        	$ldap->unbind;   # take down session
709
    	} else {
710
        	$ldap->unbind;   # take down session
711
        	# Follow references by recursive call to self
712
        	my @references = $mesg->references();
713
        	for (my $i = 0; $i <= $#references; $i++) {
714
            	my $uri = URI->new($references[$i]);
715
            	my $host = $uri->host();
716
            	my $path = $uri->path();
717
            	$path =~ s/^\///;
718
            	$entry = &getLdapEntry($host, $path, $username, $org);
719
            	if ($entry) {
720
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
721
                	return $entry;
722
            	}
723
        	}
724
    	}
725
    }
726
    return $entry;
727
}
728

    
729
# 
730
# send an email message notifying the user of the pw change
731
#
732
sub sendPasswordNotification {
733
    my $username = shift;
734
    my $org = shift;
735
    my $newPass = shift;
736
    my $recipient = shift;
737
    my $cfg = shift;
738

    
739
    my $errorMessage = "";
740
    if ($recipient) {
741
        my $mailhost = $properties->getProperty('email.mailhost');
742
        my $sender =  $properties->getProperty('email.sender');
743
        # Send the email message to them
744
        my $smtp = Net::SMTP->new($mailhost);
745
        $smtp->mail($sender);
746
        $smtp->to($recipient);
747

    
748
        my $message = <<"        ENDOFMESSAGE";
749
        To: $recipient
750
        From: $sender
751
        Subject: KNB Password Reset
752
        
753
        Somebody (hopefully you) requested that your KNB password be reset.  
754
        This is generally done when somebody forgets their password.  Your 
755
        password can be changed by visiting the following URL:
756

    
757
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
758

    
759
            Username: $username
760
        Organization: $org
761
        New Password: $newPass
762

    
763
        Thanks,
764
            The KNB Development Team
765
    
766
        ENDOFMESSAGE
767
        $message =~ s/^[ \t\r\f]+//gm;
768
    
769
        $smtp->data($message);
770
        $smtp->quit;
771
    } else {
772
        $errorMessage = "Failed to send password because I " .
773
                        "couldn't find a valid email address.";
774
    }
775
    return $errorMessage;
776
}
777

    
778
#
779
# search the LDAP directory to see if a similar account already exists
780
#
781
sub findExistingAccounts {
782
    my $ldapurl = shift;
783
    my $base = shift;
784
    my $filter = shift;
785
    my $attref = shift;
786
    my $ldap;
787
    my $mesg;
788

    
789
    my $foundAccounts = 0;
790

    
791
    #if main ldap server is down, a html file containing warning message will be returned
792
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
793
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
794
    if ($ldap) {
795
    	$ldap->start_tls( verify => 'none');
796
    	$ldap->bind( version => 3, anonymous => 1);
797
		$mesg = $ldap->search (
798
			base   => $base,
799
			filter => $filter,
800
			attrs => @$attref,
801
		);
802

    
803
	    if ($mesg->count() > 0) {
804
			$foundAccounts = "";
805
			my $entry;
806
			foreach $entry ($mesg->all_entries) { 
807
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
808
                # this could be done directly with filters on the LDAP connection, instead.
809
                if ($entry->dn !~ /ou=Account/) {
810
                    $foundAccounts .= "<p>\n<b><u>Account:</u> ";
811
                    $foundAccounts .= $entry->dn();
812
                    $foundAccounts .= "</b><br />\n";
813
                    foreach my $attribute ($entry->attributes()) {
814
                        my $value = $entry->get_value($attribute);
815
                        $foundAccounts .= "$attribute: ";
816
                        $foundAccounts .= $value;
817
                        $foundAccounts .= "<br />\n";
818
                    }
819
                    $foundAccounts .= "</p>\n";
820
                }
821
			}
822
        }
823
    	$ldap->unbind;   # take down session
824

    
825
    	# Follow references
826
    	my @references = $mesg->references();
827
    	for (my $i = 0; $i <= $#references; $i++) {
828
        	my $uri = URI->new($references[$i]);
829
        	my $host = $uri->host();
830
        	my $path = $uri->path();
831
        	$path =~ s/^\///;
832
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
833
        	if ($refFound) {
834
            	$foundAccounts .= $refFound;
835
        	}
836
    	}
837
    }
838

    
839
    #print "<p>Checking referrals...</p>\n";
840
    #my @referrals = $mesg->referrals();
841
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
842
    #for (my $i = 0; $i <= $#referrals; $i++) {
843
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
844
    #}
845

    
846
    return $foundAccounts;
847
}
848

    
849
#
850
# Validate that we have the proper set of input parameters
851
#
852
sub paramsAreValid {
853
    my @pnames = @_;
854

    
855
    my $allValid = 1;
856
    foreach my $parameter (@pnames) {
857
        if (!defined($query->param($parameter)) || 
858
            ! $query->param($parameter) ||
859
            $query->param($parameter) =~ /^\s+$/) {
860
            $allValid = 0;
861
        }
862
    }
863

    
864
    return $allValid;
865
}
866

    
867
#
868
# Create a temporary account for a user and send an email with a link which can click for the
869
# verification. This is used to protect the ldap server against spams.
870
#
871
sub createTemporaryAccount {
872
    my $allParams = shift;
873
    my $org = $query->param('o'); 
874
    my $ou = $query->param('ou');
875

    
876
    
877
    ################## Search LDAP for matching o or ou that already exist
878
    my $orgAuthBase; 
879
    my $filter;   
880
    if($org) {
881
        $filter = "(o" 
882
                  . "=" . $org .
883
                 ")";
884
        $orgAuthBase = $ldapConfig->{$org}{'base'};
885
    } else {
886
        $filter = "(ou" 
887
                  . "=" . $ou .
888
                 ")";
889
        $orgAuthBase = $ldapConfig->{$ou}{'base'};
890
    }
891
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
892
    debug("search filer " . $filter);
893
    debug("ldap server ". $ldapurl);
894
    debug("sesarch base " . $tmpSearchBase);
895
    print "Content-type: text/html\n\n";
896
    my @attrs = ['o', 'ou' ];
897
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
898
    
899
    my $ldapUsername = $ldapConfig->{$org}{'user'};
900
    my $ldapPassword = $ldapConfig->{$org}{'password'};
901
    debug("LDAP connection to $ldapurl...");    
902
    
903
        
904
    if(!$found) {
905
        debug("generate the subtree in the dc=tmp===========================");
906
        #need to generate the subtree o or ou
907
        my $dn;
908
        #if main ldap server is down, a html file containing warning message will be returned
909
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
910
        if ($ldap) {
911
            $ldap->start_tls( verify => 'none');
912
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
913
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
914
            my $additions;
915
             if($org) {
916
                $additions = [ 
917
                'o'   => $org,
918
                'objectclass' => ['top', 'organization']
919
                ];
920
                $dn='o=' . $org . ',' . $tmpSearchBase;
921
             } else {
922
                $additions = [ 
923
                'ou'   => $ou,
924
                'objectclass' => ['top', 'organizationalUnit']
925
                ];
926
                $dn='ou=' . $ou . ',' . $tmpSearchBase;
927
             }
928
            # Do the insertion
929
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
930
            if ($result->code()) {
931
                fullTemplate( ['registerFailed', 'register'], { stage => "register",
932
                                                            allParams => $allParams,
933
                                                            errorMessage => $result->error });
934
                $ldap->unbind;   # take down session
935
                exist(0)
936
                # TODO SCW was included as separate errors, test this
937
                #$templateVars    = setVars({ stage => "register",
938
                #                     allParams => $allParams });
939
                #$template->process( $templates->{'register'}, $templateVars);
940
            } 
941
            $ldap->unbind;   # take down session
942
        } else {
943
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
944
                                                            allParams => $allParams,
945
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
946
            exit(0);
947
        }
948

    
949
    } 
950
    
951
    ################create an account under tmp subtree 
952
    
953
    #generate a randomstr for matching the email.
954
    my $randomStr = getRandomPassword(16);
955
    # Create a hashed version of the password
956
    my $shapass = createSeededPassHash($query->param('userPassword'));
957
    my $additions = [ 
958
                'uid'   => $query->param('uid'),
959
                'cn'   => join(" ", $query->param('givenName'), 
960
                                    $query->param('sn')),
961
                'sn'   => $query->param('sn'),
962
                'givenName'   => $query->param('givenName'),
963
                'mail' => $query->param('mail'),
964
                'userPassword' => $shapass,
965
                'employeeNumber' => $randomStr,
966
                'objectclass' => ['top', 'person', 'organizationalPerson', 
967
                                'inetOrgPerson', 'uidObject' ]
968
                ];
969
    if (defined($query->param('telephoneNumber')) && 
970
                $query->param('telephoneNumber') &&
971
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
972
                $$additions[$#$additions + 1] = 'telephoneNumber';
973
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
974
    }
975
    if (defined($query->param('title')) && 
976
                $query->param('title') &&
977
                ! $query->param('title') =~ /^\s+$/) {
978
                $$additions[$#$additions + 1] = 'title';
979
                $$additions[$#$additions + 1] = $query->param('title');
980
    }
981
    my $dn;
982
    my $orgStr;
983
    if($org) {
984
        $$additions[$#$additions + 1] = 'o';
985
        $$additions[$#$additions + 1] = $org;
986
        $dn='uid=' . $query->param('uid') . ',' . 'o=' . $org . ',' . $tmpSearchBase;
987
        $orgStr='o=' . $org;
988
    } else {
989
        $$additions[$#$additions + 1] = 'ou';
990
        $$additions[$#$additions + 1] = $ou;
991
        $dn='uid=' . $query->param('uid') . ',' . 'ou=' . $ou . ',' . $tmpSearchBase;
992
        $orgStr='ou=' . $ou;
993
    }
994
    my $tmp = 1;
995
    createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
996
    
997
    
998
    ####################send the verification email to the user
999
    my $link = $contextUrl. '/cgi-bin/ldapweb.cgi?cfg=' . $skinName . '&' . 'stage=' . $emailVerification . '&' . 'dn=' . $dn . '&' . 'hash=' . $randomStr . '&' . $orgStr . '&uid=' . $query->param('uid');
1000
    
1001
    my $mailhost = $properties->getProperty('email.mailhost');
1002
    my $sender =  $properties->getProperty('email.sender');
1003
    my $recipient = $query->param('mail');
1004
    # Send the email message to them
1005
    my $smtp = Net::SMTP->new($mailhost);
1006
    $smtp->mail($sender);
1007
    $smtp->to($recipient);
1008

    
1009
    my $message = <<"     ENDOFMESSAGE";
1010
    To: $recipient
1011
    From: $sender
1012
    Subject: KNB Password Reset
1013
        
1014
    Somebody (hopefully you) registered a KNB account.  
1015
    Please click the following link to activate your account.
1016
    If the link doesn't work, please copy the link to your browser:
1017
    
1018
    $link
1019

    
1020
    Thanks,
1021
        The KNB Development Team
1022
    
1023
     ENDOFMESSAGE
1024
     $message =~ s/^[ \t\r\f]+//gm;
1025
    
1026
     $smtp->data($message);
1027
     $smtp->quit;
1028
    debug("the link is " . $link);
1029
    fullTemplate( ['success'] );
1030
    
1031
}
1032

    
1033
#
1034
# Bind to LDAP and create a new account using the information provided
1035
# by the user
1036
#
1037
sub createAccount2 {
1038
    my $dn = shift;
1039
    my $ldapUsername = shift;
1040
    my $ldapPassword = shift;
1041
    my $additions = shift;
1042
    my $temp = shift; #if it is for a temporary account.
1043
    my $allParams = shift;
1044
    
1045
    my @failureTemplate;
1046
    if($temp){
1047
        @failureTemplate = ['registerFailed', 'register'];
1048
    } else {
1049
        @failureTemplate = ['registerFailed'];
1050
    }
1051
    print "Content-type: text/html\n\n";
1052
    debug("the dn is " . $dn);
1053
    debug("LDAP connection to $ldapurl...");    
1054
    #if main ldap server is down, a html file containing warning message will be returned
1055
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1056
    if ($ldap) {
1057
            $ldap->start_tls( verify => 'none');
1058
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1059
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1060
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1061
            if ($result->code()) {
1062
                fullTemplate(@failureTemplate, { stage => "register",
1063
                                                            allParams => $allParams,
1064
                                                            errorMessage => $result->error });
1065
                # TODO SCW was included as separate errors, test this
1066
                #$templateVars    = setVars({ stage => "register",
1067
                #                     allParams => $allParams });
1068
                #$template->process( $templates->{'register'}, $templateVars);
1069
            } else {
1070
                #fullTemplate( ['success'] );
1071
            }
1072
            $ldap->unbind;   # take down session
1073
            
1074
    } else {   
1075
         fullTemplate(@failureTemplate, { stage => "register",
1076
                                                            allParams => $allParams,
1077
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1078
         exit(0);
1079
    }
1080
  
1081
}
1082

    
1083
#
1084
# Bind to LDAP and create a new account using the information provided
1085
# by the user
1086
#
1087
sub createAccount {
1088
    my $allParams = shift;
1089

    
1090
    if ($query->param('o') =~ "LTER") {
1091
        fullTemplate( ['registerLter'] );
1092
    } else {
1093

    
1094
        # Be sure the passwords match
1095
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
1096
            my $errorMessage = "The passwords do not match. Try again.";
1097
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
1098
                                                            allParams => $allParams,
1099
                                                            errorMessage => $errorMessage });
1100
            exit();
1101
        }
1102

    
1103
        my $o = $query->param('o');
1104

    
1105
        my $searchBase = $ldapConfig->{$o}{'base'};
1106
        my $dnBase = $ldapConfig->{$o}{'dn'};
1107
        debug("the dn is " . $dnBase);
1108
        my $ldapUsername = $ldapConfig->{$o}{'user'};
1109
        my $ldapPassword = $ldapConfig->{$o}{'password'};
1110
        debug("LDAP connection to $ldapurl...");    
1111
        #if main ldap server is down, a html file containing warning message will be returned
1112
        my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1113
        
1114
        if ($ldap) {
1115
        	$ldap->start_tls( verify => 'none');
1116
        	debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1117
        	$ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1118
        
1119
        	my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
1120
        	debug("Inserting new entry for: $dn");
1121

    
1122
        	# Create a hashed version of the password
1123
        	my $shapass = createSeededPassHash($query->param('userPassword'));
1124

    
1125
        	# Do the insertion
1126
        	my $additions = [ 
1127
                'uid'   => $query->param('uid'),
1128
                'o'   => $query->param('o'),
1129
                'cn'   => join(" ", $query->param('givenName'), 
1130
                                    $query->param('sn')),
1131
                'sn'   => $query->param('sn'),
1132
                'givenName'   => $query->param('givenName'),
1133
                'mail' => $query->param('mail'),
1134
                'userPassword' => $shapass,
1135
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1136
                                'inetOrgPerson', 'uidObject' ]
1137
            	];
1138
        	if (defined($query->param('telephoneNumber')) && 
1139
            	$query->param('telephoneNumber') &&
1140
            	! $query->param('telephoneNumber') =~ /^\s+$/) {
1141
            	$$additions[$#$additions + 1] = 'telephoneNumber';
1142
            	$$additions[$#$additions + 1] = $query->param('telephoneNumber');
1143
        	}
1144
        	if (defined($query->param('title')) && 
1145
            	$query->param('title') &&
1146
            	! $query->param('title') =~ /^\s+$/) {
1147
            	$$additions[$#$additions + 1] = 'title';
1148
            	$$additions[$#$additions + 1] = $query->param('title');
1149
        	}
1150
        	my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
1151
    
1152
        	if ($result->code()) {
1153
            	fullTemplate( ['registerFailed', 'register'], { stage => "register",
1154
                                                            allParams => $allParams,
1155
                                                            errorMessage => $result->error });
1156
            	# TODO SCW was included as separate errors, test this
1157
           	 	#$templateVars    = setVars({ stage => "register",
1158
           	 	#                     allParams => $allParams });
1159
            	#$template->process( $templates->{'register'}, $templateVars);
1160
        	} else {
1161
            	fullTemplate( ['success'] );
1162
        	}
1163

    
1164
        	$ldap->unbind;   # take down session
1165
        }
1166
    }
1167
}
1168

    
1169
#
1170
# This subroutine will handle a email verification:
1171
# If the hash string matches the one store in the ldap, the account will be
1172
# copied from the temporary space to the permanent tree and the account in 
1173
# the temporary space will be removed.
1174
sub handleEmailVerification {
1175

    
1176
    my $cfg = $query->param('cfg');
1177
    my $dn = $query->param('dn');
1178
    my $hash = $query->param('hash');
1179
    my $org = $query->param('o');
1180
    my $ou = $query->param('ou');
1181
    my $uid = $query->param('uid');
1182
    
1183
    my $orgAttributeName;
1184
    my $ldapUsername;
1185
    my $ldapPassword;
1186
    my $ldaporg;
1187
    my $orgAuthBase;
1188
    if($org) {
1189
        $ldapUsername = $ldapConfig->{$org}{'user'};
1190
        $ldapPassword = $ldapConfig->{$org}{'password'};
1191
        $orgAttributeName = 'o';
1192
        $ldaporg = $org;
1193
        $orgAuthBase = $ldapConfig->{$org}{'base'};
1194
    } else {
1195
        $ldapUsername = $ldapConfig->{$ou}{'user'};
1196
        $ldapPassword = $ldapConfig->{$ou}{'password'};
1197
        $orgAttributeName = 'ou';
1198
        $ldaporg = $ou;
1199
        $orgAuthBase = $ldapConfig->{$org}{'base'};
1200
    }
1201
    debug("LDAP connection to $ldapurl...");    
1202
    
1203

    
1204
   print "Content-type: text/html\n\n";
1205
   #if main ldap server is down, a html file containing warning message will be returned
1206
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1207
   if ($ldap) {
1208
        $ldap->start_tls( verify => 'none');
1209
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1210
        my $mesg = $ldap->search(base => $dn, scope => 'base', filter => '(objectClass=*)');
1211
        my $max = $mesg->count;
1212
        debug("the count is " . $max);
1213
        if($max < 1) {
1214
            $ldap->unbind;   # take down session
1215
            fullTemplate( ['registerFailed'], {errorMessage => "No record was founded to matche the dn " . $dn . " for the verification."});
1216
            #handleLDAPBindFailure($ldapurl);
1217
            exit(0);
1218
        } else {
1219
            #check if the hash string match
1220
            my $entry = $mesg->entry (0);
1221
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1222
            if( $hashStrFromLdap eq $hash) {
1223
                #my $additions = [ ];
1224
                #foreach my $attr ( $entry->attributes ) {
1225
                    #if($attr ne 'employeeNumber') {
1226
                        #$$additions[$#$additions + 1] = $attr;
1227
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1228
                    #}
1229
                #}
1230
                #my $tmp=0;
1231
                #my $allParams="";
1232
                $mesg = $ldap->moddn(
1233
                            dn => $dn,
1234
                            deleteoldrdn => 1,
1235
                            newrdn => "uid=" . $uid,
1236
                            newsuperior  => $orgAttributeName . "=" . $ldaporg . "," . $orgAuthBase);
1237
                $ldap->unbind;   # take down session
1238
                if(mesg->code()) {
1239
                    fullTemplate( ['registerFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1240
                    exit(0);
1241
                } else {
1242
                    fullTemplate( ['success'] );
1243
                }
1244
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1245
            } else {
1246
                $ldap->unbind;   # take down session
1247
                fullTemplate( ['registerFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1248
                exit(0);
1249
            }
1250
            
1251
        }
1252
    } else {   
1253
        handleLDAPBindFailure($ldapurl);
1254
        exit(0);
1255
    }
1256

    
1257
}
1258

    
1259
sub handleResponseMessage {
1260

    
1261
  print "Content-type: text/html\n\n";
1262
  my $errorMessage = "You provided invalid input to the script. " .
1263
                     "Try again please.";
1264
  fullTemplate( [], { stage => $templates->{'stage'},
1265
                      errorMessage => $errorMessage });
1266
  exit();
1267
}
1268

    
1269
#
1270
# perform a simple search against the LDAP database using 
1271
# a small subset of attributes of each dn and return it
1272
# as a table to the calling browser.
1273
#
1274
sub handleSimpleSearch {
1275

    
1276
    my $o = $query->param('o');
1277

    
1278
    my $ldapurl = $ldapConfig->{$o}{'url'};
1279
    my $searchBase = $ldapConfig->{$o}{'base'};
1280

    
1281
    print "Content-type: text/html\n\n";
1282

    
1283
    my $allParams = { 
1284
                      'cn' => $query->param('cn'),
1285
                      'sn' => $query->param('sn'),
1286
                      'gn' => $query->param('gn'),
1287
                      'o'  => $query->param('o'),
1288
                      'facsimiletelephonenumber' 
1289
                      => $query->param('facsimiletelephonenumber'),
1290
                      'mail' => $query->param('cmail'),
1291
                      'telephonenumber' => $query->param('telephonenumber'),
1292
                      'title' => $query->param('title'),
1293
                      'uid' => $query->param('uid'),
1294
                      'ou' => $query->param('ou'),
1295
                    };
1296

    
1297
    # Search LDAP for matching entries that already exist
1298
    my $filter = "(" . 
1299
                 $query->param('searchField') . "=" .
1300
                 "*" .
1301
                 $query->param('searchValue') .
1302
                 "*" .
1303
                 ")";
1304

    
1305
    my @attrs = [ 'sn', 
1306
                  'gn', 
1307
                  'cn', 
1308
                  'o', 
1309
                  'facsimiletelephonenumber', 
1310
                  'mail', 
1311
                  'telephoneNumber', 
1312
                  'title', 
1313
                  'uid', 
1314
                  'labeledURI', 
1315
                  'ou' ];
1316

    
1317
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1318

    
1319
    # Send back the search results
1320
    if ($found) {
1321
      fullTemplate( ('searchResults'), { stage => "searchresults",
1322
                                         allParams => $allParams,
1323
                                         foundAccounts => $found });
1324
    } else {
1325
      $found = "No entries matched your criteria.  Please try again\n";
1326

    
1327
      fullTemplate( ('searchResults'), { stage => "searchresults",
1328
                                         allParams => $allParams,
1329
                                         foundAccounts => $found });
1330
    }
1331

    
1332
    exit();
1333
}
1334

    
1335
#
1336
# search the LDAP directory to see if a similar account already exists
1337
#
1338
sub searchDirectory {
1339
    my $ldapurl = shift;
1340
    my $base = shift;
1341
    my $filter = shift;
1342
    my $attref = shift;
1343

    
1344
	my $mesg;
1345
    my $foundAccounts = 0;
1346
    
1347
    #if ldap server is down, a html file containing warning message will be returned
1348
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1349
    
1350
    if ($ldap) {
1351
    	$ldap->start_tls( verify => 'none');
1352
    	$ldap->bind( version => 3, anonymous => 1);
1353
    	my $mesg = $ldap->search (
1354
        	base   => $base,
1355
        	filter => $filter,
1356
        	attrs => @$attref,
1357
    	);
1358

    
1359
    	if ($mesg->count() > 0) {
1360
        	$foundAccounts = "";
1361
        	my $entry;
1362
        	foreach $entry ($mesg->sorted(['sn'])) {
1363
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1364
          		$foundAccounts .= "<a href=\"" unless 
1365
                    (!$entry->get_value('labeledURI'));
1366
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1367
                    (!$entry->get_value('labeledURI'));
1368
          		$foundAccounts .= "\">\n" unless 
1369
                    (!$entry->get_value('labeledURI'));
1370
          		$foundAccounts .= $entry->get_value('givenName');
1371
          		$foundAccounts .= "</a>\n" unless 
1372
                    (!$entry->get_value('labeledURI'));
1373
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1374
          		$foundAccounts .= "<a href=\"" unless 
1375
                    (!$entry->get_value('labeledURI'));
1376
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1377
                    (!$entry->get_value('labeledURI'));
1378
          		$foundAccounts .= "\">\n" unless 
1379
                    (!$entry->get_value('labeledURI'));
1380
          		$foundAccounts .= $entry->get_value('sn');
1381
          		$foundAccounts .= "</a>\n";
1382
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1383
          		$foundAccounts .= $entry->get_value('mail');
1384
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1385
          		$foundAccounts .= $entry->get_value('telephonenumber');
1386
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1387
          		$foundAccounts .= $entry->get_value('title');
1388
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1389
          		$foundAccounts .= $entry->get_value('ou');
1390
          		$foundAccounts .= "\n</td>\n";
1391
          		$foundAccounts .= "</tr>\n";
1392
        	}
1393
    	}
1394
    	$ldap->unbind;   # take down session
1395
    }
1396
    return $foundAccounts;
1397
}
1398

    
1399
sub debug {
1400
    my $msg = shift;
1401
    
1402
    if ($debug) {
1403
        print STDERR "LDAPweb: $msg\n";
1404
    }
1405
}
1406

    
1407
sub handleLDAPBindFailure {
1408
    my $ldapAttemptUrl = shift;
1409
    my $primaryLdap =  $properties->getProperty('auth.url');
1410

    
1411
    if ($ldapAttemptUrl eq  $primaryLdap) {
1412
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1413
    } else {
1414
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1415
    }
1416
}
1417

    
1418
sub handleGeneralServerFailure {
1419
    my $errorMessage = shift;
1420
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1421
    exit(0);   
1422
   }
1423
    
1424
sub setVars {
1425
    my $paramVars = shift;
1426
    # initialize default parameters 
1427
    my $templateVars = { cfg => $cfg,
1428
                         styleSkinsPath => $contextUrl . "/style/skins",
1429
                         styleCommonPath => $contextUrl . "/style/common",
1430
                         contextUrl => $contextUrl,
1431
                         cgiPrefix => $cgiPrefix,
1432
                         orgList => \@orgList,
1433
                         config  => $config,
1434
    };
1435
    
1436
    # append customized params
1437
    while (my ($k, $v) = each (%$paramVars)) {
1438
        $templateVars->{$k} = $v;
1439
    }
1440
    
1441
    return $templateVars;
1442
} 
1443