Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8254

1
#!/usr/bin/perl -w
2
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California 
5
#
6
#   '$Author: leinfelder $'
7
#     '$Date: 2013-09-20 12:20:09 -0700 (Fri, 20 Sep 2013) $'
8
# '$Revision: 8254 $' 
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 $serverUrl = $protocol . $properties->getProperty('server.name');
71
if ($properties->getProperty('server.httpPort') ne '80') {
72
        $serverUrl = $serverUrl . ':' . $properties->getProperty('server.httpPort');
73
}
74
my $context = $properties->getProperty('application.context');
75
my $contextUrl = $serverUrl . '/' .  $context;
76

    
77
my $metacatUrl = $contextUrl . "/metacat";
78
my $cgiPrefix = "/" . $context . "/cgi-bin";
79
my $styleSkinsPath = $contextUrl . "/style/skins";
80
my $styleCommonPath = $contextUrl . "/style/common";
81

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

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

    
89
my $emailVerification= 'emailverification';
90

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

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

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

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

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

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

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

    
148
# XXX END HACK
149

    
150

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

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

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

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

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

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

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

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

    
187
# This is a hash which has the keys of the organization's properties 'name', 'base', 'organization'.
188
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
189

    
190
#This is a hash which has the keys of the ldap sub tree names of the organizations, such as 'NCEAS', 'LTER' and 'KU', and values are real name of the organization.
191
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
192
# pull out properties available e.g. 'name', 'base'
193
my @orgData = keys(%$orgProps);
194

    
195
my @orgList; #An array has the names (i.e, sub tree names, such as 'NCEAS', 'LTER' and 'KU')  of the all organizations in the metacat.properties. 
196
while (my ($oKey, $oVal) = each(%$orgNames)) {
197
    push(@orgList, $oKey);
198
}
199

    
200
my $authBase = $properties->getProperty("auth.base");
201
my $ldapConfig;
202
foreach my $o (@orgList) {
203
    foreach my $d (@orgData) {
204
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
205
    }
206

    
207
    # XXX hack, remove after 1.9
208
    if ($o eq 'UCNRS') {
209
        $ldapConfig->{'UCNRS'}{'base'} = $nrsConfig->{'base'};
210
        $ldapConfig->{'UCNRS'}{'user'} = $nrsConfig->{'username'};
211
        $ldapConfig->{'UCNRS'}{'password'} = $nrsConfig->{'password'};
212
    }
213

    
214
    # set default base
215
    if (!$ldapConfig->{$o}{'base'}) {
216
        $ldapConfig->{$o}{'base'} = $authBase;
217
    }
218

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

    
249
    if (!$ldapConfig->{$o}{'password'}) {
250
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
251
    }
252
}
253

    
254
### Determine the display organization list (such as NCEAS, Account ) in the ldap template files
255
my $displayOrgListStr;
256
$displayOrgListStr = $skinProperties->getProperty("ldap.templates.organizationList") or $displayOrgListStr = $properties->getProperty('ldap.templates.organizationList');
257
debug("the string of the org from properties : " . $displayOrgListStr);
258
my @displayOrgList = split(';', $displayOrgListStr);
259

    
260
my @validDisplayOrgList; #this array contains the org list which will be shown in the templates files.
261

    
262
my %orgNamesHash = %$orgNames;
263
foreach my $element (@displayOrgList) {
264
    if(exists $orgNamesHash{$element}) {
265
         debug("push the organization " . $element . " into the dispaly array");
266
         #if the name is found in the organization part of metacat.properties, put it into the valid array
267
         push(@validDisplayOrgList, $element);
268
    } 
269
    
270
}
271

    
272
if(!@validDisplayOrgList) {
273
     my $sender;
274
     $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
275
    print "Content-type: text/html\n\n";
276
    print "The value of property ldap.templates.organizationList in " 
277
     . $skinName . ".properties file or metacat.properties file (if the property doesn't exist in the " 
278
     . $skinName . ".properties file) is invalid. Please send the information to ". $sender;
279
    exit(0);
280
}
281

    
282

    
283
#--------------------------------------------------------------------------80c->
284
# Define the main program logic that calls subroutines to do the work
285
#--------------------------------------------------------------------------80c->
286

    
287
# The processing step we are handling
288
my $stage = $query->param('stage') || $templates->{'stage'};
289

    
290
my $cfg = $query->param('cfg');
291
debug("started with stage $stage, cfg $cfg");
292

    
293
# define the possible stages
294
my %stages = (
295
              'initregister'      => \&handleInitRegister,
296
              'register'          => \&handleRegister,
297
              'registerconfirmed' => \&handleRegisterConfirmed,
298
              'simplesearch'      => \&handleSimpleSearch,
299
              'initaddentry'      => \&handleInitAddEntry,
300
              'addentry'          => \&handleAddEntry,
301
              'initmodifyentry'   => \&handleInitModifyEntry,
302
              'modifyentry'       => \&handleModifyEntry,
303
              'changepass'        => \&handleChangePassword,
304
              'initchangepass'    => \&handleInitialChangePassword,
305
              'resetpass'         => \&handleResetPassword,
306
              'initresetpass'     => \&handleInitialResetPassword,
307
              'emailverification' => \&handleEmailVerification,
308
              'lookupname'        => \&handleLookupName,
309
              'searchnamesbyemail'=> \&handleSearchNameByEmail,
310
             );
