Project

General

Profile

1
#!/usr/bin/perl -w
2
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California 
5
#
6
#   '$Author: leinfelder $'
7
#     '$Date: 2013-10-31 09:31:20 -0700 (Thu, 31 Oct 2013) $'
8
# '$Revision: 8357 $' 
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 DateTime;			# for parsing dates
42
use DateTime::Duration; # for substracting
43
use Captcha::reCAPTCHA; # for protection against spams
44
use Cwd 'abs_path';
45

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

    
59
$properties->load(*METACAT_PROPERTIES);
60

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

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

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

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

    
88
my @errorMessages;
89
my $error = 0;
90

    
91
my $emailVerification= 'emailverification';
92

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

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

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

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

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

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

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

    
150
# XXX END HACK
151

    
152

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
284

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

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

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

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

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

    
321
#--------------------------------------------------------------------------80c->
322
# Define the subroutines to do the work
323
#--------------------------------------------------------------------------80c->
324

    
325
sub clearTemporaryAccounts {
326
	
327
    #search accounts that have expired
328
	my $org = $query->param('o'); 
329
    my $ldapUsername = $ldapConfig->{$org}{'user'};
330
    my $ldapPassword = $ldapConfig->{$org}{'password'};
331
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
332
    my $orgExpiration = $ldapConfig->{$org}{'expiration'};
333
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
334
	
335
	my $dt = DateTime->now;
336
	$dt->subtract( hours => $orgExpiration );
337
	my $expirationDate = $dt->ymd("") . $dt->hms("") . "Z";
338
    my $filter = "(&(objectClass=inetOrgPerson)(createTimestamp<=" . $expirationDate . "))";
339
    debug("Clearing expired accounts with filter: " . $filter . ", base: " . $tmpSearchBase);    
340
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
341

    
342
    my $ldap;
343
    my $mesg;
344
    
345
    my $dn;
346

    
347
    #if main ldap server is down, a html file containing warning message will be returned
348
    debug("clearTemporaryAccounts: connecting to $ldapurl, $timeout");
349
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
350
    if ($ldap) {
351
    	$ldap->start_tls( verify => 'none');
352
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
353
		$mesg = $ldap->search (
354
			base   => $tmpSearchBase,
355
			filter => $filter,
356
			attrs => \@attrs,
357
		);
358
	    if ($mesg->count() > 0) {
359
			my $entry;
360
			foreach $entry ($mesg->all_entries) { 
361
            	$dn = $entry->dn();
362
            	# remove the entry
363
   				debug("Removing expired account: " . $dn);
364
            	$ldap->delete($dn);
365
			}
366
        }
367
    	$ldap->unbind;   # take down session
368
    }
369

    
370
    return 0;
371
}
372

    
373
sub fullTemplate {
374
    my $templateList = shift;
375
    my $templateVars = setVars(shift);
376
    my $c = Captcha::reCAPTCHA->new;
377
    my $captcha = 'captcha';
378
    #my $error=null;
379
    my $use_ssl= 1;
380
    #my $options=null;
381
    # use the AJAX style, only need to provide the public key to the template
382
    $templateVars->{'recaptchaPublicKey'} = $recaptchaPublicKey;
383
    #$templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
384
    $template->process( $templates->{'header'}, $templateVars );
385
    foreach my $tmpl (@{$templateList}) {
386
        $template->process( $templates->{$tmpl}, $templateVars );
387
    }
388
    $template->process( $templates->{'footer'}, $templateVars );
389
}
390

    
391

    
392
#
393
# Initialize a form for a user to request the account name associated with an email address
394
#
395
sub handleLookupName {
396
    
397
    print "Content-type: text/html\n\n";
398
    # process the template files:
399
    fullTemplate(['lookupName']); 
400
    exit();
401
}
402

    
403
#
404
# Handle the user's request to look up account names with a specified email address.
405
# This relates to "Forget your user name"
406
#
407
sub handleSearchNameByEmail{
408

    
409
    print "Content-type: text/html\n\n";
410
   
411
    my $allParams = {'mail' => $query->param('mail')};
412
    my @requiredParams = ('mail');
413
    if (! paramsAreValid(@requiredParams)) {
414
        my $errorMessage = "Required information is missing. " .
415
            "Please fill in all required fields and resubmit the form.";
416
        fullTemplate(['lookupName'], { allParams => $allParams,
417
                                     errorMessage => $errorMessage });
418
        exit();
419
    }
420
    my $mail = $query->param('mail');
421
    
422
    #search accounts with the specified emails 
423
    $searchBase = $authBase; 
424
    my $filter = "(mail=" . $mail . ")";
425
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
426
    my $notHtmlFormat = 1;
427
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs, $notHtmlFormat);
428
    my $accountInfo;
429
    if ($found) {
430
        $accountInfo = $found;
431
    } else {
432
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n";
433
    }
434

    
435
    my $mailhost = $properties->getProperty('email.mailhost');
436
    my $sender;
437
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
438
    debug("the sender is " . $sender);
439
    my $recipient = $query->param('mail');
440
    # Send the email message to them
441
    my $smtp = Net::SMTP->new($mailhost) or do {  
442
                                                  fullTemplate( ['lookupName'], {allParams => $allParams, 
443
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " . 
444
                                                                $skinProperties->getProperty("email.recipient") . "." });  
445
                                                  exit(0);
446
                                               };
