Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8262

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-20 16:36:54 -0700 (Fri, 20 Sep 2013) $'
8
# '$Revision: 8262 $' 
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
      print "Content-type: text/html\n\n";
445
      fullTemplate( ['registerLter'] );
446
      exit(0);
447
    } 
448
    
449
    my $allParams = { 'givenName' => $query->param('givenName'), 
450
                      'sn' => $query->param('sn'),
451
                      'o' => $query->param('o'), 
452
                      'mail' => $query->param('mail'), 
453
                      'uid' => $query->param('uid'), 
454
                      'userPassword' => $query->param('userPassword'), 
455
                      'userPassword2' => $query->param('userPassword2'), 
456
                      'title' => $query->param('title'), 
457
                      'telephoneNumber' => $query->param('telephoneNumber') };
458
    
459
    # Check the recaptcha
460
    my $c = Captcha::reCAPTCHA->new;
461
    my $challenge = $query->param('recaptcha_challenge_field');
462
    my $response = $query->param('recaptcha_response_field');
463
    # Verify submission
464
    my $result = $c->check_answer(
465
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
466
        $challenge, $response
467
    );
468

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

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

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

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

    
531
    # If entries match, send back a request to confirm new-user creation
532
    if ($found) {
533
      print "Content-type: text/html\n\n";
534
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
535
                                                     allParams => $allParams,
536
                                                     foundAccounts => $found });
537
    # Otherwise, create a new user in the LDAP directory
538
    } else {
539
        createTemporaryAccount($allParams);
540
    }
541

    
542
    exit();