311

    
312
# call the appropriate routine based on the stage
313
if ( $stages{$stage} ) {
314
  $stages{$stage}->();
315
} else {
316
  &handleResponseMessage();
317
}
318

    
319
#--------------------------------------------------------------------------80c->
320
# Define the subroutines to do the work
321
#--------------------------------------------------------------------------80c->
322

    
323
sub fullTemplate {
324
    my $templateList = shift;
325
    my $templateVars = setVars(shift);
326
    my $c = Captcha::reCAPTCHA->new;
327
    my $captcha = 'captcha';
328
    #my $error=null;
329
    my $use_ssl= 1;
330
    #my $options=null;
331
    # use the AJAX style, only need to provide the public key to the template
332
    $templateVars->{'recaptchaPublicKey'} = $recaptchaPublicKey;
333
    #$templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
334
    $template->process( $templates->{'header'}, $templateVars );
335
    foreach my $tmpl (@{$templateList}) {
336
        $template->process( $templates->{$tmpl}, $templateVars );
337
    }
338
    $template->process( $templates->{'footer'}, $templateVars );
339
}
340

    
341

    
342
#
343
# Initialize a form for a user to request the account name associated with an email address
344
#
345
sub handleLookupName {
346
    
347
    print "Content-type: text/html\n\n";
348
    # process the template files:
349
    fullTemplate(['lookupName']); 
350
    exit();
351
}
352

    
353
#
354
# Handle the user's request to look up account names with a specified email address.
355
# This relates to "Forget your user name"
356
#
357
sub handleSearchNameByEmail{
358

    
359
    print "Content-type: text/html\n\n";
360
   
361
    my $allParams = {'mail' => $query->param('mail')};
362
    my @requiredParams = ('mail');
363
    if (! paramsAreValid(@requiredParams)) {
364
        my $errorMessage = "Required information is missing. " .
365
            "Please fill in all required fields and resubmit the form.";
366
        fullTemplate(['lookupName'], { allParams => $allParams,
367
                                     errorMessage => $errorMessage });
368
        exit();
369
    }
370
    my $mail = $query->param('mail');
371
    
372
    #search accounts with the specified emails 
373
    $searchBase = $authBase; 
374
    my $filter = "(mail=" . $mail . ")";
375
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
376
    my $notHtmlFormat = 1;
377
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs, $notHtmlFormat);
378
    my $accountInfo;
379
    if ($found) {
380
        $accountInfo = $found;
381
    } else {
382
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n";
383
    }
384

    
385
    my $mailhost = $properties->getProperty('email.mailhost');
386
    my $sender;
387
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
388
    debug("the sender is " . $sender);
389
    my $recipient = $query->param('mail');
390
    # Send the email message to them
391
    my $smtp = Net::SMTP->new($mailhost) or do {  
392
                                                  fullTemplate( ['lookupName'], {allParams => $allParams, 
393
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " . 
394
                                                                $skinProperties->getProperty("email.recipient") . "." });  
395
                                                  exit(0);
396
                                               };
397
    $smtp->mail($sender);
398
    $smtp->to($recipient);
399

    
400
    my $message = <<"     ENDOFMESSAGE";
401
    To: $recipient
402
    From: $sender
403
    Subject: Your Account Information
404
        
405
    Somebody (hopefully you) looked up the account information associated with the email address.  
406
    Here is the account information:
407
    
408
    $accountInfo
409

    
410
    Thanks,
411
        $sender
412
    
413
     ENDOFMESSAGE
414
     $message =~ s/^[ \t\r\f]+//gm;
415
    
416
     $smtp->data($message);
417
     $smtp->quit;
418
     fullTemplate( ['lookupNameSuccess'] );
419
    
420
}
421

    
422

    
423
#
424
# create the initial registration form 
425
#
426
sub handleInitRegister {
427
  my $vars = shift;
428
  print "Content-type: text/html\n\n";
429
  # process the template files:
430
  fullTemplate(['register'], {stage => "register"}); 
431
  exit();
432
}
433

    
434

    
435

    
436
#
437
# process input from the register stage, which occurs when
438
# a user submits form data to create a new account
439
#
440
sub handleRegister {
441
    
442
    print "Content-type: text/html\n\n";
443
    if ($query->param('o') =~ "LTER") {
444
      fullTemplate( ['registerLter'] );
445
      exit(0);
446
    } 
447
    
448
    my $allParams = { 'givenName' => $query->param('givenName'), 
449
                      'sn' => $query->param('sn'),
450
                      'o' => $query->param('o'), 
451
                      'mail' => $query->param('mail'), 
452
                      'uid' => $query->param('uid'), 
453
                      'userPassword' => $query->param('userPassword'), 
454
                      'userPassword2' => $query->param('userPassword2'), 
455
                      'title' => $query->param('title'), 
456
                      'telephoneNumber' => $query->param('telephoneNumber') };
457
    
458
    # Check the recaptcha
459
    my $c = Captcha::reCAPTCHA->new;
460
    my $challenge = $query->param('recaptcha_challenge_field');
461
    my $response = $query->param('recaptcha_response_field');
462
    # Verify submission
463
    my $result = $c->check_answer(
464
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
465
        $challenge, $response
466
    );
467

    
468
    if ( $result->{is_valid} ) {
469
        #print "Yes!";
470
        #exit();
471
    }
472
    else {
473
        my $errorMessage = "The verification code is wrong. Please input again.";
474
        fullTemplate(['register'], { stage => "register",
475
                                     allParams => $allParams,
476
                                     errorMessage => $errorMessage });
477
        exit();
478
    }
479
    
480
    
481
    # Check that all required fields are provided and not null
482
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
483
                           'uid', 'userPassword', 'userPassword2');
484
    if (! paramsAreValid(@requiredParams)) {
485
        my $errorMessage = "Required information is missing. " .
486
            "Please fill in all required fields and resubmit the form.";
487
        fullTemplate(['register'], { stage => "register",
488
                                     allParams => $allParams,
489
                                     errorMessage => $errorMessage });
490
        exit();
491
    } else {
492
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
493
            my $errorMessage = "The passwords do not match. Try again.";
494
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
495
                                                            allParams => $allParams,
496
                                                            errorMessage => $errorMessage });