447
    $smtp->mail($sender);
448
    $smtp->to($recipient);
449

    
450
    my $message = <<"     ENDOFMESSAGE";
451
    To: $recipient
452
    From: $sender
453
    Subject: Your Account Information
454
        
455
    Somebody (hopefully you) looked up the account information associated with the email address.  
456
    Here is the account information:
457
    
458
    $accountInfo
459

    
460
    Thanks,
461
        $sender
462
    
463
     ENDOFMESSAGE
464
     $message =~ s/^[ \t\r\f]+//gm;
465
    
466
     $smtp->data($message);
467
     $smtp->quit;
468
     fullTemplate( ['lookupNameSuccess'] );
469
    
470
}
471

    
472

    
473
#
474
# create the initial registration form 
475
#
476
sub handleInitRegister {
477
  my $vars = shift;
478
  print "Content-type: text/html\n\n";
479
  # process the template files:
480
  fullTemplate(['register'], {stage => "register"}); 
481
  exit();
482
}
483

    
484

    
485

    
486
#
487
# process input from the register stage, which occurs when
488
# a user submits form data to create a new account
489
#
490
sub handleRegister {
491
    
492
    #print "Content-type: text/html\n\n";
493
    if ($query->param('o') =~ "LTER") {
494
      print "Content-type: text/html\n\n";
495
      fullTemplate( ['registerLter'] );
496
      exit(0);
497
    } 
498
    
499
    my $allParams = { 'givenName' => $query->param('givenName'), 
500
                      'sn' => $query->param('sn'),
501
                      'o' => $query->param('o'), 
502
                      'mail' => $query->param('mail'), 
503
                      'uid' => $query->param('uid'), 
504
                      'userPassword' => $query->param('userPassword'), 
505
                      'userPassword2' => $query->param('userPassword2'), 
506
                      'title' => $query->param('title'), 
507
                      'telephoneNumber' => $query->param('telephoneNumber') };
508
    
509
    # Check the recaptcha
510
    my $c = Captcha::reCAPTCHA->new;
511
    my $challenge = $query->param('recaptcha_challenge_field');
512
    my $response = $query->param('recaptcha_response_field');
513
    # Verify submission
514
    my $result = $c->check_answer(
515
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
516
        $challenge, $response
517
    );
518

    
519
    if ( $result->{is_valid} ) {
520
        #print "Yes!";
521
        #exit();
522
    }
523
    else {
524
        print "Content-type: text/html\n\n";
525
        my $errorMessage = "The verification code is wrong. Please input again.";
526
        fullTemplate(['register'], { stage => "register",
527
                                     allParams => $allParams,
528
                                     errorMessage => $errorMessage });
529
        exit();
530
    }
531
    
532
    
533
    # Check that all required fields are provided and not null
534
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
535
                           'uid', 'userPassword', 'userPassword2');
536
    if (! paramsAreValid(@requiredParams)) {
537
        print "Content-type: text/html\n\n";
538
        my $errorMessage = "Required information is missing. " .
539
            "Please fill in all required fields and resubmit the form.";
540
        fullTemplate(['register'], { stage => "register",
541
                                     allParams => $allParams,
542
                                     errorMessage => $errorMessage });
543
        exit();
544
    } else {
545
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
546
            print "Content-type: text/html\n\n";
547
            my $errorMessage = "The passwords do not match. Try again.";
548
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
549
                                                            allParams => $allParams,
550
                                                            errorMessage => $errorMessage });
551
            exit();
552
        }
553
        my $o = $query->param('o');    
554
        $searchBase = $ldapConfig->{$o}{'base'};  
555
    }
556
    
557
    # Remove any expired temporary accounts for this subtree before continuing
558
    clearTemporaryAccounts();
559

    
560
    # Search LDAP for matching entries that already exist
561
    # Some forms use a single text search box, whereas others search per
562
    # attribute.
563
    my $filter;
564
    if ($query->param('searchField')) {
565

    
566
      $filter = "(|" . 
567
                "(uid=" . $query->param('searchField') . ") " .
568
                "(mail=" . $query->param('searchField') . ")" .
569
                "(&(sn=" . $query->param('searchField') . ") " . 
570
                "(givenName=" . $query->param('searchField') . "))" . 
571
                ")";
572
    } else {
573
      $filter = "(|" . 
574
                "(uid=" . $query->param('uid') . ") " .
575
                "(mail=" . $query->param('mail') . ")" .
576
                "(&(sn=" . $query->param('sn') . ") " . 
577
                "(givenName=" . $query->param('givenName') . "))" . 
578
                ")";
579
    }
580

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

    
584
    # If entries match, send back a request to confirm new-user creation
585
    if ($found) {
586
      print "Content-type: text/html\n\n";
587
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
588
                                                     allParams => $allParams,
589
                                                     foundAccounts => $found });
590
    # Otherwise, create a new user in the LDAP directory
591
    } else {
592
        createTemporaryAccount($allParams);
593
    }
594

    
595
    exit();
