Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8250

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 07:48:53 -0700 (Fri, 20 Sep 2013) $'
8
# '$Revision: 8250 $' 
9
# 
10
# This program is free software; you can redistribute it and/or modify
11
# it under the terms of the GNU General Public License as published by
12
# the Free Software Foundation; either version 2 of the License, or
13
# (at your option) any later version.
14
#
15
# This program is distributed in the hope that it will be useful,
16
# but WITHOUT ANY WARRANTY; without even the implied warranty of
17
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
# GNU General Public License for more details.
19
#
20
# You should have received a copy of the GNU General Public License
21
# along with this program; if not, write to the Free Software
22
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
23
#
24

    
25
#
26
# This is a web-based application for allowing users to register a new
27
# account for Metacat access.  We currently only support LDAP even
28
# though metacat could potentially support other types of directories.
29

    
30
use lib '../WEB-INF/lib';
31
use strict;             # turn on strict syntax checking
32
use Template;           # load the template-toolkit module
33
use CGI qw/:standard :html3/; # load the CGI module 
34
use Net::LDAP;          # load the LDAP net libraries
35
use Net::SMTP;          # load the SMTP net libraries
36
use Digest::SHA1;       # for creating the password hash
37
use MIME::Base64;       # for creating the password hash
38
use URI;                # for parsing URL syntax
39
use Config::Properties; # for parsing Java .properties files
40
use File::Basename;     # for path name parsing
41
use Captcha::reCAPTCHA; # for protection against spams
42
use Cwd 'abs_path';
43

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

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

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

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

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

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

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

    
88
my $emailVerification= 'emailverification';
89

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

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

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

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

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

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

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

    
147
# XXX END HACK
148

    
149

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

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

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

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

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

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

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

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

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

    
189
#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.
190
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
191
# pull out properties available e.g. 'name', 'base'
192
my @orgData = keys(%$orgProps);
193

    
194
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. 
195
while (my ($oKey, $oVal) = each(%$orgNames)) {
196
    push(@orgList, $oKey);
197
}
198

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

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

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

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

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

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

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

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

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

    
281

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

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

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

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

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

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

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

    
340

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

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

    
358
    print "Content-type: text/html\n\n";
359
   
360
    my $allParams = {'mail' => $query->param('mail')};
361
    my @requiredParams = ('mail');
362
    if (! paramsAreValid(@requiredParams)) {
363
        my $errorMessage = "Required information is missing. " .
364
            "Please fill in all required fields and resubmit the form.";
365
        fullTemplate(['lookupName'], { allParams => $allParams,
366
                                     errorMessage => $errorMessage });
367
        exit();
368
    }
369
    my $mail = $query->param('mail');
370
    
371
    #search accounts with the specified emails 
372
    $searchBase = $authBase; 
373
    my $filter = "(mail=" . $mail . ")";
374
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
375
    my $notHtmlFormat = 1;
376
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs, $notHtmlFormat);
377
    my $accountInfo;
378
    if($found) {
379
        $accountInfo = $found;
380
    } else {
381
        my $link = $contextUrl. '/cgi-bin/ldapweb.cgi?cfg=' . $skinName;
382
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n" .
383
                       "You may create a new one by the following link: \n" . $link
384
    }
385
    
386
    
387
    
388
    my $mailhost = $properties->getProperty('email.mailhost');
389
    my $sender;
390
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
391
    debug("the sender is " . $sender);
392
    my $recipient = $query->param('mail');
393
    # Send the email message to them
394
    my $smtp = Net::SMTP->new($mailhost) or do {  
395
                                                  fullTemplate( ['lookupName'], {allParams => $allParams, 
396
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " . 
397
                                                                $skinProperties->getProperty("email.recipient") . "." });  
398
                                                  exit(0);
399
                                               };
400
    $smtp->mail($sender);
401
    $smtp->to($recipient);
402

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

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

    
425

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

    
437

    
438

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

    
471
    if ( $result->{is_valid} ) {
472
        #print "Yes!";
473
        #exit();
474
    }
475
    else {
476
        my $errorMessage = "The verification code is wrong. Please input again.";
477
        fullTemplate(['register'], { stage => "register",
478
                                     allParams => $allParams,
479
                                     errorMessage => $errorMessage });
480
        exit();
481
    }
482
    
483
    
484
    # Check that all required fields are provided and not null
485
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
486
                           'uid', 'userPassword', 'userPassword2');
487
    if (! paramsAreValid(@requiredParams)) {
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
            my $errorMessage = "The passwords do not match. Try again.";
497
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
498
                                                            allParams => $allParams,
499
                                                            errorMessage => $errorMessage });
500
            exit();
501
        }
502
        my $o = $query->param('o');    
503
        $searchBase = $ldapConfig->{$o}{'base'};  