497
            exit();
498
        }
499
        my $o = $query->param('o');    
500
        $searchBase = $ldapConfig->{$o}{'base'};  
501
    }
502

    
503
    # Search LDAP for matching entries that already exist
504
    # Some forms use a single text search box, whereas others search per
505
    # attribute.
506
    my $filter;
507
    if ($query->param('searchField')) {
508

    
509
      $filter = "(|" . 
510
                "(uid=" . $query->param('searchField') . ") " .
511
                "(mail=" . $query->param('searchField') . ")" .
512
                "(&(sn=" . $query->param('searchField') . ") " . 
513
                "(givenName=" . $query->param('searchField') . "))" . 
514
                ")";
515
    } else {
516
      $filter = "(|" . 
517
                "(uid=" . $query->param('uid') . ") " .
518
                "(mail=" . $query->param('mail') . ")" .
519
                "(&(sn=" . $query->param('sn') . ") " . 
520
                "(givenName=" . $query->param('givenName') . "))" . 
521
                ")";
522
    }
523

    
524
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
525
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
526

    
527
    # If entries match, send back a request to confirm new-user creation
528
    if ($found) {
529
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
530
                                                     allParams => $allParams,
531
                                                     foundAccounts => $found });
532
    # Otherwise, create a new user in the LDAP directory
533
    } else {
534
        createTemporaryAccount($allParams);
535
    }
536

    
537
    exit();
538
}
539

    
540
#
541
# process input from the registerconfirmed stage, which occurs when
542
# a user chooses to create an account despite similarities to other
543
# existing accounts
544
#
545
sub handleRegisterConfirmed {
546
  
547
    my $allParams = { 'givenName' => $query->param('givenName'), 
548
                      'sn' => $query->param('sn'),
549
                      'o' => $query->param('o'), 
550
                      'mail' => $query->param('mail'), 
551
                      'uid' => $query->param('uid'), 
552
                      'userPassword' => $query->param('userPassword'), 
553
                      'userPassword2' => $query->param('userPassword2'), 
554
                      'title' => $query->param('title'), 
555
                      'telephoneNumber' => $query->param('telephoneNumber') };
556
    print "Content-type: text/html\n\n";
557
    createTemporaryAccount($allParams);
558
    exit();
559
}
560

    
561
#
562
# change a user's password upon request
563
#
564
sub handleChangePassword {
565

    
566
    print "Content-type: text/html\n\n";
567

    
568
    my $allParams = { 'test' => "1", };
569
    if ($query->param('uid')) {
570
        $$allParams{'uid'} = $query->param('uid');
571
    }
572
    if ($query->param('o')) {
573
        $$allParams{'o'} = $query->param('o');
574
        my $o = $query->param('o');
575
        
576
        $searchBase = $ldapConfig->{$o}{'base'};
577
    }
578

    
579

    
580
    # Check that all required fields are provided and not null
581
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
582
                           'userPassword', 'userPassword2');
583
    if (! paramsAreValid(@requiredParams)) {
584
        my $errorMessage = "Required information is missing. " .
585
            "Please fill in all required fields and submit the form.";
586
        fullTemplate( ['changePass'], { stage => "changepass",
587
                                        allParams => $allParams,
588
                                        errorMessage => $errorMessage });
589
        exit();
590
    }
591

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

    
595
        my $o = $query->param('o');
596
        $searchBase = $ldapConfig->{$o}{'base'};
597
        $ldapUsername = $ldapConfig->{$o}{'user'};
598
        $ldapPassword = $ldapConfig->{$o}{'password'};
599

    
600
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
601
        if ($query->param('o') =~ "LTER") {
602
            fullTemplate( ['registerLter'] );
603
        } else {
604
            my $errorMessage = changePassword(
605
                    $dn, $query->param('userPassword'), 
606
                    $dn, $query->param('oldpass'), $query->param('o'));
607
            if ($errorMessage) {
608
                fullTemplate( ['changePass'], { stage => "changepass",
609
                                                allParams => $allParams,
610
                                                errorMessage => $errorMessage });
611
                exit();
612
            } else {
613
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
614
                                                       allParams => $allParams });
615
                exit();
616
            }
617
        }
618
    } else {
619
        my $errorMessage = "The passwords do not match. Try again.";
620
        fullTemplate( ['changePass'], { stage => "changepass",
621
                                        allParams => $allParams,
622
                                        errorMessage => $errorMessage });
623
        exit();
624
    }
