Project

General

Profile

1 2341 sgarg
#!/usr/bin/perl -w
2 4865 walbridge
#
3
#  '$RCSfile$'
4
#  Copyright: 2001 Regents of the University of California
5
#
6
#   '$Author$'
7
#     '$Date$'
8
# '$Revision$'
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 2341 sgarg
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 4394 walbridge
30
use lib '../WEB-INF/lib';
31 4080 daigle
use strict;             # turn on strict syntax checking
32
use Template;           # load the template-toolkit module
33 4394 walbridge
use CGI qw/:standard :html3/; # load the CGI module
34 4080 daigle
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 8351 leinfelder
use DateTime;			# for parsing dates
42
use DateTime::Duration; # for substracting
43 8166 tao
use Captcha::reCAPTCHA; # for protection against spams
44 4394 walbridge
use Cwd 'abs_path';
45 2341 sgarg
46 4080 daigle
# Global configuration paramters
47 4394 walbridge
# This entire block (including skin parsing) could be pushed out to a separate .pm file
48 4080 daigle
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 4394 walbridge
    print "Content-type: text/html\n\n";
54 4080 daigle
    print "Unable to locate Metacat properties. Working directory is set as " .
55
        $workingDirectory .", is this correct?";
56
    exit(0);
57
}
58 2341 sgarg
59 4080 daigle
$properties->load(*METACAT_PROPERTIES);
60 4010 tao
61 4394 walbridge
# 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 7199 leinfelder
my $protocol = 'http://';
69
if ( $properties->getProperty('server.httpPort') eq '443' ) {
70
	$protocol = 'https://';
71
}
72 8253 leinfelder
my $serverUrl = $protocol . $properties->getProperty('server.name');
73 4864 walbridge
if ($properties->getProperty('server.httpPort') ne '80') {
74 8253 leinfelder
        $serverUrl = $serverUrl . ':' . $properties->getProperty('server.httpPort');
75 4864 walbridge
}
76 8253 leinfelder
my $context = $properties->getProperty('application.context');
77
my $contextUrl = $serverUrl . '/' .  $context;
78 4394 walbridge
79
my $metacatUrl = $contextUrl . "/metacat";
80 8253 leinfelder
my $cgiPrefix = "/" . $context . "/cgi-bin";
81 4394 walbridge
my $styleSkinsPath = $contextUrl . "/style/skins";
82
my $styleCommonPath = $contextUrl . "/style/common";
83
84 8169 tao
#recaptcha key information
85
my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');
86
my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');
87
88 4394 walbridge
my @errorMessages;
89
my $error = 0;
90
91 8181 tao
my $emailVerification= 'emailverification';
92
93 4394 walbridge
# 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 4747 walbridge
    debug("No configuration set.");
104 4394 walbridge
    print "Content-type: text/html\n\n";
105 4749 walbridge
    print 'LDAPweb Error: The registry requires a skin name to continue.';
106 4394 walbridge
    exit();
107
}
108
109
# Metacat isn't initialized, the registry will fail in strange ways.
110
if (!($metacatUrl)) {
111 4747 walbridge
    debug("No Metacat.");
112 4394 walbridge
    print "Content-type: text/html\n\n";
113
    'Registry Error: Metacat is not initialized! Make sure' .
114 5214 walbridge
        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';
115 4394 walbridge
    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 4870 walbridge
# 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 4394 walbridge
my $searchBase;
154
my $ldapUsername;
155
my $ldapPassword;
156 4728 walbridge
# 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 4080 daigle
160
# Java uses miliseconds, Perl expects whole seconds
161 4728 walbridge
my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;
162 4080 daigle
163 2341 sgarg
# Get the CGI input variables
164
my $query = new CGI;
165 4747 walbridge
my $debug = 1;
166 2341 sgarg
167
#--------------------------------------------------------------------------80c->
168
# Set up the Template Toolkit to read html form templates
169
170 4080 daigle
# templates hash, imported from ldap.templates tree in metacat.properties
171
my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');
172 4394 walbridge
$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");
173
$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");
174 2341 sgarg
175
# set some configuration options for the template object
176 4394 walbridge
my $ttConfig = {
177
             INCLUDE_PATH => $templatesDir,
178
             INTERPOLATE  => 0,
179
             POST_CHOMP   => 1,
180
             DEBUG        => 1,
181 2341 sgarg
             };
182
183
# create an instance of the template
184 4394 walbridge
my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);
185 2341 sgarg
186 4080 daigle
# custom LDAP properties hash
187
my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');
188 2341 sgarg
189 8201 tao
# This is a hash which has the keys of the organization's properties 'name', 'base', 'organization'.
190 4394 walbridge
my $orgProps = $properties->splitToTree(qr/\./, 'organization');
191 8201 tao
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 4394 walbridge
my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');
194
# pull out properties available e.g. 'name', 'base'
195
my @orgData = keys(%$orgProps);
196 4870 walbridge
197 8201 tao
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 4394 walbridge
while (my ($oKey, $oVal) = each(%$orgNames)) {
199
    push(@orgList, $oKey);
200
}
201
202 4866 walbridge
my $authBase = $properties->getProperty("auth.base");
203 4080 daigle
my $ldapConfig;
204
foreach my $o (@orgList) {
205 4394 walbridge
    foreach my $d (@orgData) {
206
        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");
207 4080 daigle
    }
208 4866 walbridge
209 4870 walbridge
    # 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 4866 walbridge
    # 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 8201 tao
            #$ldapConfig->{$o}{'filter'} = $filter;
231
            $ldapConfig->{$o}{'filter'} = $ldapConfig->{$o}{'org'};
232 4866 walbridge
        }
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 4394 walbridge
    } else {
238
        $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'base'};
239
    }
240 4868 walbridge
241
    # set LDAP administrator user account
242 4866 walbridge
    if (!$ldapConfig->{$o}{'user'}) {
243
        $ldapConfig->{$o}{'user'} = $ldapConfig->{'unaffiliated'}{'user'};
244 4865 walbridge
    }
245 4868 walbridge
    # 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 4866 walbridge
251
    if (!$ldapConfig->{$o}{'password'}) {
252
        $ldapConfig->{$o}{'password'} = $ldapConfig->{'unaffiliated'}{'password'};
253
    }