596
}
597

    
598
#
599
# process input from the registerconfirmed stage, which occurs when
600
# a user chooses to create an account despite similarities to other
601
# existing accounts
602
#
603
sub handleRegisterConfirmed {
604
  
605
    my $allParams = { 'givenName' => $query->param('givenName'), 
606
                      'sn' => $query->param('sn'),
607
                      'o' => $query->param('o'), 
608
                      'mail' => $query->param('mail'), 
609
                      'uid' => $query->param('uid'), 
610
                      'userPassword' => $query->param('userPassword'), 
611
                      'userPassword2' => $query->param('userPassword2'), 
612
                      'title' => $query->param('title'), 
613
                      'telephoneNumber' => $query->param('telephoneNumber') };
614
    #print "Content-type: text/html\n\n";
615
    createTemporaryAccount($allParams);
616
    exit();
617
}
618

    
619
#
620
# change a user's password upon request
621
#
622
sub handleChangePassword {
623

    
624
    print "Content-type: text/html\n\n";
625

    
626
    my $allParams = { 'test' => "1", };
627
    if ($query->param('uid')) {
628
        $$allParams{'uid'} = $query->param('uid');
629
    }
630
    if ($query->param('o')) {
631
        $$allParams{'o'} = $query->param('o');
632
        my $o = $query->param('o');
633
        
634
        $searchBase = $ldapConfig->{$o}{'base'};
635
    }
636

    
637

    
638
    # Check that all required fields are provided and not null
639
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
640
                           'userPassword', 'userPassword2');
641
    if (! paramsAreValid(@requiredParams)) {
642
        my $errorMessage = "Required information is missing. " .
643
            "Please fill in all required fields and submit the form.";
644
        fullTemplate( ['changePass'], { stage => "changepass",
645
                                        allParams => $allParams,
646
                                        errorMessage => $errorMessage });
647
        exit();
648
    }
649

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

    
653
        my $o = $query->param('o');
654
        $searchBase = $ldapConfig->{$o}{'base'};
655
        $ldapUsername = $ldapConfig->{$o}{'user'};
656
        $ldapPassword = $ldapConfig->{$o}{'password'};
657

    
658
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
659
        if ($query->param('o') =~ "LTER") {
660
            fullTemplate( ['registerLter'] );
661
        } else {
662
            my $errorMessage = changePassword(
663
                    $dn, $query->param('userPassword'), 
664
                    $dn, $query->param('oldpass'), $query->param('o'));
665
            if ($errorMessage) {
666
                fullTemplate( ['changePass'], { stage => "changepass",
667
                                                allParams => $allParams,
668
                                                errorMessage => $errorMessage });
669
                exit();
670
            } else {
671
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
672
                                                       allParams => $allParams });
673
                exit();
674
            }
675
        }
676
    } else {
677
        my $errorMessage = "The passwords do not match. Try again.";
678
        fullTemplate( ['changePass'], { stage => "changepass",
679
                                        allParams => $allParams,
680
                                        errorMessage => $errorMessage });
681
        exit();
682
    }
683
}
684

    
685
#
686
# change a user's password upon request - no input params
687
# only display chagepass template without any error
688
#
689
sub handleInitialChangePassword {
690
    print "Content-type: text/html\n\n";
691

    
692
    my $allParams = { 'test' => "1", };
693
    my $errorMessage = "";
694
    fullTemplate( ['changePass'], { stage => "changepass",
695
                                    errorMessage => $errorMessage });
696
    exit();
697
}
698

    
699
#
700
# reset a user's password upon request
701
#
702
sub handleResetPassword {
703

    
704
    print "Content-type: text/html\n\n";
705

    
706
    my $allParams = { 'test' => "1", };
707
    if ($query->param('uid')) {
708
        $$allParams{'uid'} = $query->param('uid');
709
    }
710
    if ($query->param('o')) {
711
        $$allParams{'o'} = $query->param('o');
712
        my $o = $query->param('o');
713
        
714
        $searchBase = $ldapConfig->{$o}{'base'};
715
        $ldapUsername = $ldapConfig->{$o}{'user'};
716
        $ldapPassword = $ldapConfig->{$o}{'password'};
717
    }
718

    
719
    # Check that all required fields are provided and not null
720
    my @requiredParams = ( 'uid', 'o' );
721
    if (! paramsAreValid(@requiredParams)) {
722
        my $errorMessage = "Required information is missing. " .
723
            "Please fill in all required fields and submit the form.";
724
        fullTemplate( ['resetPass'],  { stage => "resetpass",
725
                                        allParams => $allParams,
726
                                        errorMessage => $errorMessage });
727
        exit();
728
    }
729

    
730
    # We have all of the info we need, so try to change the password
731
    my $o = $query->param('o');
732
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
733
    debug("handleResetPassword: dn: $dn");
734
    if ($query->param('o') =~ "LTER") {
735
        fullTemplate( ['registerLter'] );
736
        exit();
737
    } else {
738
        my $errorMessage = "";
739
        my $recipient;
740
        my $userPass;
741
        my $entry = getLdapEntry($ldapurl, $searchBase, 
742
                $query->param('uid'), $query->param('o'));
743

    
744
        if ($entry) {
745
            $recipient = $entry->get_value('mail');
746
            $userPass = getRandomPassword();
747
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
748
        } else {
749
            $errorMessage = "User not found in database.  Please try again.";
750
        }
751

    
752
        if ($errorMessage) {
753
            fullTemplate( ['resetPass'], { stage => "resetpass",
754
                                           allParams => $allParams,
755
                                           errorMessage => $errorMessage });
756
            exit();
757
        } else {
758
            my $errorMessage = sendPasswordNotification($query->param('uid'),
759
                    $query->param('o'), $userPass, $recipient, $cfg);
760
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
761
                                                  allParams => $allParams,
762
                                                  errorMessage => $errorMessage });
763
            exit();
764
        }