625
}
626

    
627
#
628
# change a user's password upon request - no input params
629
# only display chagepass template without any error
630
#
631
sub handleInitialChangePassword {
632
    print "Content-type: text/html\n\n";
633

    
634
    my $allParams = { 'test' => "1", };
635
    my $errorMessage = "";
636
    fullTemplate( ['changePass'], { stage => "changepass",
637
                                    errorMessage => $errorMessage });
638
    exit();
639
}
640

    
641
#
642
# reset a user's password upon request
643
#
644
sub handleResetPassword {
645

    
646
    print "Content-type: text/html\n\n";
647

    
648
    my $allParams = { 'test' => "1", };
649
    if ($query->param('uid')) {
650
        $$allParams{'uid'} = $query->param('uid');
651
    }
652
    if ($query->param('o')) {
653
        $$allParams{'o'} = $query->param('o');
654
        my $o = $query->param('o');
655
        
656
        $searchBase = $ldapConfig->{$o}{'base'};
657
        $ldapUsername = $ldapConfig->{$o}{'user'};
658
        $ldapPassword = $ldapConfig->{$o}{'password'};
659
    }
660

    
661
    # Check that all required fields are provided and not null
662
    my @requiredParams = ( 'uid', 'o' );
663
    if (! paramsAreValid(@requiredParams)) {
664
        my $errorMessage = "Required information is missing. " .
665
            "Please fill in all required fields and submit the form.";
666
        fullTemplate( ['resetPass'],  { stage => "resetpass",
667
                                        allParams => $allParams,
668
                                        errorMessage => $errorMessage });
669
        exit();
670
    }
671

    
672
    # We have all of the info we need, so try to change the password
673
    my $o = $query->param('o');
674
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
675
    debug("handleResetPassword: dn: $dn");
676
    if ($query->param('o') =~ "LTER") {
677
        fullTemplate( ['registerLter'] );
678
        exit();
679
    } else {
680
        my $errorMessage = "";
681
        my $recipient;
682
        my $userPass;
683
        my $entry = getLdapEntry($ldapurl, $searchBase, 
684
                $query->param('uid'), $query->param('o'));
685

    
686
        if ($entry) {
687
            $recipient = $entry->get_value('mail');
688
            $userPass = getRandomPassword();
689
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
690
        } else {
691
            $errorMessage = "User not found in database.  Please try again.";
692
        }
693

    
694
        if ($errorMessage) {
695
            fullTemplate( ['resetPass'], { stage => "resetpass",
696
                                           allParams => $allParams,
697
                                           errorMessage => $errorMessage });
698
            exit();
699
        } else {
700
            my $errorMessage = sendPasswordNotification($query->param('uid'),
701
                    $query->param('o'), $userPass, $recipient, $cfg);
702
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
703
                                                  allParams => $allParams,
704
                                                  errorMessage => $errorMessage });
705
            exit();
706
        }
707
    }
708
}
709

    
710
#
711
# reset a user's password upon request- no initial params
712
# only display resetpass template without any error
713
#
714
sub handleInitialResetPassword {
715
    print "Content-type: text/html\n\n";
716
    my $errorMessage = "";
717
    fullTemplate( ['resetPass'], { stage => "resetpass",
718
                                   errorMessage => $errorMessage });
719
    exit();
720
}
721

    
722
#
723
# Construct a random string to use for a newly reset password
724
#
725
sub getRandomPassword {
726
    my $length = shift;
727
    if (!$length) {
728
        $length = 8;
729
    }
730
    my $newPass = "";
731

    
732
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
733
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
734
    return $newPass;
735
}
736

    
737
#
738
# Change a password to a new value, binding as the provided user
739
#
740
sub changePassword {
741
    my $userDN = shift;
742
    my $userPass = shift;
743
    my $bindDN = shift;
744
    my $bindPass = shift;
745
    my $o = shift;
746

    
747
    my $searchBase = $ldapConfig->{$o}{'base'};
748

    
749
    my $errorMessage = 0;
750
    my $ldap;
751

    
752
    #if main ldap server is down, a html file containing warning message will be returned
753
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
754
    
755
    if ($ldap) {
756
        #$ldap->start_tls( verify => 'require',
757
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
758
        $ldap->start_tls( verify => 'none');
759
        debug("changePassword: attempting to bind to $bindDN");
760
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
761
                                  password => $bindPass );
762
        if ($bindresult->code) {
763
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
764
                            "correct? Please correct and try again...";
765
            return $errorMessage;
766
        }
767

    
768
    	# Find the user here and change their entry
769
    	my $newpass = createSeededPassHash($userPass);
770
    	my $modifications = { userPassword => $newpass };
771
      debug("changePass: setting password for $userDN to $newpass");
772
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
773
    
774
    	if ($result->code()) {
775
            debug("changePass: error changing password: " . $result->error);
776
        	$errorMessage = "There was an error changing the password:" .
777
                           "<br />\n" . $result->error;
778
    	} 
779
    	$ldap->unbind;   # take down session
780
    }
781

    
782
    return $errorMessage;