254 2341 sgarg
}
255
256 8201 tao
### Determine the display organization list (such as NCEAS, Account ) in the ldap template files
257 8206 tao
my $displayOrgListStr;
258
$displayOrgListStr = $skinProperties->getProperty("ldap.templates.organizationList") or $displayOrgListStr = $properties->getProperty('ldap.templates.organizationList');
259 8207 tao
debug("the string of the org from properties : " . $displayOrgListStr);
260
my @displayOrgList = split(';', $displayOrgListStr);
261
262 8206 tao
my @validDisplayOrgList; #this array contains the org list which will be shown in the templates files.
263 8201 tao
264 8206 tao
my %orgNamesHash = %$orgNames;
265
foreach my $element (@displayOrgList) {
266
    if(exists $orgNamesHash{$element}) {
267 8207 tao
         debug("push the organization " . $element . " into the dispaly array");
268 8206 tao
         #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 8201 tao
274 8206 tao
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 2341 sgarg
#--------------------------------------------------------------------------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 4080 daigle
my $stage = $query->param('stage') || $templates->{'stage'};
291 2341 sgarg
292
my $cfg = $query->param('cfg');
293 4767 walbridge
debug("started with stage $stage, cfg $cfg");
294 2341 sgarg
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 2972 jones
              'changepass'        => \&handleChangePassword,
306
              'initchangepass'    => \&handleInitialChangePassword,
307 2341 sgarg
              'resetpass'         => \&handleResetPassword,
308 2414 sgarg
              'initresetpass'     => \&handleInitialResetPassword,
309 8185 tao
              'emailverification' => \&handleEmailVerification,
310 8229 tao
              'lookupname'        => \&handleLookupName,
311
              'searchnamesbyemail'=> \&handleSearchNameByEmail,
312 2341 sgarg
             );
313 4394 walbridge
314 2341 sgarg
# 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 8351 leinfelder
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 8354 leinfelder
	my $expirationDate = $dt->ymd("") . $dt->hms("") . "Z";
338 8351 leinfelder
    my $filter = "(createTimestamp <= " . $expirationDate . ")";
339
    debug("Clearing expired accounts with filter: " . $filter);
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("clearTempAccounts: 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 8354 leinfelder
			base   => $orgAuthBase,
355 8351 leinfelder
			filter => $filter,
356
			attrs => \@attrs,
357
		);
358
359
	    if ($mesg->count() > 0) {
360
			my $entry;
361
			foreach $entry ($mesg->all_entries) {
362
            	$dn = $entry->dn();
363
            	# remove the entry
364
   				debug("DRY RUN: Removing expired account: " . $dn);
365
            	#$ldap->delete($dn);
366
			}
367
        }
368
    	$ldap->unbind;   # take down session
369
    }
370
371 8354 leinfelder
    return 0;
372 8351 leinfelder
}
373
374 4728 walbridge
sub fullTemplate {
375
    my $templateList = shift;
376
    my $templateVars = setVars(shift);
377 8166 tao
    my $c = Captcha::reCAPTCHA->new;
378
    my $captcha = 'captcha';
379
    #my $error=null;
380
    my $use_ssl= 1;
381
    #my $options=null;
382 8250 leinfelder
    # use the AJAX style, only need to provide the public key to the template
383
    $templateVars->{'recaptchaPublicKey'} = $recaptchaPublicKey;
384
    #$templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);
385 4728 walbridge
    $template->process( $templates->{'header'}, $templateVars );
386
    foreach my $tmpl (@{$templateList}) {
387
        $template->process( $templates->{$tmpl}, $templateVars );
388
    }
389
    $template->process( $templates->{'footer'}, $templateVars );
390
}
391
392 8221 tao
393 8229 tao
#
394
# Initialize a form for a user to request the account name associated with an email address
395
#
396
sub handleLookupName {
397
398
    print "Content-type: text/html\n\n";
399
    # process the template files:
400
    fullTemplate(['lookupName']);
401
    exit();
402
}
403 8221 tao
404 2341 sgarg
#
405 8221 tao
# Handle the user's request to look up account names with a specified email address.
406
# This relates to "Forget your user name"
407
#
408 8229 tao
sub handleSearchNameByEmail{
409 8221 tao
410
    print "Content-type: text/html\n\n";
411
412
    my $allParams = {'mail' => $query->param('mail')};
413
    my @requiredParams = ('mail');
414
    if (! paramsAreValid(@requiredParams)) {
415
        my $errorMessage = "Required information is missing. " .
416
            "Please fill in all required fields and resubmit the form.";
417 8229 tao
        fullTemplate(['lookupName'], { allParams => $allParams,
418 8221 tao
                                     errorMessage => $errorMessage });
419
        exit();
420
    }
421
    my $mail = $query->param('mail');
422
423
    #search accounts with the specified emails
424
    $searchBase = $authBase;
425
    my $filter = "(mail=" . $mail . ")";
426
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
427
    my $notHtmlFormat = 1;
428
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs, $notHtmlFormat);
429
    my $accountInfo;
430 8254 leinfelder
    if ($found) {
431 8221 tao
        $accountInfo = $found;
432
    } else {
433 8254 leinfelder
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n";
434 8221 tao
    }
435 8254 leinfelder
436 8221 tao
    my $mailhost = $properties->getProperty('email.mailhost');
437
    my $sender;
438
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
439
    debug("the sender is " . $sender);
440
    my $recipient = $query->param('mail');
441
    # Send the email message to them
442
    my $smtp = Net::SMTP->new($mailhost) or do {
443 8229 tao
                                                  fullTemplate( ['lookupName'], {allParams => $allParams,
444
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " .
445
                                                                $skinProperties->getProperty("email.recipient") . "." });
446 8221 tao
                                                  exit(0);
447
                                               };
448
    $smtp->mail($sender);
449
    $smtp->to($recipient);
450
451
    my $message = <<"     ENDOFMESSAGE";
452
    To: $recipient
453
    From: $sender
454 8234 tao
    Subject: Your Account Information
455 8221 tao
456 8234 tao
    Somebody (hopefully you) looked up the account information associated with the email address.
457
    Here is the account information:
458 8221 tao
459
    $accountInfo
460
461
    Thanks,
462 8234 tao
        $sender
463 8221 tao
464
     ENDOFMESSAGE
465
     $message =~ s/^[ \t\r\f]+//gm;
466
467
     $smtp->data($message);
468
     $smtp->quit;
469
     fullTemplate( ['lookupNameSuccess'] );