543
}
544

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

    
566
#
567
# change a user's password upon request
568
#
569
sub handleChangePassword {
570

    
571
    print "Content-type: text/html\n\n";
572

    
573
    my $allParams = { 'test' => "1", };
574
    if ($query->param('uid')) {
575
        $$allParams{'uid'} = $query->param('uid');
576
    }
577
    if ($query->param('o')) {
578
        $$allParams{'o'} = $query->param('o');
579
        my $o = $query->param('o');
580
        
581
        $searchBase = $ldapConfig->{$o}{'base'};
582
    }
583

    
584

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

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

    
600
        my $o = $query->param('o');
601
        $searchBase = $ldapConfig->{$o}{'base'};
602
        $ldapUsername = $ldapConfig->{$o}{'user'};
603
        $ldapPassword = $ldapConfig->{$o}{'password'};
604

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

    
632
#
633
# change a user's password upon request - no input params
634
# only display chagepass template without any error
635
#
636
sub handleInitialChangePassword {
637
    print "Content-type: text/html\n\n";
638

    
639
    my $allParams = { 'test' => "1", };
640
    my $errorMessage = "";
641
    fullTemplate( ['changePass'], { stage => "changepass",
642
                                    errorMessage => $errorMessage });
643
    exit();
644
}
645

    
646
#
647
# reset a user's password upon request
648
#
649
sub handleResetPassword {
650

    
651
    print "Content-type: text/html\n\n";
652

    
653
    my $allParams = { 'test' => "1", };
654
    if ($query->param('uid')) {
655
        $$allParams{'uid'} = $query->param('uid');
656
    }
657
    if ($query->param('o')) {
658
        $$allParams{'o'} = $query->param('o');
659
        my $o = $query->param('o');
660
        
661
        $searchBase = $ldapConfig->{$o}{'base'};
662
        $ldapUsername = $ldapConfig->{$o}{'user'};
663
        $ldapPassword = $ldapConfig->{$o}{'password'};
664
    }
665

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

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

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

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

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

    
727
#
728
# Construct a random string to use for a newly reset password
729
#
730
sub getRandomPassword {
731
    my $length = shift;
732
    if (!$length) {
733
        $length = 8;
734
    }
735
    my $newPass = "";
736

    
737
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
738
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
739
    return $newPass;
740
}
741

    
742
#
743
# Change a password to a new value, binding as the provided user
744
#
745
sub changePassword {
746
    my $userDN = shift;
747
    my $userPass = shift;
748
    my $bindDN = shift;
749
    my $bindPass = shift;
750
    my $o = shift;
751

    
752
    my $searchBase = $ldapConfig->{$o}{'base'};
753

    
754
    my $errorMessage = 0;
755
    my $ldap;
756

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

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

    
787
    return $errorMessage;
788
}
789

    
790
#
791
# generate a Seeded SHA1 hash of a plaintext password
792
#
793
sub createSeededPassHash {
794
    my $secret = shift;
795

    
796
    my $salt = "";
797
    for (my $i=0; $i < 4; $i++) {
798
        $salt .= int(rand(10));
799
    }
800

    
801
    my $ctx = Digest::SHA1->new;
802
    $ctx->add($secret);
803
    $ctx->add($salt);
804
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
805

    
806
    return $hashedPasswd;
807
}
808

    
809
#
810
# Look up an ldap entry for a user
811
#
812
sub getLdapEntry {
813
    my $ldapurl = shift;
814
    my $base = shift;
815
    my $username = shift;
816
    my $org = shift;
817

    
818
    my $entry = "";
819
    my $mesg;
820
    my $ldap;
821
    debug("ldap server: $ldapurl");
822

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

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

    
866
# 
867
# send an email message notifying the user of the pw change
868
#
869
sub sendPasswordNotification {
870
    my $username = shift;
871
    my $org = shift;
872
    my $newPass = shift;
873
    my $recipient = shift;
874
    my $cfg = shift;
875

    
876
    my $errorMessage = "";
877
    if ($recipient) {
878
    
879
        my $mailhost = $properties->getProperty('email.mailhost');
880
        my $sender;
881
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
882
        # Send the email message to them
883
        my $smtp = Net::SMTP->new($mailhost);
884
        $smtp->mail($sender);
885
        $smtp->to($recipient);
886

    
887
        my $message = <<"        ENDOFMESSAGE";
888
        To: $recipient
889
        From: $sender
890
        Subject: Your Account Password Reset
891
        
892
        Somebody (hopefully you) requested that your account password be reset.  
893
        Your temporary password is below. Please change it as soon as possible 
894
        at: $contextUrl.
895

    
896
            Username: $username
897
        Organization: $org
898
        New Password: $newPass
899

    
900
        Thanks,
901
            $sender
902
    
903
        ENDOFMESSAGE
904
        $message =~ s/^[ \t\r\f]+//gm;
905
    
906
        $smtp->data($message);
907
        $smtp->quit;
908
    } else {
909
        $errorMessage = "Failed to send password because I " .
910
                        "couldn't find a valid email address.";
911
    }
912
    return $errorMessage;
913
}
914

    
915
#
916
# search the LDAP directory to see if a similar account already exists
917
#
918
sub findExistingAccounts {
919
    my $ldapurl = shift;
920
    my $base = shift;
921
    my $filter = shift;
922
    my $attref = shift;
923
    my $notHtmlFormat = shift;
924
    my $ldap;
925
    my $mesg;
926

    
927
    my $foundAccounts = 0;
928

    
929
    #if main ldap server is down, a html file containing warning message will be returned
930
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
931
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
932
    if ($ldap) {
933
    	$ldap->start_tls( verify => 'none');
934
    	$ldap->bind( version => 3, anonymous => 1);
935
		$mesg = $ldap->search (
936
			base   => $base,
937
			filter => $filter,
938
			attrs => @$attref,
939
		);
940

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

    
980
    	# Follow references
981
    	my @references = $mesg->references();
982
    	for (my $i = 0; $i <= $#references; $i++) {
983
        	my $uri = URI->new($references[$i]);
984
        	my $host = $uri->host();
985
        	my $path = $uri->path();
986
        	$path =~ s/^\///;
987
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
988
        	if ($refFound) {
989
            	$foundAccounts .= $refFound;
990
        	}
991
    	}
992
    }
993

    
994
    #print "<p>Checking referrals...</p>\n";
995
    #my @referrals = $mesg->referrals();
996
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
997
    #for (my $i = 0; $i <= $#referrals; $i++) {
998
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
999
    #}
1000

    
1001
    return $foundAccounts;
1002
}
1003

    
1004
#
1005
# Validate that we have the proper set of input parameters
1006
#
1007
sub paramsAreValid {
1008
    my @pnames = @_;
1009

    
1010
    my $allValid = 1;
1011
    foreach my $parameter (@pnames) {
1012
        if (!defined($query->param($parameter)) || 
1013
            ! $query->param($parameter) ||
1014
            $query->param($parameter) =~ /^\s+$/) {
1015
            $allValid = 0;
1016
        }
1017
    }
1018

    
1019
    return $allValid;
1020
}
1021

    
1022
#
1023
# Create a temporary account for a user and send an email with a link which can click for the
1024
# verification. This is used to protect the ldap server against spams.
1025
#
1026
sub createTemporaryAccount {
1027
    my $allParams = shift;
1028
    my $org = $query->param('o'); 
1029
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1030
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1031
    my $tmp = 1;
1032

    
1033
    ################## 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
1034
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
1035
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
1036
    my $tmpFilter = "dc=tmp";
1037
    my @attributes=['dc'];
1038
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
1039
    if (!$foundTmp) {
1040
        my $dn = $tmpSearchBase;
1041
        my $additions = [ 
1042
                    'dc' => 'tmp',
1043
                    'o'  => 'tmp',
1044
                    'objectclass' => ['top', 'dcObject', 'organization']
1045
                    ];
1046
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1047
    } else {
1048
     debug("found the tmp space");
1049
    }
1050
    
1051
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1052
    my $filter = $ldapConfig->{$org}{'filter'};   
1053
    
1054
    debug("search filer " . $filter);
1055
    debug("ldap server ". $ldapurl);
1056
    debug("sesarch base " . $tmpSearchBase);
1057
    #print "Content-type: text/html\n\n";
1058
    my @attrs = ['o', 'ou' ];
1059
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1060

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

    
1118
    
1119
    #$$additions[$#$additions + 1] = 'o';
1120
    #$$additions[$#$additions + 1] = $org;
1121
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1122
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1123
    
1124
    
1125
    ####################send the verification email to the user
1126
    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.
1127
    
1128
    my $overrideURL;
1129
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1130
    debug("the overrideURL is " . $overrideURL);
1131
    if (defined($overrideURL) && !($overrideURL eq '')) {
1132
    	$link = $serverUrl . $overrideURL . $link;
1133
    } else {
1134
    	$link = $serverUrl . $link;
1135
    }
1136
    
1137
    my $mailhost = $properties->getProperty('email.mailhost');
1138
    my $sender;
1139
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1140
    debug("the sender is " . $sender);
1141
    my $recipient = $query->param('mail');
1142
    # Send the email message to them
1143
    my $smtp = Net::SMTP->new($mailhost) or do {  
1144
                                                  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 " . 
1145
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1146
                                                  exit(0);
1147
                                               };
1148
    $smtp->mail($sender);
1149
    $smtp->to($recipient);
1150

    
1151
    my $message = <<"     ENDOFMESSAGE";
1152
    To: $recipient
1153
    From: $sender
1154
    Subject: New Account Activation
1155
        
1156
    Somebody (hopefully you) registered an account on $contextUrl.  
1157
    Please click the following link to activate your account.
1158
    If the link doesn't work, please copy the link to your browser:
1159
    
1160
    $link
1161

    
1162
    Thanks,
1163
        $sender
1164
    
1165
     ENDOFMESSAGE
1166
     $message =~ s/^[ \t\r\f]+//gm;
1167
    
1168
     $smtp->data($message);
1169
     $smtp->quit;
1170
    debug("the link is " . $link);
1171
    fullTemplate( ['success'] );
1172
    
1173
}
1174

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

    
1226

    
1227

    
1228

    
1229

    
1230

    
1231
#
1232
# This subroutine will handle a email verification:
1233
# If the hash string matches the one store in the ldap, the account will be
1234
# copied from the temporary space to the permanent tree and the account in 
1235
# the temporary space will be removed.
1236
sub handleEmailVerification {
1237

    
1238
    my $cfg = $query->param('cfg');
1239
    my $dn = $query->param('dn');
1240
    my $hash = $query->param('hash');
1241
    my $org = $query->param('o');
1242
    my $uid = $query->param('uid');
1243
    
1244
    my $ldapUsername;
1245
    my $ldapPassword;
1246
    #my $orgAuthBase;
1247

    
1248
    $ldapUsername = $ldapConfig->{$org}{'user'};
1249
    $ldapPassword = $ldapConfig->{$org}{'password'};
1250
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1251
    
1252
    debug("LDAP connection to $ldapurl...");    
1253
    
1254

    
1255
   print "Content-type: text/html\n\n";
1256
   #if main ldap server is down, a html file containing warning message will be returned
1257
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1258
   if ($ldap) {
1259
        $ldap->start_tls( verify => 'none');
1260
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1261
        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.
1262
        my $max = $mesg->count;
1263
        debug("the count is " . $max);
1264
        if($max < 1) {
1265
            $ldap->unbind;   # take down session
1266
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1267
            #handleLDAPBindFailure($ldapurl);
1268
            exit(0);
1269
        } else {
1270
            #check if the hash string match
1271
            my $entry = $mesg->entry (0);
1272
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1273
            if( $hashStrFromLdap eq $hash) {
1274
                #my $additions = [ ];
1275
                #foreach my $attr ( $entry->attributes ) {
1276
                    #if($attr ne 'employeeNumber') {
1277
                        #$$additions[$#$additions + 1] = $attr;
1278
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1279
                    #}
1280
                #}
1281

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

    
1309
}
1310

    
1311
sub handleResponseMessage {
1312

    
1313
  print "Content-type: text/html\n\n";
1314
  my $errorMessage = "You provided invalid input to the script. " .
1315
                     "Try again please.";
1316
  fullTemplate( [], { stage => $templates->{'stage'},
1317
                      errorMessage => $errorMessage });
1318
  exit();
1319
}
1320

    
1321
#
1322
# perform a simple search against the LDAP database using 
1323
# a small subset of attributes of each dn and return it
1324
# as a table to the calling browser.
1325
#
1326
sub handleSimpleSearch {
1327

    
1328
    my $o = $query->param('o');
1329

    
1330
    my $ldapurl = $ldapConfig->{$o}{'url'};
1331
    my $searchBase = $ldapConfig->{$o}{'base'};
1332

    
1333
    print "Content-type: text/html\n\n";
1334

    
1335
    my $allParams = { 
1336
                      'cn' => $query->param('cn'),
1337
                      'sn' => $query->param('sn'),
1338
                      'gn' => $query->param('gn'),
1339
                      'o'  => $query->param('o'),
1340
                      'facsimiletelephonenumber' 
1341
                      => $query->param('facsimiletelephonenumber'),
1342
                      'mail' => $query->param('cmail'),
1343
                      'telephonenumber' => $query->param('telephonenumber'),
1344
                      'title' => $query->param('title'),
1345
                      'uid' => $query->param('uid'),
1346
                      'ou' => $query->param('ou'),
1347
                    };
1348

    
1349
    # Search LDAP for matching entries that already exist
1350
    my $filter = "(" . 
1351
                 $query->param('searchField') . "=" .
1352
                 "*" .
1353
                 $query->param('searchValue') .
1354
                 "*" .
1355
                 ")";
1356

    
1357
    my @attrs = [ 'sn', 
1358
                  'gn', 
1359
                  'cn', 
1360
                  'o', 
1361
                  'facsimiletelephonenumber', 
1362
                  'mail', 
1363
                  'telephoneNumber', 
1364
                  'title', 
1365
                  'uid', 
1366
                  'labeledURI', 
1367
                  'ou' ];
1368

    
1369
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1370

    
1371
    # Send back the search results
1372
    if ($found) {
1373
      fullTemplate( ('searchResults'), { stage => "searchresults",
1374
                                         allParams => $allParams,
1375
                                         foundAccounts => $found });
1376
    } else {
1377
      $found = "No entries matched your criteria.  Please try again\n";
1378

    
1379
      fullTemplate( ('searchResults'), { stage => "searchresults",
1380
                                         allParams => $allParams,
1381
                                         foundAccounts => $found });
1382
    }
1383

    
1384
    exit();
1385
}
1386

    
1387
#
1388
# search the LDAP directory to see if a similar account already exists
1389
#
1390
sub searchDirectory {
1391
    my $ldapurl = shift;
1392
    my $base = shift;
1393
    my $filter = shift;
1394
    my $attref = shift;
1395

    
1396
	my $mesg;
1397
    my $foundAccounts = 0;
1398
    
1399
    #if ldap server is down, a html file containing warning message will be returned
1400
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1401
    
1402
    if ($ldap) {
1403
    	$ldap->start_tls( verify => 'none');
1404
    	$ldap->bind( version => 3, anonymous => 1);
1405
    	my $mesg = $ldap->search (
1406
        	base   => $base,
1407
        	filter => $filter,
1408
        	attrs => @$attref,
1409
    	);
1410

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

    
1451
sub debug {
1452
    my $msg = shift;
1453
    
1454
    if ($debug) {
1455
        print STDERR "LDAPweb: $msg\n";
1456
    }
1457
}
1458

    
1459
sub handleLDAPBindFailure {
1460
    my $ldapAttemptUrl = shift;
1461
    my $primaryLdap =  $properties->getProperty('auth.url');
1462

    
1463
    if ($ldapAttemptUrl eq  $primaryLdap) {
1464
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1465
    } else {
1466
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1467
    }
1468
}
1469

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