783
}
784

    
785
#
786
# generate a Seeded SHA1 hash of a plaintext password
787
#
788
sub createSeededPassHash {
789
    my $secret = shift;
790

    
791
    my $salt = "";
792
    for (my $i=0; $i < 4; $i++) {
793
        $salt .= int(rand(10));
794
    }
795

    
796
    my $ctx = Digest::SHA1->new;
797
    $ctx->add($secret);
798
    $ctx->add($salt);
799
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
800

    
801
    return $hashedPasswd;
802
}
803

    
804
#
805
# Look up an ldap entry for a user
806
#
807
sub getLdapEntry {
808
    my $ldapurl = shift;
809
    my $base = shift;
810
    my $username = shift;
811
    my $org = shift;
812

    
813
    my $entry = "";
814
    my $mesg;
815
    my $ldap;
816
    debug("ldap server: $ldapurl");
817

    
818
    #if main ldap server is down, a html file containing warning message will be returned
819
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
820
    
821
    if ($ldap) {
822
    	$ldap->start_tls( verify => 'none');
823
    	my $bindresult = $ldap->bind;
824
    	if ($bindresult->code) {
825
        	return $entry;
826
    	}
827

    
828
    	if($ldapConfig->{$org}{'filter'}){
829
            debug("getLdapEntry: filter set, searching for base=$base, " .
830
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
831
        	$mesg = $ldap->search ( base   => $base,
832
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
833
    	} else {
834
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
835
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
836
    	}
837
    
838
    	if ($mesg->count > 0) {
839
        	$entry = $mesg->pop_entry;
840
        	$ldap->unbind;   # take down session
841
    	} else {
842
        	$ldap->unbind;   # take down session
843
        	# Follow references by recursive call to self
844
        	my @references = $mesg->references();
845
        	for (my $i = 0; $i <= $#references; $i++) {
846
            	my $uri = URI->new($references[$i]);
847
            	my $host = $uri->host();
848
            	my $path = $uri->path();
849
            	$path =~ s/^\///;
850
            	$entry = &getLdapEntry($host, $path, $username, $org);
851
            	if ($entry) {
852
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
853
                	return $entry;
854
            	}
855
        	}
856
    	}
857
    }
858
    return $entry;
859
}
860

    
861
# 
862
# send an email message notifying the user of the pw change
863
#
864
sub sendPasswordNotification {
865
    my $username = shift;
866
    my $org = shift;
867
    my $newPass = shift;
868
    my $recipient = shift;
869
    my $cfg = shift;
870

    
871
    my $errorMessage = "";
872
    if ($recipient) {
873
    	
874
    	# use the appropriate link
875
		my $link = '/' . $context . '/cgi-bin/ldapweb.cgi?stage=changepass&cfg=' . $cfg;
876
		my $overrideURL;
877
	    $overrideURL = $skinProperties->getProperty("email.overrideURL");
878
	    debug("the overrideURL is " . $overrideURL);
879
	    if (defined($overrideURL) && !($overrideURL eq '')) {
880
	    	$link = $serverUrl . $overrideURL . $link;
881
	    } else {
882
	    	$link = $serverUrl . $link;
883
	    }
884
    
885
        my $mailhost = $properties->getProperty('email.mailhost');
886
        my $sender;
887
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
888
        # Send the email message to them
889
        my $smtp = Net::SMTP->new($mailhost);
890
        $smtp->mail($sender);
891
        $smtp->to($recipient);
892

    
893
        my $message = <<"        ENDOFMESSAGE";
894
        To: $recipient
895
        From: $sender
896
        Subject: Your Account Password Reset
897
        
898
        Somebody (hopefully you) requested that your account password be reset.  
899
        Your temporary password is below. Please update your password to 
900
        something permanent by visiting the following URL:
901

    
902
        $link
903

    
904
            Username: $username
905
        Organization: $org
906
        New Password: $newPass
907

    
908
        Thanks,
909
            $sender
910
    
911
        ENDOFMESSAGE
912
        $message =~ s/^[ \t\r\f]+//gm;
913
    
914
        $smtp->data($message);
915
        $smtp->quit;
916
    } else {
917
        $errorMessage = "Failed to send password because I " .
918
                        "couldn't find a valid email address.";
919
    }
920
    return $errorMessage;
921
}
922

    
923
#
924
# search the LDAP directory to see if a similar account already exists
925
#
926
sub findExistingAccounts {
927
    my $ldapurl = shift;
928
    my $base = shift;
929
    my $filter = shift;
930
    my $attref = shift;
931
    my $notHtmlFormat = shift;
932
    my $ldap;
933
    my $mesg;
934

    
935
    my $foundAccounts = 0;
936

    
937
    #if main ldap server is down, a html file containing warning message will be returned
938
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
939
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
940
    if ($ldap) {
941
    	$ldap->start_tls( verify => 'none');
942
    	$ldap->bind( version => 3, anonymous => 1);
943
		$mesg = $ldap->search (
944
			base   => $base,
945
			filter => $filter,
946
			attrs => @$attref,
947
		);
948

    
949
	    if ($mesg->count() > 0) {
950
			$foundAccounts = "";
951
			my $entry;
952
			foreach $entry ($mesg->all_entries) { 
953
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
954
                # this could be done directly with filters on the LDAP connection, instead.
955
                #if ($entry->dn !~ /ou=Account/) {
956
                    if($notHtmlFormat) {
957
                        $foundAccounts .= "\nAccount: ";
958
                    } else {
959
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
960
                    }
961
                    $foundAccounts .= $entry->dn();
962
                    if($notHtmlFormat) {
963
                        $foundAccounts .= "\n";
964
                    } else {
965
                        $foundAccounts .= "</b><br />\n";
966
                    }
967
                    foreach my $attribute ($entry->attributes()) {
968
                        my $value = $entry->get_value($attribute);
969
                        $foundAccounts .= "$attribute: ";
970
                        $foundAccounts .= $value;
971
                         if($notHtmlFormat) {
972
                            $foundAccounts .= "\n";
973
                        } else {
974
                            $foundAccounts .= "<br />\n";
975
                        }
976
                    }
977
                    if($notHtmlFormat) {
978
                        $foundAccounts .= "\n";
979
                    } else {
980
                        $foundAccounts .= "</p>\n";
981
                    }
982
                    
983
                #}
984
			}
985
        }
986
    	$ldap->unbind;   # take down session
987

    
988
    	# Follow references
989
    	my @references = $mesg->references();
990
    	for (my $i = 0; $i <= $#references; $i++) {
991
        	my $uri = URI->new($references[$i]);
992
        	my $host = $uri->host();
993
        	my $path = $uri->path();
994
        	$path =~ s/^\///;
995
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
996
        	if ($refFound) {
997
            	$foundAccounts .= $refFound;
998
        	}
999
    	}
1000
    }
1001

    
1002
    #print "<p>Checking referrals...</p>\n";
1003
    #my @referrals = $mesg->referrals();
1004
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
1005
    #for (my $i = 0; $i <= $#referrals; $i++) {
1006
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
1007
    #}
1008

    
1009
    return $foundAccounts;
1010
}
1011

    
1012
#
1013
# Validate that we have the proper set of input parameters
1014
#
1015
sub paramsAreValid {
1016
    my @pnames = @_;
1017

    
1018
    my $allValid = 1;
1019
    foreach my $parameter (@pnames) {
1020
        if (!defined($query->param($parameter)) || 
1021
            ! $query->param($parameter) ||
1022
            $query->param($parameter) =~ /^\s+$/) {
1023
            $allValid = 0;
1024
        }
1025
    }
1026

    
1027
    return $allValid;
1028
}
1029

    
1030
#
1031
# Create a temporary account for a user and send an email with a link which can click for the
1032
# verification. This is used to protect the ldap server against spams.
1033
#
1034
sub createTemporaryAccount {
1035
    my $allParams = shift;
1036
    my $org = $query->param('o'); 
1037
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1038
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1039
    my $tmp = 1;
1040

    
1041
    ################## Search LDAP to see if the dc=tmp which stores the inactive accounts exist or not. If it doesn't exist, it will be generated
1042
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
1043
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
1044
    my $tmpFilter = "dc=tmp";
1045
    my @attributes=['dc'];
1046
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
1047
    if (!$foundTmp) {
1048
        my $dn = $tmpSearchBase;
1049
        my $additions = [ 
1050
                    'dc' => 'tmp',
1051
                    'o'  => 'tmp',
1052
                    'objectclass' => ['top', 'dcObject', 'organization']
1053
                    ];
1054
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1055
    } else {
1056
     debug("found the tmp space");
1057
    }
1058
    
1059
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1060
    my $filter = $ldapConfig->{$org}{'filter'};   
1061
    
1062
    debug("search filer " . $filter);
1063
    debug("ldap server ". $ldapurl);
1064
    debug("sesarch base " . $tmpSearchBase);
1065
    print "Content-type: text/html\n\n";
1066
    my @attrs = ['o', 'ou' ];
1067
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1068

    
1069
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
1070
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
1071
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
1072
        
1073
    if(!$found) {
1074
        debug("generate the subtree in the dc=tmp===========================");
1075
        #need to generate the subtree o or ou
1076
        my $additions;
1077
            if($organization eq 'ou') {
1078
                $additions = [ 
1079
                    $organization   => $organizationName,
1080
                    'objectclass' => ['top', 'organizationalUnit']
1081
                    ];
1082
            
1083
            } else {
1084
                $additions = [ 
1085
                    $organization   => $organizationName,
1086
                    'objectclass' => ['top', 'organization']
1087
                    ];
1088
            
1089
            } 
1090
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1091
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1092
    } 
1093
    
1094
    ################create an account under tmp subtree 
1095
    
1096
    #generate a randomstr for matching the email.
1097
    my $randomStr = getRandomPassword(16);
1098
    # Create a hashed version of the password
1099
    my $shapass = createSeededPassHash($query->param('userPassword'));
1100
    my $additions = [ 
1101
                'uid'   => $query->param('uid'),
1102
                'cn'   => join(" ", $query->param('givenName'), 
1103
                                    $query->param('sn')),
1104
                'sn'   => $query->param('sn'),
1105
                'givenName'   => $query->param('givenName'),
1106
                'mail' => $query->param('mail'),
1107
                'userPassword' => $shapass,
1108
                'employeeNumber' => $randomStr,
1109
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1110
                                'inetOrgPerson', 'uidObject' ],
1111
                $organization   => $organizationName
1112
                ];
1113
    if (defined($query->param('telephoneNumber')) && 
1114
                $query->param('telephoneNumber') &&
1115
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1116
                $$additions[$#$additions + 1] = 'telephoneNumber';
1117
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1118
    }
1119
    if (defined($query->param('title')) && 
1120
                $query->param('title') &&
1121
                ! $query->param('title') =~ /^\s+$/) {
1122
                $$additions[$#$additions + 1] = 'title';
1123
                $$additions[$#$additions + 1] = $query->param('title');
1124
    }
1125

    
1126
    
1127
    #$$additions[$#$additions + 1] = 'o';
1128
    #$$additions[$#$additions + 1] = $org;
1129
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1130
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1131
    
1132
    
1133
    ####################send the verification email to the user
1134
    my $link = '/' . $context . '/cgi-bin/ldapweb.cgi?cfg=' . $skinName . '&' . 'stage=' . $emailVerification . '&' . 'dn=' . $dn . '&' . 'hash=' . $randomStr . '&o=' . $org . '&uid=' . $query->param('uid'); #even though we use o=something. The emailVerification will figure the real o= or ou=something.
1135
    
1136
    my $overrideURL;
1137
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1138
    debug("the overrideURL is " . $overrideURL);
1139
    if (defined($overrideURL) && !($overrideURL eq '')) {
1140
    	$link = $serverUrl . $overrideURL . $link;
1141
    } else {
1142
    	$link = $serverUrl . $link;
1143
    }
1144
    
1145
    my $mailhost = $properties->getProperty('email.mailhost');
1146
    my $sender;
1147
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1148
    debug("the sender is " . $sender);
1149
    my $recipient = $query->param('mail');
1150
    # Send the email message to them
1151
    my $smtp = Net::SMTP->new($mailhost) or do {  
1152
                                                  fullTemplate( ['registerFailed'], {errorMessage => "The temporary account " . $dn . " was created successfully. However, the vertification email can't be sent to you because the email server has some issues. Please contact " . 
1153
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1154
                                                  exit(0);
1155
                                               };
1156
    $smtp->mail($sender);
1157
    $smtp->to($recipient);
1158

    
1159
    my $message = <<"     ENDOFMESSAGE";
1160
    To: $recipient
1161
    From: $sender
1162
    Subject: New Account Activation
1163
        
1164
    Somebody (hopefully you) registered an account on $contextUrl.  
1165
    Please click the following link to activate your account.
1166
    If the link doesn't work, please copy the link to your browser:
1167
    
1168
    $link
1169

    
1170
    Thanks,
1171
        $sender
1172
    
1173
     ENDOFMESSAGE
1174
     $message =~ s/^[ \t\r\f]+//gm;
1175
    
1176
     $smtp->data($message);
1177
     $smtp->quit;
1178
    debug("the link is " . $link);
1179
    fullTemplate( ['success'] );
1180
    
1181
}
1182

    
1183
#
1184
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1185
# by the user
1186
#
1187
sub createItem {
1188
    my $dn = shift;
1189
    my $ldapUsername = shift;
1190
    my $ldapPassword = shift;
1191
    my $additions = shift;
1192
    my $temp = shift; #if it is for a temporary account.
1193
    my $allParams = shift;
1194
    
1195
    my @failureTemplate;
1196
    if($temp){
1197
        @failureTemplate = ['registerFailed', 'register'];
1198
    } else {
1199
        @failureTemplate = ['registerFailed'];
1200
    }
1201
    print "Content-type: text/html\n\n";
1202
    debug("the dn is " . $dn);
1203
    debug("LDAP connection to $ldapurl...");    
1204
    #if main ldap server is down, a html file containing warning message will be returned
1205
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1206
    if ($ldap) {
1207
            $ldap->start_tls( verify => 'none');
1208
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1209
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1210
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1211
            if ($result->code()) {
1212
                fullTemplate(@failureTemplate, { stage => "register",
1213
                                                            allParams => $allParams,
1214
                                                            errorMessage => $result->error });
1215
                exist(0);
1216
                # TODO SCW was included as separate errors, test this
1217
                #$templateVars    = setVars({ stage => "register",
1218
                #                     allParams => $allParams });
1219
                #$template->process( $templates->{'register'}, $templateVars);
1220
            } else {
1221
                #fullTemplate( ['success'] );
1222
            }
1223
            $ldap->unbind;   # take down session
1224
            
1225
    } else {   
1226
         fullTemplate(@failureTemplate, { stage => "register",
1227
                                                            allParams => $allParams,
1228
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1229
         exit(0);
1230
    }
1231
  
1232
}
1233

    
1234

    
1235

    
1236

    
1237

    
1238

    
1239
#
1240
# This subroutine will handle a email verification:
1241
# If the hash string matches the one store in the ldap, the account will be
1242
# copied from the temporary space to the permanent tree and the account in 
1243
# the temporary space will be removed.
1244
sub handleEmailVerification {
1245

    
1246
    my $cfg = $query->param('cfg');
1247
    my $dn = $query->param('dn');
1248
    my $hash = $query->param('hash');
1249
    my $org = $query->param('o');
1250
    my $uid = $query->param('uid');
1251
    
1252
    my $ldapUsername;
1253
    my $ldapPassword;
1254
    #my $orgAuthBase;
1255

    
1256
    $ldapUsername = $ldapConfig->{$org}{'user'};
1257
    $ldapPassword = $ldapConfig->{$org}{'password'};
1258
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1259
    
1260
    debug("LDAP connection to $ldapurl...");    
1261
    
1262

    
1263
   print "Content-type: text/html\n\n";
1264
   #if main ldap server is down, a html file containing warning message will be returned
1265
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1266
   if ($ldap) {
1267
        $ldap->start_tls( verify => 'none');
1268
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1269
        my $mesg = $ldap->search(base => $dn, scope => 'base', filter => '(objectClass=*)'); #This dn is with the dc=tmp. So it will find out the temporary account registered in registration step.
1270
        my $max = $mesg->count;
1271
        debug("the count is " . $max);
1272
        if($max < 1) {
1273
            $ldap->unbind;   # take down session
1274
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1275
            #handleLDAPBindFailure($ldapurl);
1276
            exit(0);
1277
        } else {
1278
            #check if the hash string match
1279
            my $entry = $mesg->entry (0);
1280
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1281
            if( $hashStrFromLdap eq $hash) {
1282
                #my $additions = [ ];
1283
                #foreach my $attr ( $entry->attributes ) {
1284
                    #if($attr ne 'employeeNumber') {
1285
                        #$$additions[$#$additions + 1] = $attr;
1286
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1287
                    #}
1288
                #}
1289

    
1290
                
1291
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1292
                $mesg = $ldap->moddn(
1293
                            dn => $dn,
1294
                            deleteoldrdn => 1,
1295
                            newrdn => "uid=" . $uid,
1296
                            newsuperior  =>  $orgDn);
1297
                $ldap->unbind;   # take down session
1298
                if($mesg->code()) {
1299
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1300
                    exit(0);
1301
                } else {
1302
                    fullTemplate( ['verificationSuccess'] );
1303
                }
1304
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1305
            } else {
1306
                $ldap->unbind;   # take down session
1307
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1308
                exit(0);
1309
            }
1310
            
1311
        }
1312
    } else {   
1313
        handleLDAPBindFailure($ldapurl);
1314
        exit(0);
1315
    }
1316

    
1317
}
1318

    
1319
sub handleResponseMessage {
1320

    
1321
  print "Content-type: text/html\n\n";
1322
  my $errorMessage = "You provided invalid input to the script. " .
1323
                     "Try again please.";
1324
  fullTemplate( [], { stage => $templates->{'stage'},
1325
                      errorMessage => $errorMessage });
1326
  exit();
1327
}
1328

    
1329
#
1330
# perform a simple search against the LDAP database using 
1331
# a small subset of attributes of each dn and return it
1332
# as a table to the calling browser.
1333
#
1334
sub handleSimpleSearch {
1335

    
1336
    my $o = $query->param('o');
1337

    
1338
    my $ldapurl = $ldapConfig->{$o}{'url'};
1339
    my $searchBase = $ldapConfig->{$o}{'base'};
1340

    
1341
    print "Content-type: text/html\n\n";
1342

    
1343
    my $allParams = { 
1344
                      'cn' => $query->param('cn'),
1345
                      'sn' => $query->param('sn'),
1346
                      'gn' => $query->param('gn'),
1347
                      'o'  => $query->param('o'),
1348
                      'facsimiletelephonenumber' 
1349
                      => $query->param('facsimiletelephonenumber'),
1350
                      'mail' => $query->param('cmail'),
1351
                      'telephonenumber' => $query->param('telephonenumber'),
1352
                      'title' => $query->param('title'),
1353
                      'uid' => $query->param('uid'),
1354
                      'ou' => $query->param('ou'),
1355
                    };
1356

    
1357
    # Search LDAP for matching entries that already exist
1358
    my $filter = "(" . 
1359
                 $query->param('searchField') . "=" .
1360
                 "*" .
1361
                 $query->param('searchValue') .
1362
                 "*" .
1363
                 ")";
1364

    
1365
    my @attrs = [ 'sn', 
1366
                  'gn', 
1367
                  'cn', 
1368
                  'o', 
1369
                  'facsimiletelephonenumber', 
1370
                  'mail', 
1371
                  'telephoneNumber', 
1372
                  'title', 
1373
                  'uid', 
1374
                  'labeledURI', 
1375
                  'ou' ];
1376

    
1377
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1378

    
1379
    # Send back the search results
1380
    if ($found) {
1381
      fullTemplate( ('searchResults'), { stage => "searchresults",
1382
                                         allParams => $allParams,
1383
                                         foundAccounts => $found });
1384
    } else {
1385
      $found = "No entries matched your criteria.  Please try again\n";
1386

    
1387
      fullTemplate( ('searchResults'), { stage => "searchresults",
1388
                                         allParams => $allParams,
1389
                                         foundAccounts => $found });
1390
    }
1391

    
1392
    exit();
1393
}
1394

    
1395
#
1396
# search the LDAP directory to see if a similar account already exists
1397
#
1398
sub searchDirectory {
1399
    my $ldapurl = shift;
1400
    my $base = shift;
1401
    my $filter = shift;
1402
    my $attref = shift;
1403

    
1404
	my $mesg;
1405
    my $foundAccounts = 0;
1406
    
1407
    #if ldap server is down, a html file containing warning message will be returned
1408
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1409
    
1410
    if ($ldap) {
1411
    	$ldap->start_tls( verify => 'none');
1412
    	$ldap->bind( version => 3, anonymous => 1);
1413
    	my $mesg = $ldap->search (
1414
        	base   => $base,
1415
        	filter => $filter,
1416
        	attrs => @$attref,
1417
    	);
1418

    
1419
    	if ($mesg->count() > 0) {
1420
        	$foundAccounts = "";
1421
        	my $entry;
1422
        	foreach $entry ($mesg->sorted(['sn'])) {
1423
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1424
          		$foundAccounts .= "<a href=\"" unless 
1425
                    (!$entry->get_value('labeledURI'));
1426
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1427
                    (!$entry->get_value('labeledURI'));
1428
          		$foundAccounts .= "\">\n" unless 
1429
                    (!$entry->get_value('labeledURI'));
1430
          		$foundAccounts .= $entry->get_value('givenName');
1431
          		$foundAccounts .= "</a>\n" unless 
1432
                    (!$entry->get_value('labeledURI'));
1433
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1434
          		$foundAccounts .= "<a href=\"" unless 
1435
                    (!$entry->get_value('labeledURI'));
1436
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1437
                    (!$entry->get_value('labeledURI'));
1438
          		$foundAccounts .= "\">\n" unless 
1439
                    (!$entry->get_value('labeledURI'));
1440
          		$foundAccounts .= $entry->get_value('sn');
1441
          		$foundAccounts .= "</a>\n";
1442
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1443
          		$foundAccounts .= $entry->get_value('mail');
1444
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1445
          		$foundAccounts .= $entry->get_value('telephonenumber');
1446
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1447
          		$foundAccounts .= $entry->get_value('title');
1448
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1449
          		$foundAccounts .= $entry->get_value('ou');
1450
          		$foundAccounts .= "\n</td>\n";
1451
          		$foundAccounts .= "</tr>\n";
1452
        	}
1453
    	}
1454
    	$ldap->unbind;   # take down session
1455
    }
1456
    return $foundAccounts;
1457
}
1458

    
1459
sub debug {
1460
    my $msg = shift;
1461
    
1462
    if ($debug) {
1463
        print STDERR "LDAPweb: $msg\n";
1464
    }
1465
}
1466

    
1467
sub handleLDAPBindFailure {
1468
    my $ldapAttemptUrl = shift;
1469
    my $primaryLdap =  $properties->getProperty('auth.url');
1470

    
1471
    if ($ldapAttemptUrl eq  $primaryLdap) {
1472
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1473
    } else {
1474
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1475
    }
1476
}
1477

    
1478
sub handleGeneralServerFailure {
1479
    my $errorMessage = shift;
1480
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1481
    exit(0);   
1482
   }
1483
    
1484
sub setVars {
1485
    my $paramVars = shift;
1486
    # initialize default parameters 
1487
    my $templateVars = { cfg => $cfg,
1488
                         styleSkinsPath => $contextUrl . "/style/skins",
1489
                         styleCommonPath => $contextUrl . "/style/common",
1490
                         contextUrl => $contextUrl,
1491
                         cgiPrefix => $cgiPrefix,
1492
                         orgList => \@validDisplayOrgList,
1493
                         config  => $config,
1494
    };
1495
    
1496
    # append customized params
1497
    while (my ($k, $v) = each (%$paramVars)) {
1498
        $templateVars->{$k} = $v;
1499
    }
1500
    
1501
    return $templateVars;
1502
} 
1503