470
471
}
472
473
474
#
475 2341 sgarg
# create the initial registration form
476
#
477
sub handleInitRegister {
478
  my $vars = shift;
479
  print "Content-type: text/html\n\n";
480
  # process the template files:
481 4080 daigle
  fullTemplate(['register'], {stage => "register"});
482 2341 sgarg
  exit();
483
}
484
485 8221 tao
486
487 2341 sgarg
#
488
# process input from the register stage, which occurs when
489
# a user submits form data to create a new account
490
#
491
sub handleRegister {
492
493 8258 tao
    #print "Content-type: text/html\n\n";
494 8220 tao
    if ($query->param('o') =~ "LTER") {
495 8258 tao
      print "Content-type: text/html\n\n";
496 8220 tao
      fullTemplate( ['registerLter'] );
497
      exit(0);
498
    }
499 8166 tao
500 2341 sgarg
    my $allParams = { 'givenName' => $query->param('givenName'),
501
                      'sn' => $query->param('sn'),
502
                      'o' => $query->param('o'),
503
                      'mail' => $query->param('mail'),
504
                      'uid' => $query->param('uid'),
505
                      'userPassword' => $query->param('userPassword'),
506
                      'userPassword2' => $query->param('userPassword2'),
507
                      'title' => $query->param('title'),
508
                      'telephoneNumber' => $query->param('telephoneNumber') };
509 8166 tao
510
    # Check the recaptcha
511
    my $c = Captcha::reCAPTCHA->new;
512
    my $challenge = $query->param('recaptcha_challenge_field');
513
    my $response = $query->param('recaptcha_response_field');
514
    # Verify submission
515
    my $result = $c->check_answer(
516 8169 tao
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
517 8166 tao
        $challenge, $response
518
    );
519
520
    if ( $result->{is_valid} ) {
521
        #print "Yes!";
522
        #exit();
523
    }
524
    else {
525 8258 tao
        print "Content-type: text/html\n\n";
526 8166 tao
        my $errorMessage = "The verification code is wrong. Please input again.";
527
        fullTemplate(['register'], { stage => "register",
528
                                     allParams => $allParams,
529
                                     errorMessage => $errorMessage });
530
        exit();
531
    }
532
533
534 2341 sgarg
    # Check that all required fields are provided and not null
535
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail',
536
                           'uid', 'userPassword', 'userPassword2');
537
    if (! paramsAreValid(@requiredParams)) {
538 8258 tao
        print "Content-type: text/html\n\n";
539 2341 sgarg
        my $errorMessage = "Required information is missing. " .
540
            "Please fill in all required fields and resubmit the form.";
541 4080 daigle
        fullTemplate(['register'], { stage => "register",
542
                                     allParams => $allParams,
543
                                     errorMessage => $errorMessage });
544
        exit();
545 2341 sgarg
    } else {
546 8186 tao
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
547 8258 tao
            print "Content-type: text/html\n\n";
548 8186 tao
            my $errorMessage = "The passwords do not match. Try again.";
549
            fullTemplate( ['registerFailed', 'register'], { stage => "register",
550
                                                            allParams => $allParams,
551
                                                            errorMessage => $errorMessage });
552
            exit();
553
        }
554 2972 jones
        my $o = $query->param('o');
555 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
556 2341 sgarg
    }
557 8351 leinfelder
558
    # Remove any expired temporary accounts for this subtree before continuing
559
    clearTemporaryAccounts();
560 2341 sgarg
561
    # Search LDAP for matching entries that already exist
562
    # Some forms use a single text search box, whereas others search per
563
    # attribute.
564
    my $filter;
565
    if ($query->param('searchField')) {
566
567
      $filter = "(|" .
568
                "(uid=" . $query->param('searchField') . ") " .
569
                "(mail=" . $query->param('searchField') . ")" .
570
                "(&(sn=" . $query->param('searchField') . ") " .
571
                "(givenName=" . $query->param('searchField') . "))" .
572
                ")";
573
    } else {
574
      $filter = "(|" .
575
                "(uid=" . $query->param('uid') . ") " .
576
                "(mail=" . $query->param('mail') . ")" .
577
                "(&(sn=" . $query->param('sn') . ") " .
578
                "(givenName=" . $query->param('givenName') . "))" .
579
                ")";
580
    }
581
582 8217 tao
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
583 2341 sgarg
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
584
585
    # If entries match, send back a request to confirm new-user creation
586
    if ($found) {
587 8261 tao
      print "Content-type: text/html\n\n";
588 4080 daigle
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
589
                                                     allParams => $allParams,
590
                                                     foundAccounts => $found });
591 2341 sgarg
    # Otherwise, create a new user in the LDAP directory
592
    } else {
593 8180 tao
        createTemporaryAccount($allParams);
594 2341 sgarg
    }
595
596
    exit();
597
}
598
599
#
600
# process input from the registerconfirmed stage, which occurs when
601
# a user chooses to create an account despite similarities to other
602
# existing accounts
603
#
604
sub handleRegisterConfirmed {
605
606
    my $allParams = { 'givenName' => $query->param('givenName'),
607
                      'sn' => $query->param('sn'),
608 8207 tao
                      'o' => $query->param('o'),
609 2341 sgarg
                      'mail' => $query->param('mail'),
610
                      'uid' => $query->param('uid'),
611
                      'userPassword' => $query->param('userPassword'),
612
                      'userPassword2' => $query->param('userPassword2'),
613
                      'title' => $query->param('title'),
614
                      'telephoneNumber' => $query->param('telephoneNumber') };
615 8258 tao
    #print "Content-type: text/html\n\n";
616 8180 tao
    createTemporaryAccount($allParams);
617 2341 sgarg
    exit();
618
}
619
620
#
621
# change a user's password upon request
622
#
623
sub handleChangePassword {
624
625
    print "Content-type: text/html\n\n";
626
627
    my $allParams = { 'test' => "1", };
628
    if ($query->param('uid')) {
629
        $$allParams{'uid'} = $query->param('uid');
630
    }
631
    if ($query->param('o')) {
632
        $$allParams{'o'} = $query->param('o');
633 2972 jones
        my $o = $query->param('o');
634
635 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
636 2341 sgarg
    }
637
638
639
    # Check that all required fields are provided and not null
640
    my @requiredParams = ( 'uid', 'o', 'oldpass',
641
                           'userPassword', 'userPassword2');
642
    if (! paramsAreValid(@requiredParams)) {
643
        my $errorMessage = "Required information is missing. " .
644
            "Please fill in all required fields and submit the form.";
645 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
646
                                        allParams => $allParams,
647
                                        errorMessage => $errorMessage });
648
        exit();
649 2341 sgarg
    }
650
651
    # We have all of the info we need, so try to change the password
652
    if ($query->param('userPassword') =~ $query->param('userPassword2')) {
653
654 2972 jones
        my $o = $query->param('o');
655 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
656
        $ldapUsername = $ldapConfig->{$o}{'user'};
657
        $ldapPassword = $ldapConfig->{$o}{'password'};
658 2341 sgarg
659 4080 daigle
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
660 2341 sgarg
        if ($query->param('o') =~ "LTER") {
661 4080 daigle
            fullTemplate( ['registerLter'] );
662 2341 sgarg
        } else {
663
            my $errorMessage = changePassword(
664
                    $dn, $query->param('userPassword'),
665
                    $dn, $query->param('oldpass'), $query->param('o'));
666 2972 jones
            if ($errorMessage) {
667 4080 daigle
                fullTemplate( ['changePass'], { stage => "changepass",
668
                                                allParams => $allParams,
669
                                                errorMessage => $errorMessage });
670
                exit();
671 2341 sgarg
            } else {
672 4080 daigle
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
673
                                                       allParams => $allParams });
674
                exit();
675 2341 sgarg
            }