504
    }
505

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

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

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

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

    
540
    exit();
541
}
542

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

    
564
#
565
# change a user's password upon request
566
#
567
sub handleChangePassword {
568

    
569
    print "Content-type: text/html\n\n";
570

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

    
582

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

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

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

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

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

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

    
644
#
645
# reset a user's password upon request
646
#
647
sub handleResetPassword {
648

    
649
    print "Content-type: text/html\n\n";
650

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

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

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

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

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

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

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

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

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

    
750
    my $searchBase = $ldapConfig->{$o}{'base'};
751

    
752
    my $errorMessage = 0;
753
    my $ldap;
754

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

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

    
785
    return $errorMessage;
786
}
787

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

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

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

    
804
    return $hashedPasswd;
805
}
806

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

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

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

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

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

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

    
884
        my $message = <<"        ENDOFMESSAGE";
885
        To: $recipient
886
        From: $sender
887
        Subject: Your Account Password Reset
888
        
889
        Somebody (hopefully you) requested that your account password be reset.  
890
        This is generally done when somebody forgets their password.  Your 
891
        password can be changed by visiting the following URL:
892

    
893
        $contextUrl/cgi-bin/ldapweb.cgi?stage=changepass&cfg=$cfg
894

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

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

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

    
926
    my $foundAccounts = 0;
927

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

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

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

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

    
1000
    return $foundAccounts;
1001
}
1002

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

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

    
1018
    return $allValid;
1019
}
1020

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

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

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

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

    
1141
    my $message = <<"     ENDOFMESSAGE";
1142
    To: $recipient
1143
    From: $sender
1144
    Subject: New Account Activation
1145
        
1146
    Somebody (hopefully you) registered an account on $metacatUrl.  
1147
    Please click the following link to activate your account.
1148
    If the link doesn't work, please copy the link to your browser:
1149
    
1150
    $link
1151

    
1152
    Thanks,
1153
        $sender
1154
    
1155
     ENDOFMESSAGE
1156
     $message =~ s/^[ \t\r\f]+//gm;
1157
    
1158
     $smtp->data($message);
1159
     $smtp->quit;
1160
    debug("the link is " . $link);
1161
    fullTemplate( ['success'] );
1162
    
