Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8259

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 14:42:58 -0700 (Fri, 20 Sep 2013) $'
8
# '$Revision: 8259 $' 
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
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
534
                                                     allParams => $allParams,
535
                                                     foundAccounts => $found });
536
    # Otherwise, create a new user in the LDAP directory
537
    } else {
538
        createTemporaryAccount($allParams);
539
    }
540

    
541
    exit();
542
}
543

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

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

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

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

    
583

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
786
    return $errorMessage;
787
}
788

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

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

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

    
805
    return $hashedPasswd;
806
}
807

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

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

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

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

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

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

    
886
        my $message = <<"        ENDOFMESSAGE";
887
        To: $recipient
888
        From: $sender
889
        Subject: Your Account Password Reset
890
        
891
        Somebody (hopefully you) requested that your account password be reset.  
892
        Your temporary password is below. Please change it as soon as possible 
893
        at: $contextUrl.
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, $notHtmlFormat);
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 = '/' . $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.
1126
    
1127
    my $overrideURL;
1128
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1129
    debug("the overrideURL is " . $overrideURL);
1130
    if (defined($overrideURL) && !($overrideURL eq '')) {
1131
    	$link = $serverUrl . $overrideURL . $link;
1132
    } else {
1133
    	$link = $serverUrl . $link;
1134
    }
1135
    
1136
    my $mailhost = $properties->getProperty('email.mailhost');
1137
    my $sender;
1138
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1139
    debug("the sender is " . $sender);
1140
    my $recipient = $query->param('mail');
1141
    # Send the email message to them
1142
    my $smtp = Net::SMTP->new($mailhost) or do {  
1143
                                                  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 " . 
1144
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1145
                                                  exit(0);
1146
                                               };
1147
    $smtp->mail($sender);
1148
    $smtp->to($recipient);
1149

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

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

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

    
1225

    
1226

    
1227

    
1228

    
1229

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

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

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

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

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

    
1308
}
1309

    
1310
sub handleResponseMessage {
1311

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

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

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

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

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

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

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

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

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

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

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

    
1383
    exit();
1384
}
1385

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

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

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

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

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

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

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