Project

General

Profile

metacat / src / perl / ldapweb.cgi @ 8258

1
#!/usr/bin/perl -w
2
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California 
5
#
6
#   '$Author: tao $'
7
#     '$Date: 2013-09-20 13:17:01 -0700 (Fri, 20 Sep 2013) $'
8
# '$Revision: 8258 $' 
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
    	# use the appropriate link
879
		my $link = '/' . $context . '/cgi-bin/ldapweb.cgi?stage=changepass&cfg=' . $cfg;
880
		my $overrideURL;
881
	    $overrideURL = $skinProperties->getProperty("email.overrideURL");
882
	    debug("the overrideURL is " . $overrideURL);
883
	    if (defined($overrideURL) && !($overrideURL eq '')) {
884
	    	$link = $serverUrl . $overrideURL . $link;
885
	    } else {
886
	    	$link = $serverUrl . $link;
887
	    }
888
    
889
        my $mailhost = $properties->getProperty('email.mailhost');
890
        my $sender;
891
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
892
        # Send the email message to them
893
        my $smtp = Net::SMTP->new($mailhost);
894
        $smtp->mail($sender);
895
        $smtp->to($recipient);
896

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

    
906
        $link
907

    
908
            Username: $username
909
        Organization: $org
910
        New Password: $newPass
911

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

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

    
939
    my $foundAccounts = 0;
940

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

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

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

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

    
1013
    return $foundAccounts;
1014
}
1015

    
1016
#
1017
# Validate that we have the proper set of input parameters
1018
#
1019
sub paramsAreValid {
1020
    my @pnames = @_;
1021

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

    
1031
    return $allValid;
1032
}
1033

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

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

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

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

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

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

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

    
1238

    
1239

    
1240

    
1241

    
1242

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

    
1250
    my $cfg = $query->param('cfg');
1251
    my $dn = $query->param('dn');
1252
    my $hash = $query->param('hash');
1253
    my $org = $query->param('o');
1254
    my $uid = $query->param('uid');
1255
    
1256
    my $ldapUsername;
1257
    my $ldapPassword;
1258
    #my $orgAuthBase;
1259

    
1260
    $ldapUsername = $ldapConfig->{$org}{'user'};
1261
    $ldapPassword = $ldapConfig->{$org}{'password'};
1262
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1263
    
1264
    debug("LDAP connection to $ldapurl...");    
1265
    
1266

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

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

    
1321
}
1322

    
1323
sub handleResponseMessage {
1324

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

    
1333
#
1334
# perform a simple search against the LDAP database using 
1335
# a small subset of attributes of each dn and return it
1336
# as a table to the calling browser.
1337
#
1338
sub handleSimpleSearch {
1339

    
1340
    my $o = $query->param('o');
1341

    
1342
    my $ldapurl = $ldapConfig->{$o}{'url'};
1343
    my $searchBase = $ldapConfig->{$o}{'base'};
1344

    
1345
    print "Content-type: text/html\n\n";
1346

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

    
1361
    # Search LDAP for matching entries that already exist
1362
    my $filter = "(" . 
1363
                 $query->param('searchField') . "=" .
1364
                 "*" .
1365
                 $query->param('searchValue') .
1366
                 "*" .
1367
                 ")";
1368

    
1369
    my @attrs = [ 'sn', 
1370
                  'gn', 
1371
                  'cn', 
1372
                  'o', 
1373
                  'facsimiletelephonenumber', 
1374
                  'mail', 
1375
                  'telephoneNumber', 
1376
                  'title', 
1377
                  'uid', 
1378
                  'labeledURI', 
1379
                  'ou' ];
1380

    
1381
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1382

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

    
1391
      fullTemplate( ('searchResults'), { stage => "searchresults",
1392
                                         allParams => $allParams,
1393
                                         foundAccounts => $found });
1394
    }
1395

    
1396
    exit();
1397
}
1398

    
1399
#
1400
# search the LDAP directory to see if a similar account already exists
1401
#
1402
sub searchDirectory {
1403
    my $ldapurl = shift;
1404
    my $base = shift;
1405
    my $filter = shift;
1406
    my $attref = shift;
1407

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

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

    
1463
sub debug {
1464
    my $msg = shift;
1465
    
1466
    if ($debug) {
1467
        print STDERR "LDAPweb: $msg\n";
1468
    }
1469
}
1470

    
1471
sub handleLDAPBindFailure {
1472
    my $ldapAttemptUrl = shift;
1473
    my $primaryLdap =  $properties->getProperty('auth.url');
1474

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

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