1163
}
1164

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

    
1216

    
1217

    
1218

    
1219

    
1220

    
1221
#
1222
# This subroutine will handle a email verification:
1223
# If the hash string matches the one store in the ldap, the account will be
1224
# copied from the temporary space to the permanent tree and the account in 
1225
# the temporary space will be removed.
1226
sub handleEmailVerification {
1227

    
1228
    my $cfg = $query->param('cfg');
1229
    my $dn = $query->param('dn');
1230
    my $hash = $query->param('hash');
1231
    my $org = $query->param('o');
1232
    my $uid = $query->param('uid');
1233
    
1234
    my $ldapUsername;
1235
    my $ldapPassword;
1236
    #my $orgAuthBase;
1237

    
1238
    $ldapUsername = $ldapConfig->{$org}{'user'};
1239
    $ldapPassword = $ldapConfig->{$org}{'password'};
1240
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1241
    
1242
    debug("LDAP connection to $ldapurl...");    
1243
    
1244

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

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

    
1299
}
1300

    
1301
sub handleResponseMessage {
1302

    
1303
  print "Content-type: text/html\n\n";
1304
  my $errorMessage = "You provided invalid input to the script. " .
1305
                     "Try again please.";
1306
  fullTemplate( [], { stage => $templates->{'stage'},
1307
                      errorMessage => $errorMessage });
1308
  exit();
1309
}
1310

    
1311
#
1312
# perform a simple search against the LDAP database using 
1313
# a small subset of attributes of each dn and return it
1314
# as a table to the calling browser.
1315
#
1316
sub handleSimpleSearch {
1317

    
1318
    my $o = $query->param('o');
1319

    
1320
    my $ldapurl = $ldapConfig->{$o}{'url'};
1321
    my $searchBase = $ldapConfig->{$o}{'base'};
1322

    
1323
    print "Content-type: text/html\n\n";
1324

    
1325
    my $allParams = { 
1326
                      'cn' => $query->param('cn'),
1327
                      'sn' => $query->param('sn'),
1328
                      'gn' => $query->param('gn'),
1329
                      'o'  => $query->param('o'),
1330
                      'facsimiletelephonenumber' 
1331
                      => $query->param('facsimiletelephonenumber'),
1332
                      'mail' => $query->param('cmail'),
1333
                      'telephonenumber' => $query->param('telephonenumber'),
1334
                      'title' => $query->param('title'),
1335
                      'uid' => $query->param('uid'),
1336
                      'ou' => $query->param('ou'),
1337
                    };
1338

    
1339
    # Search LDAP for matching entries that already exist
1340
    my $filter = "(" . 
1341
                 $query->param('searchField') . "=" .
1342
                 "*" .
1343
                 $query->param('searchValue') .
1344
                 "*" .
1345
                 ")";
1346

    
1347
    my @attrs = [ 'sn', 
1348
                  'gn', 
1349
                  'cn', 
1350
                  'o', 
1351
                  'facsimiletelephonenumber', 
1352
                  'mail', 
1353
                  'telephoneNumber', 
1354
                  'title', 
1355
                  'uid', 
1356
                  'labeledURI', 
1357
                  'ou' ];
1358

    
1359
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1360

    
1361
    # Send back the search results
1362
    if ($found) {
1363
      fullTemplate( ('searchResults'), { stage => "searchresults",
1364
                                         allParams => $allParams,
1365
                                         foundAccounts => $found });
1366
    } else {
1367
      $found = "No entries matched your criteria.  Please try again\n";
1368

    
1369
      fullTemplate( ('searchResults'), { stage => "searchresults",
1370
                                         allParams => $allParams,
1371
                                         foundAccounts => $found });
1372
    }
1373

    
1374
    exit();
1375
}
1376

    
1377
#
1378
# search the LDAP directory to see if a similar account already exists
1379
#
1380
sub searchDirectory {
1381
    my $ldapurl = shift;
1382
    my $base = shift;
1383
    my $filter = shift;
1384
    my $attref = shift;
1385

    
1386
	my $mesg;
1387
    my $foundAccounts = 0;
1388
    
1389
    #if ldap server is down, a html file containing warning message will be returned
1390
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1391
    
1392
    if ($ldap) {
1393
    	$ldap->start_tls( verify => 'none');
1394
    	$ldap->bind( version => 3, anonymous => 1);
1395
    	my $mesg = $ldap->search (
1396
        	base   => $base,
1397
        	filter => $filter,
1398
        	attrs => @$attref,
1399
    	);
1400

    
1401
    	if ($mesg->count() > 0) {
1402
        	$foundAccounts = "";
1403
        	my $entry;
1404
        	foreach $entry ($mesg->sorted(['sn'])) {
1405
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1406
          		$foundAccounts .= "<a href=\"" unless 
1407
                    (!$entry->get_value('labeledURI'));
1408
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1409
                    (!$entry->get_value('labeledURI'));
1410
          		$foundAccounts .= "\">\n" unless 
1411
                    (!$entry->get_value('labeledURI'));
1412
          		$foundAccounts .= $entry->get_value('givenName');
1413
          		$foundAccounts .= "</a>\n" unless 
1414
                    (!$entry->get_value('labeledURI'));
1415
          		$foundAccounts .= "\n</td>\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('sn');
1423
          		$foundAccounts .= "</a>\n";
1424
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1425
          		$foundAccounts .= $entry->get_value('mail');
1426
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1427
          		$foundAccounts .= $entry->get_value('telephonenumber');
1428
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1429
          		$foundAccounts .= $entry->get_value('title');
1430
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1431
          		$foundAccounts .= $entry->get_value('ou');
1432
          		$foundAccounts .= "\n</td>\n";
1433
          		$foundAccounts .= "</tr>\n";
1434
        	}
1435
    	}
1436
    	$ldap->unbind;   # take down session
1437
    }
1438
    return $foundAccounts;
1439
}
1440

    
1441
sub debug {
1442
    my $msg = shift;
1443
    
1444
    if ($debug) {
1445
        print STDERR "LDAPweb: $msg\n";
1446
    }
1447
}
1448

    
1449
sub handleLDAPBindFailure {
1450
    my $ldapAttemptUrl = shift;
1451
    my $primaryLdap =  $properties->getProperty('auth.url');
1452

    
1453
    if ($ldapAttemptUrl eq  $primaryLdap) {
1454
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1455
    } else {
1456
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1457
    }
1458
}
1459

    
1460
sub handleGeneralServerFailure {
1461
    my $errorMessage = shift;
1462
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1463
    exit(0);   
1464
   }
1465
    
1466
sub setVars {
1467
    my $paramVars = shift;
1468
    # initialize default parameters 
1469
    my $templateVars = { cfg => $cfg,
1470
                         styleSkinsPath => $contextUrl . "/style/skins",
1471
                         styleCommonPath => $contextUrl . "/style/common",
1472
                         contextUrl => $contextUrl,
1473
                         cgiPrefix => $cgiPrefix,
1474
                         orgList => \@validDisplayOrgList,
1475
                         config  => $config,
1476
    };
1477
    
1478
    # append customized params
1479
    while (my ($k, $v) = each (%$paramVars)) {
1480
        $templateVars->{$k} = $v;
1481
    }
1482
    
1483
    return $templateVars;
1484
} 
1485