676
        }
677
    } else {
678
        my $errorMessage = "The passwords do not match. Try again.";
679 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
680
                                        allParams => $allParams,
681
                                        errorMessage => $errorMessage });
682
        exit();
683 2341 sgarg
    }
684
}
685
686
#
687 2414 sgarg
# change a user's password upon request - no input params
688
# only display chagepass template without any error
689
#
690
sub handleInitialChangePassword {
691
    print "Content-type: text/html\n\n";
692
693
    my $allParams = { 'test' => "1", };
694
    my $errorMessage = "";
695 4080 daigle
    fullTemplate( ['changePass'], { stage => "changepass",
696
                                    errorMessage => $errorMessage });
697
    exit();
698 2414 sgarg
}
699
700
#
701 2341 sgarg
# reset a user's password upon request
702
#
703
sub handleResetPassword {
704
705
    print "Content-type: text/html\n\n";
706
707
    my $allParams = { 'test' => "1", };
708
    if ($query->param('uid')) {
709
        $$allParams{'uid'} = $query->param('uid');
710
    }
711
    if ($query->param('o')) {
712
        $$allParams{'o'} = $query->param('o');
713 2972 jones
        my $o = $query->param('o');
714
715 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
716 4868 walbridge
        $ldapUsername = $ldapConfig->{$o}{'user'};
717 4080 daigle
        $ldapPassword = $ldapConfig->{$o}{'password'};
718 2341 sgarg
    }
719
720
    # Check that all required fields are provided and not null
721
    my @requiredParams = ( 'uid', 'o' );
722
    if (! paramsAreValid(@requiredParams)) {
723
        my $errorMessage = "Required information is missing. " .
724
            "Please fill in all required fields and submit the form.";
725 4080 daigle
        fullTemplate( ['resetPass'],  { stage => "resetpass",
726
                                        allParams => $allParams,
727
                                        errorMessage => $errorMessage });
728
        exit();
729 2341 sgarg
    }
730
731
    # We have all of the info we need, so try to change the password
732
    my $o = $query->param('o');
733 4080 daigle
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
734 4866 walbridge
    debug("handleResetPassword: dn: $dn");
735 2341 sgarg
    if ($query->param('o') =~ "LTER") {
736 4080 daigle
        fullTemplate( ['registerLter'] );
737
        exit();
738 2341 sgarg
    } else {
739
        my $errorMessage = "";
740
        my $recipient;
741
        my $userPass;
742
        my $entry = getLdapEntry($ldapurl, $searchBase,
743
                $query->param('uid'), $query->param('o'));
744
745
        if ($entry) {
746
            $recipient = $entry->get_value('mail');
747
            $userPass = getRandomPassword();
748 4080 daigle
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
749 2341 sgarg
        } else {
750
            $errorMessage = "User not found in database.  Please try again.";
751
        }
752
753
        if ($errorMessage) {
754 4080 daigle
            fullTemplate( ['resetPass'], { stage => "resetpass",
755
                                           allParams => $allParams,
756
                                           errorMessage => $errorMessage });
757
            exit();
758 2341 sgarg
        } else {
759
            my $errorMessage = sendPasswordNotification($query->param('uid'),
760 2972 jones
                    $query->param('o'), $userPass, $recipient, $cfg);
761 4080 daigle
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
762
                                                  allParams => $allParams,
763
                                                  errorMessage => $errorMessage });
764
            exit();
765 2341 sgarg
        }
766
    }
767
}
768
769
#
770 2414 sgarg
# reset a user's password upon request- no initial params
771
# only display resetpass template without any error
772
#
773
sub handleInitialResetPassword {
774
    print "Content-type: text/html\n\n";
775
    my $errorMessage = "";
776 4080 daigle
    fullTemplate( ['resetPass'], { stage => "resetpass",
777
                                   errorMessage => $errorMessage });
778
    exit();
779 2414 sgarg
}
780
781
#
782 2341 sgarg
# Construct a random string to use for a newly reset password
783
#
784
sub getRandomPassword {
785
    my $length = shift;
786
    if (!$length) {
787
        $length = 8;
788
    }
789
    my $newPass = "";
790
791
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
792
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
793
    return $newPass;
794
}
795
796
#
797
# Change a password to a new value, binding as the provided user
798
#
799
sub changePassword {
800
    my $userDN = shift;
801
    my $userPass = shift;
802
    my $bindDN = shift;
803
    my $bindPass = shift;
804
    my $o = shift;
805
806 4080 daigle
    my $searchBase = $ldapConfig->{$o}{'base'};
807 4868 walbridge
808 2341 sgarg
    my $errorMessage = 0;
809 3177 tao
    my $ldap;
810 4868 walbridge
811 4771 walbridge
    #if main ldap server is down, a html file containing warning message will be returned
812
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
813 4394 walbridge
814 4849 daigle
    if ($ldap) {
815 4868 walbridge
        #$ldap->start_tls( verify => 'require',
816 2972 jones
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
817 4868 walbridge
        $ldap->start_tls( verify => 'none');
818
        debug("changePassword: attempting to bind to $bindDN");
819
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN,
820 2341 sgarg
                                  password => $bindPass );
821 4868 walbridge
        if ($bindresult->code) {
822
            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .
823
                            "correct? Please correct and try again...";
824
            return $errorMessage;
825
        }
826 2341 sgarg
827 4849 daigle
    	# Find the user here and change their entry
828
    	my $newpass = createSeededPassHash($userPass);
829
    	my $modifications = { userPassword => $newpass };
830 4868 walbridge
      debug("changePass: setting password for $userDN to $newpass");
831 4849 daigle
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
832 2341 sgarg
833 4849 daigle
    	if ($result->code()) {
834 4866 walbridge
            debug("changePass: error changing password: " . $result->error);
835
        	$errorMessage = "There was an error changing the password:" .
836 2341 sgarg
                           "<br />\n" . $result->error;
837 4849 daigle
    	}
838
    	$ldap->unbind;   # take down session
839
    }
840 2341 sgarg
841
    return $errorMessage;