765
    }
766
}
767

    
768
#
769
# reset a user's password upon request- no initial params
770
# only display resetpass template without any error
771
#
772
sub handleInitialResetPassword {
773
    print "Content-type: text/html\n\n";
774
    my $errorMessage = "";
775
    fullTemplate( ['resetPass'], { stage => "resetpass",
776
                                   errorMessage => $errorMessage });
777
    exit();
778
}
779

    
780
#
781
# Construct a random string to use for a newly reset password
782
#
783
sub getRandomPassword {
784
    my $length = shift;
785
    if (!$length) {
786
        $length = 8;
787
    }
788
    my $newPass = "";
789

    
790
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
791
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
792
    return $newPass;
793
}
794

    
795
#
796
# Change a password to a new value, binding as the provided user
797
#
798
sub changePassword {
799
    my $userDN = shift;
800
    my $userPass = shift;
801
    my $bindDN = shift;
802
    my $bindPass = shift;
803
    my $o = shift;
804

    
805
    my $searchBase = $ldapConfig->{$o}{'base'};
806

    
807
    my $errorMessage = 0;
808
    my $ldap;
809

    
810
    #if main ldap server is down, a html file containing warning message will be returned
811
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
812
    
813
    if ($ldap) {
814
        #$ldap->start_tls( verify => 'require',
815
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
816
        $ldap->start_tls( verify => 'none');
817
        debug("changePassword: attempting to bind to $bindDN");
818
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
819
                                  password => $bindPass );
820
        if ($bindresult->code) {
821
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
822
                            "correct? Please correct and try again...";
823
            return $errorMessage;
824
        }
825

    
826
    	# Find the user here and change their entry
827
    	my $newpass = createSeededPassHash($userPass);
828
    	my $modifications = { userPassword => $newpass };
829
      debug("changePass: setting password for $userDN to $newpass");
830
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
831
    
832
    	if ($result->code()) {
833
            debug("changePass: error changing password: " . $result->error);
834
        	$errorMessage = "There was an error changing the password:" .
835
                           "<br />\n" . $result->error;
836
    	} 
837
    	$ldap->unbind;   # take down session
838
    }
839

    
840
    return $errorMessage;