842
}
843
844
#
845
# generate a Seeded SHA1 hash of a plaintext password
846
#
847
sub createSeededPassHash {
848
    my $secret = shift;
849
850
    my $salt = "";
851
    for (my $i=0; $i < 4; $i++) {
852
        $salt .= int(rand(10));
853
    }
854
855
    my $ctx = Digest::SHA1->new;
856
    $ctx->add($secret);
857
    $ctx->add($salt);
858
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
859
860
    return $hashedPasswd;
861
}
862
863
#
864
# Look up an ldap entry for a user
865
#
866
sub getLdapEntry {
867
    my $ldapurl = shift;
868
    my $base = shift;
869
    my $username = shift;
870
    my $org = shift;
871
872
    my $entry = "";
873
    my $mesg;
874 3177 tao
    my $ldap;
875 4749 walbridge
    debug("ldap server: $ldapurl");
876 4394 walbridge
877
    #if main ldap server is down, a html file containing warning message will be returned
878 4771 walbridge
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
879 4849 daigle
880
    if ($ldap) {
881
    	$ldap->start_tls( verify => 'none');
882
    	my $bindresult = $ldap->bind;
883
    	if ($bindresult->code) {
884
        	return $entry;
885
    	}
886 2341 sgarg
887 4849 daigle
    	if($ldapConfig->{$org}{'filter'}){
888 4865 walbridge
            debug("getLdapEntry: filter set, searching for base=$base, " .
889
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
890 4849 daigle
        	$mesg = $ldap->search ( base   => $base,
891 4080 daigle
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
892 4849 daigle
    	} else {
893 4865 walbridge
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
894 4849 daigle
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
895
    	}
896 3177 tao
897 4849 daigle
    	if ($mesg->count > 0) {
898
        	$entry = $mesg->pop_entry;
899
        	$ldap->unbind;   # take down session
900
    	} else {
901
        	$ldap->unbind;   # take down session
902
        	# Follow references by recursive call to self
903
        	my @references = $mesg->references();
904
        	for (my $i = 0; $i <= $#references; $i++) {
905
            	my $uri = URI->new($references[$i]);
906
            	my $host = $uri->host();
907
            	my $path = $uri->path();
908
            	$path =~ s/^\///;
909
            	$entry = &getLdapEntry($host, $path, $username, $org);
910
            	if ($entry) {
911 4865 walbridge
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
912 4849 daigle
                	return $entry;
913
            	}
914
        	}
915
    	}
916 2341 sgarg
    }
917
    return $entry;
918
}
919
920
#
921
# send an email message notifying the user of the pw change
922
#
923
sub sendPasswordNotification {
924
    my $username = shift;
925
    my $org = shift;
926
    my $newPass = shift;
927
    my $recipient = shift;
928 2972 jones
    my $cfg = shift;
929 2341 sgarg
930
    my $errorMessage = "";
931
    if ($recipient) {
932 8254 leinfelder
933 4771 walbridge
        my $mailhost = $properties->getProperty('email.mailhost');
934 8197 tao
        my $sender;
935
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
936 2341 sgarg
        # Send the email message to them
937
        my $smtp = Net::SMTP->new($mailhost);
938
        $smtp->mail($sender);
939
        $smtp->to($recipient);
940
941
        my $message = <<"        ENDOFMESSAGE";
942
        To: $recipient
943
        From: $sender
944 8234 tao
        Subject: Your Account Password Reset
945 2341 sgarg
946 8234 tao
        Somebody (hopefully you) requested that your account password be reset.
947 8259 leinfelder
        Your temporary password is below. Please change it as soon as possible
948
        at: $contextUrl.
949 2341 sgarg
950
            Username: $username
951
        Organization: $org
952
        New Password: $newPass
953
954
        Thanks,
955 8234 tao
            $sender
956 2341 sgarg
957
        ENDOFMESSAGE
958
        $message =~ s/^[ \t\r\f]+//gm;
959
960
        $smtp->data($message);
961
        $smtp->quit;
962
    } else {
963
        $errorMessage = "Failed to send password because I " .
964
                        "couldn't find a valid email address.";
965
    }
966
    return $errorMessage;
967
}
968
969
#
970
# search the LDAP directory to see if a similar account already exists
971
#
972
sub findExistingAccounts {
973
    my $ldapurl = shift;
974
    my $base = shift;
975
    my $filter = shift;
976
    my $attref = shift;
977 8221 tao
    my $notHtmlFormat = shift;
978 3175 tao
    my $ldap;
979 4847 daigle
    my $mesg;
980 2341 sgarg
981
    my $foundAccounts = 0;
982 4749 walbridge
983 4394 walbridge
    #if main ldap server is down, a html file containing warning message will be returned
984 4868 walbridge
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
985 4771 walbridge
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
986 4845 daigle
    if ($ldap) {
987
    	$ldap->start_tls( verify => 'none');
988
    	$ldap->bind( version => 3, anonymous => 1);
989 4848 daigle
		$mesg = $ldap->search (
990 4845 daigle
			base   => $base,
991
			filter => $filter,
992
			attrs => @$attref,
993
		);
994 2341 sgarg
995 4845 daigle
	    if ($mesg->count() > 0) {
996
			$foundAccounts = "";
997
			my $entry;
998
			foreach $entry ($mesg->all_entries) {
999 5650 walbridge
                # a fix to ignore 'ou=Account' properties which are not usable accounts within Metacat.
1000
                # this could be done directly with filters on the LDAP connection, instead.
1001 8217 tao
                #if ($entry->dn !~ /ou=Account/) {
1002 8221 tao
                    if($notHtmlFormat) {
1003
                        $foundAccounts .= "\nAccount: ";
1004
                    } else {
1005
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
1006
                    }
1007 5650 walbridge
                    $foundAccounts .= $entry->dn();
1008 8221 tao
                    if($notHtmlFormat) {
1009
                        $foundAccounts .= "\n";
1010
                    } else {
1011
                        $foundAccounts .= "</b><br />\n";
1012
                    }
1013 5650 walbridge
                    foreach my $attribute ($entry->attributes()) {
1014
                        my $value = $entry->get_value($attribute);
1015
                        $foundAccounts .= "$attribute: ";
1016
                        $foundAccounts .= $value;
1017 8221 tao
                         if($notHtmlFormat) {
1018
                            $foundAccounts .= "\n";
1019
                        } else {
1020
                            $foundAccounts .= "<br />\n";
1021
                        }
1022 5650 walbridge
                    }
1023 8221 tao
                    if($notHtmlFormat) {
1024
                        $foundAccounts .= "\n";
1025
                    } else {
1026
                        $foundAccounts .= "</p>\n";
1027
                    }
1028
1029 8217 tao
                #}
1030 4845 daigle
			}
1031 2341 sgarg
        }
1032 4845 daigle
    	$ldap->unbind;   # take down session
1033 2341 sgarg
1034 4848 daigle
    	# Follow references
1035
    	my @references = $mesg->references();
1036
    	for (my $i = 0; $i <= $#references; $i++) {
1037
        	my $uri = URI->new($references[$i]);
1038
        	my $host = $uri->host();
1039
        	my $path = $uri->path();
1040
        	$path =~ s/^\///;
1041 8254 leinfelder
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
1042 4848 daigle
        	if ($refFound) {
1043
            	$foundAccounts .= $refFound;
1044
        	}
1045
    	}
1046 2341 sgarg
    }
1047
1048
    #print "<p>Checking referrals...</p>\n";
1049
    #my @referrals = $mesg->referrals();
1050
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
1051
    #for (my $i = 0; $i <= $#referrals; $i++) {
1052
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
1053
    #}
1054
1055
    return $foundAccounts;
1056
}
1057
1058
#
1059
# Validate that we have the proper set of input parameters
1060
#
1061
sub paramsAreValid {
1062
    my @pnames = @_;
1063
1064
    my $allValid = 1;
1065
    foreach my $parameter (@pnames) {
1066
        if (!defined($query->param($parameter)) ||
1067
            ! $query->param($parameter) ||
1068
            $query->param($parameter) =~ /^\s+$/) {
1069
            $allValid = 0;
1070
        }
1071
    }
1072
1073
    return $allValid;
1074
}
1075
1076
#
1077 8175 tao
# Create a temporary account for a user and send an email with a link which can click for the
1078
# verification. This is used to protect the ldap server against spams.
1079
#
1080
sub createTemporaryAccount {
1081
    my $allParams = shift;
1082 8180 tao
    my $org = $query->param('o');
1083 8220 tao
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1084
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1085
    my $tmp = 1;
1086 8185 tao
1087 8220 tao
    ################## 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
1088
    my $orgAuthBase = $ldapConfig->{$org}{'base'};
1089
    my $tmpSearchBase = 'dc=tmp,' . $orgAuthBase;
1090
    my $tmpFilter = "dc=tmp";
1091
    my @attributes=['dc'];
1092
    my $foundTmp = searchDirectory($ldapurl, $orgAuthBase, $tmpFilter, \@attributes);
1093
    if (!$foundTmp) {
1094
        my $dn = $tmpSearchBase;
1095
        my $additions = [
1096
                    'dc' => 'tmp',
1097
                    'o'  => 'tmp',
1098
                    'objectclass' => ['top', 'dcObject', 'organization']
1099
                    ];
1100
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1101
    } else {
1102
     debug("found the tmp space");
1103
    }
1104 8175 tao
1105 8220 tao
    ################## Search LDAP for matching o or ou under the dc=tmp that already exist. If it doesn't exist, it will be generated
1106 8201 tao
    my $filter = $ldapConfig->{$org}{'filter'};
1107 8220 tao
1108 8176 tao
    debug("search filer " . $filter);
1109
    debug("ldap server ". $ldapurl);
1110
    debug("sesarch base " . $tmpSearchBase);
1111 8262 tao
    #print "Content-type: text/html\n\n";
1112 8175 tao
    my @attrs = ['o', 'ou' ];
1113
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1114 8220 tao
1115
    my @organizationInfo = split('=', $ldapConfig->{$org}{'org'}); #split 'o=NCEAS' or something like that
1116
    my $organization = $organizationInfo[0]; # This will be 'o' or 'ou'
1117
    my $organizationName = $organizationInfo[1]; # This will be 'NCEAS' or 'Account'
1118 8180 tao
1119 8176 tao
    if(!$found) {
1120 8180 tao
        debug("generate the subtree in the dc=tmp===========================");
1121 8176 tao
        #need to generate the subtree o or ou
1122 8220 tao
        my $additions;
1123 8207 tao
            if($organization eq 'ou') {
1124
                $additions = [
1125
                    $organization   => $organizationName,
1126
                    'objectclass' => ['top', 'organizationalUnit']
1127
                    ];
1128
1129
            } else {
1130
                $additions = [
1131
                    $organization   => $organizationName,
1132
                    'objectclass' => ['top', 'organization']
1133
                    ];
1134
1135
            }
1136 8220 tao
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1137
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1138 8176 tao
    }
1139 8175 tao
1140 8180 tao
    ################create an account under tmp subtree
1141 8176 tao
1142 8180 tao
    #generate a randomstr for matching the email.
1143
    my $randomStr = getRandomPassword(16);
1144
    # Create a hashed version of the password
1145
    my $shapass = createSeededPassHash($query->param('userPassword'));
1146
    my $additions = [
1147
                'uid'   => $query->param('uid'),
1148
                'cn'   => join(" ", $query->param('givenName'),
1149
                                    $query->param('sn')),
1150
                'sn'   => $query->param('sn'),
1151
                'givenName'   => $query->param('givenName'),
1152
                'mail' => $query->param('mail'),
1153
                'userPassword' => $shapass,
1154
                'employeeNumber' => $randomStr,
1155
                'objectclass' => ['top', 'person', 'organizationalPerson',
1156 8201 tao
                                'inetOrgPerson', 'uidObject' ],
1157
                $organization   => $organizationName
1158 8180 tao
                ];
1159
    if (defined($query->param('telephoneNumber')) &&
1160
                $query->param('telephoneNumber') &&
1161
                ! $query->param('telephoneNumber') =~ /^\s+$/) {
1162
                $$additions[$#$additions + 1] = 'telephoneNumber';
1163
                $$additions[$#$additions + 1] = $query->param('telephoneNumber');
1164
    }
1165
    if (defined($query->param('title')) &&
1166
                $query->param('title') &&
1167
                ! $query->param('title') =~ /^\s+$/) {
1168
                $$additions[$#$additions + 1] = 'title';
1169
                $$additions[$#$additions + 1] = $query->param('title');
1170
    }
1171 8201 tao
1172
1173
    #$$additions[$#$additions + 1] = 'o';
1174
    #$$additions[$#$additions + 1] = $org;
1175
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1176 8220 tao
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1177 8176 tao
1178 8180 tao
1179
    ####################send the verification email to the user
1180 8253 leinfelder
    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.
1181 8180 tao
1182 8253 leinfelder
    my $overrideURL;
1183
    $overrideURL = $skinProperties->getProperty("email.overrideURL");
1184
    debug("the overrideURL is " . $overrideURL);
1185
    if (defined($overrideURL) && !($overrideURL eq '')) {
1186
    	$link = $serverUrl . $overrideURL . $link;
1187
    } else {
1188
    	$link = $serverUrl . $link;
1189
    }
1190
1191 8181 tao
    my $mailhost = $properties->getProperty('email.mailhost');
1192 8197 tao
    my $sender;
1193
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1194
    debug("the sender is " . $sender);
1195 8181 tao
    my $recipient = $query->param('mail');
1196
    # Send the email message to them
1197 8191 tao
    my $smtp = Net::SMTP->new($mailhost) or do {
1198
                                                  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 " .
1199
                                                  $skinProperties->getProperty("email.recipient") . "." });
1200
                                                  exit(0);
1201
                                               };
1202 8181 tao
    $smtp->mail($sender);
1203
    $smtp->to($recipient);
1204
1205
    my $message = <<"     ENDOFMESSAGE";
1206
    To: $recipient
1207
    From: $sender
1208 8239 leinfelder
    Subject: New Account Activation
1209 8181 tao
1210 8254 leinfelder
    Somebody (hopefully you) registered an account on $contextUrl.
1211 8181 tao
    Please click the following link to activate your account.
1212
    If the link doesn't work, please copy the link to your browser:
1213
1214
    $link
1215
1216
    Thanks,
1217 8234 tao
        $sender
1218 8181 tao
1219
     ENDOFMESSAGE
1220
     $message =~ s/^[ \t\r\f]+//gm;
1221
1222
     $smtp->data($message);
1223
     $smtp->quit;
1224 8182 tao
    debug("the link is " . $link);
1225 8181 tao
    fullTemplate( ['success'] );
1226
1227 8175 tao
}
1228
1229
#
1230 8220 tao
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1231 2341 sgarg
# by the user
1232
#
1233 8220 tao
sub createItem {
1234 8180 tao
    my $dn = shift;
1235
    my $ldapUsername = shift;
1236
    my $ldapPassword = shift;
1237
    my $additions = shift;
1238
    my $temp = shift; #if it is for a temporary account.
1239
    my $allParams = shift;
1240
1241
    my @failureTemplate;
1242
    if($temp){
1243
        @failureTemplate = ['registerFailed', 'register'];
1244
    } else {
1245
        @failureTemplate = ['registerFailed'];
1246
    }
1247
    print "Content-type: text/html\n\n";
1248
    debug("the dn is " . $dn);
1249
    debug("LDAP connection to $ldapurl...");
1250
    #if main ldap server is down, a html file containing warning message will be returned
1251
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1252
    if ($ldap) {
1253
            $ldap->start_tls( verify => 'none');
1254
            debug("Attempting to bind to LDAP server with dn = $ldapUsername, pwd = $ldapPassword");
1255 8185 tao
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1256 8180 tao
            my $result = $ldap->add ( 'dn' => $dn, 'attr' => [@$additions ]);
1257
            if ($result->code()) {
1258
                fullTemplate(@failureTemplate, { stage => "register",
1259
                                                            allParams => $allParams,
1260
                                                            errorMessage => $result->error });
1261 8220 tao
                exist(0);
1262 8180 tao
                # TODO SCW was included as separate errors, test this
1263
                #$templateVars    = setVars({ stage => "register",
1264
                #                     allParams => $allParams });
1265
                #$template->process( $templates->{'register'}, $templateVars);
1266
            } else {
1267 8181 tao
                #fullTemplate( ['success'] );
1268 8180 tao
            }
1269
            $ldap->unbind;   # take down session
1270
1271
    } else {
1272
         fullTemplate(@failureTemplate, { stage => "register",
1273
                                                            allParams => $allParams,
1274
                                                            errorMessage => "The ldap server is not available now. Please try it later"});
1275
         exit(0);
1276
    }
1277
1278
}
1279
1280 2341 sgarg
1281
1282
1283
1284
1285 8185 tao
#
1286
# This subroutine will handle a email verification:
1287
# If the hash string matches the one store in the ldap, the account will be
1288
# copied from the temporary space to the permanent tree and the account in
1289
# the temporary space will be removed.
1290
sub handleEmailVerification {
1291
1292
    my $cfg = $query->param('cfg');
1293
    my $dn = $query->param('dn');
1294
    my $hash = $query->param('hash');
1295
    my $org = $query->param('o');
1296
    my $uid = $query->param('uid');
1297
1298
    my $ldapUsername;
1299
    my $ldapPassword;
1300 8211 tao
    #my $orgAuthBase;
1301
1302
    $ldapUsername = $ldapConfig->{$org}{'user'};
1303
    $ldapPassword = $ldapConfig->{$org}{'password'};
1304
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1305
1306 8185 tao
    debug("LDAP connection to $ldapurl...");
1307
1308
1309
   print "Content-type: text/html\n\n";
1310
   #if main ldap server is down, a html file containing warning message will be returned
1311
   my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1312
   if ($ldap) {
1313
        $ldap->start_tls( verify => 'none');
1314
        $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1315 8211 tao
        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.
1316 8185 tao
        my $max = $mesg->count;
1317
        debug("the count is " . $max);
1318
        if($max < 1) {
1319
            $ldap->unbind;   # take down session
1320 8216 tao
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1321 8185 tao
            #handleLDAPBindFailure($ldapurl);
1322
            exit(0);
1323
        } else {
1324
            #check if the hash string match
1325
            my $entry = $mesg->entry (0);
1326
            my $hashStrFromLdap = $entry->get_value('employeeNumber');
1327
            if( $hashStrFromLdap eq $hash) {
1328
                #my $additions = [ ];
1329
                #foreach my $attr ( $entry->attributes ) {
1330
                    #if($attr ne 'employeeNumber') {
1331
                        #$$additions[$#$additions + 1] = $attr;
1332
                        #$$additions[$#$additions + 1] = $entry->get_value( $attr );
1333
                    #}
1334
                #}
1335 8211 tao
1336
1337
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1338 8185 tao
                $mesg = $ldap->moddn(
1339
                            dn => $dn,
1340
                            deleteoldrdn => 1,
1341
                            newrdn => "uid=" . $uid,
1342 8211 tao
                            newsuperior  =>  $orgDn);
1343 8185 tao
                $ldap->unbind;   # take down session
1344 8186 tao
                if($mesg->code()) {
1345 8216 tao
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1346 8185 tao
                    exit(0);
1347
                } else {
1348 8216 tao
                    fullTemplate( ['verificationSuccess'] );
1349 8185 tao
                }
1350
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1351
            } else {
1352
                $ldap->unbind;   # take down session
1353 8216 tao
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1354 8185 tao
                exit(0);
1355
            }
1356
1357
        }
1358
    } else {
1359
        handleLDAPBindFailure($ldapurl);
1360
        exit(0);
1361
    }
1362
1363
}
1364
1365 2341 sgarg
sub handleResponseMessage {
1366
1367
  print "Content-type: text/html\n\n";
1368
  my $errorMessage = "You provided invalid input to the script. " .
1369
                     "Try again please.";
1370 4080 daigle
  fullTemplate( [], { stage => $templates->{'stage'},
1371
                      errorMessage => $errorMessage });
1372
  exit();
1373 2341 sgarg
}
1374
1375
#
1376
# perform a simple search against the LDAP database using
1377
# a small subset of attributes of each dn and return it
1378
# as a table to the calling browser.
1379
#
1380
sub handleSimpleSearch {
1381
1382
    my $o = $query->param('o');
1383
1384 4080 daigle
    my $ldapurl = $ldapConfig->{$o}{'url'};
1385
    my $searchBase = $ldapConfig->{$o}{'base'};
1386 2341 sgarg
1387
    print "Content-type: text/html\n\n";
1388
1389
    my $allParams = {
1390
                      'cn' => $query->param('cn'),
1391
                      'sn' => $query->param('sn'),
1392
                      'gn' => $query->param('gn'),
1393
                      'o'  => $query->param('o'),
1394
                      'facsimiletelephonenumber'
1395
                      => $query->param('facsimiletelephonenumber'),
1396
                      'mail' => $query->param('cmail'),
1397
                      'telephonenumber' => $query->param('telephonenumber'),
1398
                      'title' => $query->param('title'),
1399
                      'uid' => $query->param('uid'),
1400
                      'ou' => $query->param('ou'),
1401
                    };
1402
1403
    # Search LDAP for matching entries that already exist
1404
    my $filter = "(" .
1405
                 $query->param('searchField') . "=" .
1406
                 "*" .
1407
                 $query->param('searchValue') .
1408
                 "*" .
1409
                 ")";
1410
1411
    my @attrs = [ 'sn',
1412
                  'gn',
1413
                  'cn',
1414
                  'o',
1415
                  'facsimiletelephonenumber',
1416
                  'mail',
1417
                  'telephoneNumber',
1418
                  'title',
1419
                  'uid',
1420
                  'labeledURI',
1421
                  'ou' ];
1422
1423
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
1424
1425
    # Send back the search results
1426
    if ($found) {
1427 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
1428
                                         allParams => $allParams,
1429
                                         foundAccounts => $found });
1430 2341 sgarg
    } else {
1431
      $found = "No entries matched your criteria.  Please try again\n";
1432
1433 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
1434
                                         allParams => $allParams,
1435
                                         foundAccounts => $found });
1436 2341 sgarg
    }
1437
1438
    exit();
1439
}
1440
1441
#
1442
# search the LDAP directory to see if a similar account already exists
1443
#
1444
sub searchDirectory {
1445
    my $ldapurl = shift;
1446
    my $base = shift;
1447
    my $filter = shift;
1448
    my $attref = shift;
1449
1450 4849 daigle
	my $mesg;
1451 2341 sgarg
    my $foundAccounts = 0;
1452 3177 tao
1453
    #if ldap server is down, a html file containing warning message will be returned
1454 4771 walbridge
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1455 3177 tao
1456 4849 daigle
    if ($ldap) {
1457
    	$ldap->start_tls( verify => 'none');
1458
    	$ldap->bind( version => 3, anonymous => 1);
1459
    	my $mesg = $ldap->search (
1460
        	base   => $base,
1461
        	filter => $filter,
1462
        	attrs => @$attref,
1463
    	);
1464 2341 sgarg
1465 4849 daigle
    	if ($mesg->count() > 0) {
1466
        	$foundAccounts = "";
1467
        	my $entry;
1468
        	foreach $entry ($mesg->sorted(['sn'])) {
1469
          		$foundAccounts .= "<tr>\n<td class=\"main\">\n";
1470
          		$foundAccounts .= "<a href=\"" unless
1471 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1472 4849 daigle
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1473 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1474 4849 daigle
          		$foundAccounts .= "\">\n" unless
1475 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1476 4849 daigle
          		$foundAccounts .= $entry->get_value('givenName');
1477
          		$foundAccounts .= "</a>\n" unless
1478 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1479 4849 daigle
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1480
          		$foundAccounts .= "<a href=\"" unless
1481 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1482 4849 daigle
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1483 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1484 4849 daigle
          		$foundAccounts .= "\">\n" unless
1485 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1486 4849 daigle
          		$foundAccounts .= $entry->get_value('sn');
1487
          		$foundAccounts .= "</a>\n";
1488
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1489
          		$foundAccounts .= $entry->get_value('mail');
1490
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1491
          		$foundAccounts .= $entry->get_value('telephonenumber');
1492
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1493
          		$foundAccounts .= $entry->get_value('title');
1494
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1495
          		$foundAccounts .= $entry->get_value('ou');
1496
          		$foundAccounts .= "\n</td>\n";
1497
          		$foundAccounts .= "</tr>\n";
1498
        	}
1499
    	}
1500
    	$ldap->unbind;   # take down session
1501 2341 sgarg
    }
1502
    return $foundAccounts;
1503
}
1504
1505
sub debug {
1506
    my $msg = shift;
1507
1508
    if ($debug) {
1509 4747 walbridge
        print STDERR "LDAPweb: $msg\n";
1510 2341 sgarg
    }
1511
}
1512 3175 tao
1513 4771 walbridge
sub handleLDAPBindFailure {
1514
    my $ldapAttemptUrl = shift;
1515
    my $primaryLdap =  $properties->getProperty('auth.url');
1516
1517
    if ($ldapAttemptUrl eq  $primaryLdap) {
1518
        handleGeneralServerFailure("The main LDAP server $ldapurl is down!");
1519
    } else {
1520
        debug("attempted to bind to nonresponsive LDAP server $ldapAttemptUrl, skipped.");
1521
    }
1522
}
1523
1524 3177 tao
sub handleGeneralServerFailure {
1525
    my $errorMessage = shift;
1526 4728 walbridge
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1527 3175 tao
    exit(0);
1528
   }
1529
1530 4080 daigle
sub setVars {
1531
    my $paramVars = shift;
1532
    # initialize default parameters
1533
    my $templateVars = { cfg => $cfg,
1534 4394 walbridge
                         styleSkinsPath => $contextUrl . "/style/skins",
1535
                         styleCommonPath => $contextUrl . "/style/common",
1536
                         contextUrl => $contextUrl,
1537 4770 daigle
                         cgiPrefix => $cgiPrefix,
1538 8206 tao
                         orgList => \@validDisplayOrgList,
1539 4394 walbridge
                         config  => $config,
1540 4080 daigle
    };
1541
1542
    # append customized params
1543
    while (my ($k, $v) = each (%$paramVars)) {
1544
        $templateVars->{$k} = $v;
1545
    }
1546
1547
    return $templateVars;
1548
}