841
}
842

    
843
#
844
# generate a Seeded SHA1 hash of a plaintext password
845
#
846
sub createSeededPassHash {
847
    my $secret = shift;
848

    
849
    my $salt = "";
850
    for (my $i=0; $i < 4; $i++) {
851
        $salt .= int(rand(10));
852
    }
853

    
854
    my $ctx = Digest::SHA1->new;
855
    $ctx->add($secret);
856
    $ctx->add($salt);
857
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
858

    
859
    return $hashedPasswd;
860
}
861

    
862
#
863
# Look up an ldap entry for a user
864
#
865
sub getLdapEntry {
866
    my $ldapurl = shift;
867
    my $base = shift;
868
    my $username = shift;
869
    my $org = shift;
870

    
871
    my $entry = "";
872
    my $mesg;
873
    my $ldap;
874
    debug("ldap server: $ldapurl");
875

    
876
    #if main ldap server is down, a html file containing warning message will be returned
877
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
878
    
879
    if ($ldap) {
880
    	$ldap->start_tls( verify => 'none');
881
    	my $bindresult = $ldap->bind;
882
    	if ($bindresult->code) {
883
        	return $entry;
884
    	}
885

    
886
    	if($ldapConfig->{$org}{'filter'}){
887
            debug("getLdapEntry: filter set, searching for base=$base, " .
888
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
889
        	$mesg = $ldap->search ( base   => $base,
890
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
891
    	} else {
892
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
893
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
894
    	}
895
    
896
    	if ($mesg->count > 0) {
897
        	$entry = $mesg->pop_entry;
898
        	$ldap->unbind;   # take down session
899
    	} else {
900
        	$ldap->unbind;   # take down session
901
        	# Follow references by recursive call to self
902
        	my @references = $mesg->references();
903
        	for (my $i = 0; $i <= $#references; $i++) {
904
            	my $uri = URI->new($references[$i]);
905
            	my $host = $uri->host();
906
            	my $path = $uri->path();
907
            	$path =~ s/^\///;
908
            	$entry = &getLdapEntry($host, $path, $username, $org);
909
            	if ($entry) {
910
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
911
                	return $entry;
912
            	}
913
        	}
914
    	}
915
    }
916
    return $entry;
917
}
918

    
919
# 
920
# send an email message notifying the user of the pw change
921
#
922
sub sendPasswordNotification {
923
    my $username = shift;
924
    my $org = shift;
925
    my $newPass = shift;
926
    my $recipient = shift;
927
    my $cfg = shift;
928

    
929
    my $errorMessage = "";
930
    if ($recipient) {
931
    
932
        my $mailhost = $properties->getProperty('email.mailhost');
933
        my $sender;
934
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
935
        # Send the email message to them
936
        my $smtp = Net::SMTP->new($mailhost);
937
        $smtp->mail($sender);
938
        $smtp->to($recipient);
939

    
940
        my $message = <<"        ENDOFMESSAGE";
941
        To: $recipient
942
        From: $sender
943
        Subject: Your Account Password Reset
944
        
945
        Somebody (hopefully you) requested that your account password be reset.  
946
        Your temporary password is below. Please change it as soon as possible 
947
        at: $contextUrl.
948

    
949
            Username: $username
950
        Organization: $org
951
        New Password: $newPass
952

    
953
        Thanks,
954
            $sender
955
    
956
        ENDOFMESSAGE
957
        $message =~ s/^[ \t\r\f]+//gm;
958
    
959
        $smtp->data($message);
960
        $smtp->quit;
961
    } else {
962
        $errorMessage = "Failed to send password because I " .
963
                        "couldn't find a valid email address.";
964
    }
965
    return $errorMessage;
966
}
967

    
968
#
969
# search the LDAP directory to see if a similar account already exists
970
#
971
sub findExistingAccounts {
972
    my $ldapurl = shift;
973
    my $base = shift;
974
    my $filter = shift;
975
    my $attref = shift;
976
    my $notHtmlFormat = shift;
977
    my $ldap;
978
    my $mesg;
979

    
980
    my $foundAccounts = 0;
981

    
982
    #if main ldap server is down, a html file containing warning message will be returned
983
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
984
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
985
    if ($ldap) {
986
    	$ldap->start_tls( verify => 'none');
987
    	$ldap->bind( version => 3, anonymous => 1);
988
		$mesg = $ldap->search (
989
			base   => $base,
990
			filter => $filter,
991
			attrs => @$attref,
992
		);
993

    
994
	    if ($mesg->count() > 0) {
995
			$foundAccounts = "";
996
			my $entry;
997
			foreach $entry ($mesg->all_entries) { 
998
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
999
                # this could be done directly with filters on the LDAP connection, instead.
1000
                #if ($entry->dn !~ /ou=Account/) {
1001
                    if($notHtmlFormat) {
1002
                        $foundAccounts .= "\nAccount: ";
1003
                    } else {
1004
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
1005
                    }
1006
                    $foundAccounts .= $entry->dn();
1007
                    if($notHtmlFormat) {
1008
                        $foundAccounts .= "\n";
1009
                    } else {
1010
                        $foundAccounts .= "</b><br />\n";
1011
                    }
1012
                    foreach my $attribute ($entry->attributes()) {
1013
                        my $value = $entry->get_value($attribute);
1014
                        $foundAccounts .= "$attribute: ";
1015
                        $foundAccounts .= $value;
1016
                         if($notHtmlFormat) {
1017
                            $foundAccounts .= "\n";
1018
                        } else {
1019
                            $foundAccounts .= "<br />\n";
1020
                        }
1021
                    }
1022
                    if($notHtmlFormat) {
1023
                        $foundAccounts .= "\n";
1024
                    } else {
1025
                        $foundAccounts .= "</p>\n";
1026
                    }
1027
                    
1028
                #}
1029
			}
1030
        }
1031
    	$ldap->unbind;   # take down session
1032

    
1033
    	# Follow references
1034
    	my @references = $mesg->references();
1035
    	for (my $i = 0; $i <= $#references; $i++) {
1036
        	my $uri = URI->new($references[$i]);
1037
        	my $host = $uri->host();
1038
        	my $path = $uri->path();
1039
        	$path =~ s/^\///;
1040
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
1041
        	if ($refFound) {
1042
            	$foundAccounts .= $refFound;
1043
        	}
1044
    	}
1045
    }
1046

    
1047
    #print "<p>Checking referrals...</p>\n";
1048
    #my @referrals = $mesg->referrals();
1049
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
1050
    #for (my $i = 0; $i <= $#referrals; $i++) {
1051
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
1052
    #}
1053

    
1054
    return $foundAccounts;
1055
}
1056

    
1057
#
1058
# Validate that we have the proper set of input parameters
1059
#
1060
sub paramsAreValid {
1061
    my @pnames = @_;
1062

    
1063
    my $allValid = 1;
1064
    foreach my $parameter (@pnames) {
1065
        if (!defined($query->param($parameter)) || 
1066
            ! $query->param($parameter) ||
1067
            $query->param($parameter) =~ /^\s+$/) {
1068
            $allValid = 0;
1069
        }
1070
    }
1071

    
1072
    return $allValid;
1073
}
1074

    
1075
#
1076
# Create a temporary account for a user and send an email with a link which can click for the
1077
# verification. This is used to protect the ldap server against spams.
1078
#
1079
sub createTemporaryAccount {
1080
    my $allParams = shift;
1081
    my $org = $query->param('o'); 
1082
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1083
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1084
    my $tmp = 1;
1085

    
1086
    ################## 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
1087
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
1088
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase; 
1089
    my $tmpFilter = "dc=tmp";
1090
    my @attributes=['dc'];
1091
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
1092
    if (!$foundTmp) {
1093
        my $dn = $tmpSearchBase;
1094
        my $additions = [ 
1095
                    'dc' => 'tmp',
1096
                    'o'  => 'tmp',
1097
                    'objectclass' => ['top', 'dcObject', 'organization']
1098
                    ];
1099
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1100
    } else {
1101
     debug("found the tmp space");
1102
    }
1103
    
1104
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1105
    my $filter = $ldapConfig->{$org}{'filter'};   
1106
    
1107
    debug("search filer " . $filter);
1108
    debug("ldap server ". $ldapurl);
1109
    debug("sesarch base " . $tmpSearchBase);
1110
    #print "Content-type: text/html\n\n";
1111
    my @attrs = ['o', 'ou' ];
1112
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1113

    
1114
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
1115
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
1116
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
1117
        
1118
    if(!$found) {
1119
        debug("generate the subtree in the dc=tmp===========================");
1120
        #need to generate the subtree o or ou
1121
        my $additions;
1122
            if($organization eq 'ou') {
1123
                $additions = [ 
1124
                    $organization   => $organizationName,
1125
                    'objectclass' => ['top', 'organizationalUnit']
1126
                    ];
1127
            
1128
            } else {
1129
                $additions = [ 
1130
                    $organization   => $organizationName,
1131
                    'objectclass' => ['top', 'organization']
1132
                    ];
1133
            
1134
            } 
1135
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1136
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1137
    } 
1138
    
1139
    ################create an account under tmp subtree 
1140
    
1141
    #generate a randomstr for matching the email.
1142
    my $randomStr = getRandomPassword(16);
1143
    # Create a hashed version of the password
1144
    my $shapass = createSeededPassHash($query->param('userPassword'));
1145
    my $additions = [ 
1146
                'uid'   => $query->param('uid'),
1147
                'cn'   => join(" ", $query->param('givenName'), 
1148
                                    $query->param('sn')),
1149
                'sn'   => $query->param('sn'),
1150
                'givenName'   => $query->param('givenName'),
1151
                'mail' => $query->param('mail'),
1152
                'userPassword' => $shapass,
1153
                'employeeNumber' => $randomStr,
1154
                'objectclass' => ['top', 'person', 'organizationalPerson', 
1155
                                'inetOrgPerson', 'uidObject' ],
1156
                $organization   => $organizationName
1157
                ];
1158
    if (defined($query->param('telephoneNumber')) && 
1159
                $query->param('telephoneNumber') &&
1160
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1161
                $$additions[$#$additions + 1] = 'telephoneNumber';
1162
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1163
    }
1164
    if (defined($query->param('title')) && 
1165
                $query->param('title') &&
1166
                ! $query->param('title') =~ /^\s+$/) {
1167
                $$additions[$#$additions + 1] = 'title';
1168
                $$additions[$#$additions + 1] = $query->param('title');
1169
    }
1170

    
1171
    
1172
    #$$additions[$#$additions + 1] = 'o';
1173
    #$$additions[$#$additions + 1] = $org;
1174
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1175
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1176
    
1177
    
1178
    ####################send the verification email to the user
1179
    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.
1180
    
1181
    my $overrideURL;
1182
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1183
    debug("the overrideURL is " . $overrideURL);
1184
    if (defined($overrideURL) && !($overrideURL eq '')) {
1185
    	$link = $serverUrl . $overrideURL . $link;
1186
    } else {
1187
    	$link = $serverUrl . $link;
1188
    }
1189
    
1190
    my $mailhost = $properties->getProperty('email.mailhost');
1191
    my $sender;
1192
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1193
    debug("the sender is " . $sender);
1194
    my $recipient = $query->param('mail');
1195
    # Send the email message to them
1196
    my $smtp = Net::SMTP->new($mailhost) or do {  
1197
                                                  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 " . 
1198
                                                  $skinProperties->getProperty("email.recipient") . "." });  
1199
                                                  exit(0);
1200
                                               };
1201
    $smtp->mail($sender);
1202
    $smtp->to($recipient);
1203

    
1204
    my $message = <<"     ENDOFMESSAGE";
1205
    To: $recipient
1206
    From: $sender
1207
    Subject: New Account Activation
1208
        
1209
    Somebody (hopefully you) registered an account on $contextUrl.  
1210
    Please click the following link to activate your account.
1211
    If the link doesn't work, please copy the link to your browser:
1212
    
1213
    $link
1214

    
1215
    Thanks,
1216
        $sender
1217
    
1218
     ENDOFMESSAGE
1219
     $message =~ s/^[ \t\r\f]+//gm;
1220
    
1221
     $smtp->data($message);
1222
     $smtp->quit;
1223
    debug("the link is " . $link);
1224
    fullTemplate( ['success'] );
1225
    
1226
}
1227

    
1228
#
1229
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1230
# by the user
1231
#
1232
sub createItem {
1233
    my $dn = shift;
1234
    my $ldapUsername = shift;
1235
    my $ldapPassword = shift;
1236
    my $additions = shift;
1237
    my $temp = shift; #if it is for a temporary account.
1238
    my $allParams = shift;
1239
    
1240
    my @failureTemplate;
1241
    if($temp){
1242
        @failureTemplate = ['registerFailed', 'register'];
1243
    } else {
1244
        @failureTemplate = ['registerFailed'];
1245
    }
1246
    print "Content-type: text/html\n\n";
1247
    debug("the dn is " . $dn);
1248
    debug("LDAP connection to $ldapurl...");    
1249
    #if main ldap server is down, a html file containing warning message will be returned
1250
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1251
    if ($ldap) {
1252
            $ldap->start_tls( verify => 'none');
1253
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1254
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword ); 
1255
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1256
            if ($result->code()) {
1257
                fullTemplate(@failureTemplate, { stage => "register",
1258
                                                            allParams => $allParams,
1259
                                                            errorMessage => $result->error });
1260
                exist(0);
1261
                # TODO SCW was included as separate errors, test this
1262
                #$templateVars    = setVars({ stage => "register",
1263
                #                     allParams => $allParams });
1264
                #$template->process( $templates->{'register'}, $templateVars);
1265
            } else {
1266
                #fullTemplate( ['success'] );
1267
            }
1268
            $ldap->unbind;   # take down session
1269
            
1270
    } else {   
1271
         fullTemplate(@failureTemplate, { stage => "register",
1272
                                                            allParams => $allParams,
1273
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1274
         exit(0);
1275
    }
1276
  
1277
}
1278

    
1279

    
1280

    
1281

    
1282

    
1283

    
1284
#
1285
# This subroutine will handle a email verification:
1286
# If the hash string matches the one store in the ldap, the account will be
1287
# copied from the temporary space to the permanent tree and the account in 
1288
# the temporary space will be removed.
1289
sub handleEmailVerification {
1290

    
1291
    my $cfg = $query->param('cfg');
1292
    my $dn = $query->param('dn');
1293
    my $hash = $query->param('hash');
1294
    my $org = $query->param('o');
1295
    my $uid = $query->param('uid');
1296
    
1297
    my $ldapUsername;
1298
    my $ldapPassword;
1299
    #my $orgAuthBase;
1300

    
1301
    $ldapUsername = $ldapConfig->{$org}{'user'};
1302
    $ldapPassword = $ldapConfig->{$org}{'password'};
1303
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1304
    
1305
    debug("LDAP connection to $ldapurl...");    
1306
    
1307

    
1308
   print "Content-type: text/html\n\n";
1309
   #if main ldap server is down, a html file containing warning message will be returned
1310
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1311
   if ($ldap) {
1312
        $ldap->start_tls( verify => 'none');
1313
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1314
        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.
1315
        my $max = $mesg->count;
1316
        debug("the count is " . $max);
1317
        if($max < 1) {
1318
            $ldap->unbind;   # take down session
1319
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1320
            #handleLDAPBindFailure($ldapurl);
1321
            exit(0);
1322
        } else {
1323
            #check if the hash string match
1324
            my $entry = $mesg->entry (0);
1325
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1326
            if( $hashStrFromLdap eq $hash) {
1327
                #my $additions = [ ];
1328
                #foreach my $attr ( $entry->attributes ) {
1329
                    #if($attr ne 'employeeNumber') {
1330
                        #$$additions[$#$additions + 1] = $attr;
1331
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1332
                    #}
1333
                #}
1334

    
1335
                
1336
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1337
                $mesg = $ldap->moddn(
1338
                            dn => $dn,
1339
                            deleteoldrdn => 1,
1340
                            newrdn => "uid=" . $uid,
1341
                            newsuperior  =>  $orgDn);
1342
                $ldap->unbind;   # take down session
1343
                if($mesg->code()) {
1344
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1345
                    exit(0);
1346
                } else {
1347
                    fullTemplate( ['verificationSuccess'] );
1348
                }
1349
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1350
            } else {
1351
                $ldap->unbind;   # take down session
1352
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1353
                exit(0);
1354
            }
1355
            
1356
        }
1357
    } else {   
1358
        handleLDAPBindFailure($ldapurl);
1359
        exit(0);
1360
    }
1361

    
1362
}
1363

    
1364
sub handleResponseMessage {
1365

    
1366
  print "Content-type: text/html\n\n";
1367
  my $errorMessage = "You provided invalid input to the script. " .
1368
                     "Try again please.";
1369
  fullTemplate( [], { stage => $templates->{'stage'},
1370
                      errorMessage => $errorMessage });
1371
  exit();
1372
}
1373

    
1374
#
1375
# perform a simple search against the LDAP database using 
1376
# a small subset of attributes of each dn and return it
1377
# as a table to the calling browser.
1378
#
1379
sub handleSimpleSearch {
1380

    
1381
    my $o = $query->param('o');
1382

    
1383
    my $ldapurl = $ldapConfig->{$o}{'url'};
1384
    my $searchBase = $ldapConfig->{$o}{'base'};
1385

    
1386
    print "Content-type: text/html\n\n";
1387

    
1388
    my $allParams = { 
1389
                      'cn' => $query->param('cn'),
1390
                      'sn' => $query->param('sn'),
1391
                      'gn' => $query->param('gn'),
1392
                      'o'  => $query->param('o'),
1393
                      'facsimiletelephonenumber' 
1394
                      => $query->param('facsimiletelephonenumber'),
1395
                      'mail' => $query->param('cmail'),
1396
                      'telephonenumber' => $query->param('telephonenumber'),
1397
                      'title' => $query->param('title'),
1398
                      'uid' => $query->param('uid'),
1399
                      'ou' => $query->param('ou'),
1400
                    };
1401

    
1402
    # Search LDAP for matching entries that already exist
1403
    my $filter = "(" . 
1404
                 $query->param('searchField') . "=" .
1405
                 "*" .
1406
                 $query->param('searchValue') .
1407
                 "*" .
1408
                 ")";
1409

    
1410
    my @attrs = [ 'sn', 
1411
                  'gn', 
1412
                  'cn', 
1413
                  'o', 
1414
                  'facsimiletelephonenumber', 
1415
                  'mail', 
1416
                  'telephoneNumber', 
1417
                  'title', 
1418
                  'uid', 
1419
                  'labeledURI', 
1420
                  'ou' ];
1421

    
1422
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1423

    
1424
    # Send back the search results
1425
    if ($found) {
1426
      fullTemplate( ('searchResults'), { stage => "searchresults",
1427
                                         allParams => $allParams,
1428
                                         foundAccounts => $found });
1429
    } else {
1430
      $found = "No entries matched your criteria.  Please try again\n";
1431

    
1432
      fullTemplate( ('searchResults'), { stage => "searchresults",
1433
                                         allParams => $allParams,
1434
                                         foundAccounts => $found });
1435
    }
1436

    
1437
    exit();
1438
}
1439

    
1440
#
1441
# search the LDAP directory to see if a similar account already exists
1442
#
1443
sub searchDirectory {
1444
    my $ldapurl = shift;
1445
    my $base = shift;
1446
    my $filter = shift;
1447
    my $attref = shift;
1448

    
1449
	my $mesg;
1450
    my $foundAccounts = 0;
1451
    
1452
    #if ldap server is down, a html file containing warning message will be returned
1453
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1454
    
1455
    if ($ldap) {
1456
    	$ldap->start_tls( verify => 'none');
1457
    	$ldap->bind( version => 3, anonymous => 1);
1458
    	my $mesg = $ldap->search (
1459
        	base   => $base,
1460
        	filter => $filter,
1461
        	attrs => @$attref,
1462
    	);
1463

    
1464
    	if ($mesg->count() > 0) {
1465
        	$foundAccounts = "";
1466
        	my $entry;
1467
        	foreach $entry ($mesg->sorted(['sn'])) {
1468
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1469
          		$foundAccounts .= "<a href=\"" unless 
1470
                    (!$entry->get_value('labeledURI'));
1471
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1472
                    (!$entry->get_value('labeledURI'));
1473
          		$foundAccounts .= "\">\n" unless 
1474
                    (!$entry->get_value('labeledURI'));
1475
          		$foundAccounts .= $entry->get_value('givenName');
1476
          		$foundAccounts .= "</a>\n" unless 
1477
                    (!$entry->get_value('labeledURI'));
1478
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1479
          		$foundAccounts .= "<a href=\"" unless 
1480
                    (!$entry->get_value('labeledURI'));
1481
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1482
                    (!$entry->get_value('labeledURI'));
1483
          		$foundAccounts .= "\">\n" unless 
1484
                    (!$entry->get_value('labeledURI'));
1485
          		$foundAccounts .= $entry->get_value('sn');
1486
          		$foundAccounts .= "</a>\n";
1487
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1488
          		$foundAccounts .= $entry->get_value('mail');
1489
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1490
          		$foundAccounts .= $entry->get_value('telephonenumber');
1491
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1492
          		$foundAccounts .= $entry->get_value('title');
1493
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1494
          		$foundAccounts .= $entry->get_value('ou');
1495
          		$foundAccounts .= "\n</td>\n";
1496
          		$foundAccounts .= "</tr>\n";
1497
        	}
1498
    	}
1499
    	$ldap->unbind;   # take down session
1500
    }
1501
    return $foundAccounts;
1502
}
1503

    
1504
sub debug {
1505
    my $msg = shift;
1506
    
1507
    if ($debug) {
1508
        print STDERR "LDAPweb: $msg\n";
1509
    }
1510
}
1511

    
1512
sub handleLDAPBindFailure {
1513
    my $ldapAttemptUrl = shift;
1514
    my $primaryLdap =  $properties->getProperty('auth.url');
1515

    
1516
    if ($ldapAttemptUrl eq  $primaryLdap) {
1517
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1518
    } else {
1519
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1520
    }
1521
}
1522

    
1523
sub handleGeneralServerFailure {
1524
    my $errorMessage = shift;
1525
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1526
    exit(0);   
1527
   }
1528
    
1529
sub setVars {
1530
    my $paramVars = shift;
1531
    # initialize default parameters 
1532
    my $templateVars = { cfg => $cfg,
1533
                         styleSkinsPath => $contextUrl . "/style/skins",
1534
                         styleCommonPath => $contextUrl . "/style/common",
1535
                         contextUrl => $contextUrl,
1536
                         cgiPrefix => $cgiPrefix,
1537
                         orgList => \@validDisplayOrgList,
1538
                         config  => $config,
1539
    };
1540
    
1541
    # append customized params
1542
    while (my ($k, $v) = each (%$paramVars)) {
1543
        $templateVars->{$k} = $v;
1544
    }
1545
    
1546
    return $templateVars;
1547
} 
1548

    
(10-10/14)