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 8356 leinfelder
    my $filter = "(&(objectClass=inetOrgPerson)(createTimestamp<=" . $expirationDate . "))";
339
    debug("Clearing expired accounts with filter: " . $filter . ", base: " . $tmpSearchBase);
340 8351 leinfelder
    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 8356 leinfelder
    debug("clearTemporaryAccounts: connecting to $ldapurl, $timeout");
349 8351 leinfelder
    $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 8356 leinfelder
			base   => $tmpSearchBase,
355 8351 leinfelder
			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("DRY RUN: Removing expired account: " . $dn);
364
            	#$ldap->delete($dn);
365
			}
366
        }
367
    	$ldap->unbind;   # take down session
368
    }
369
370 8354 leinfelder
    return 0;
371 8351 leinfelder
}
372
373 4728 walbridge
sub fullTemplate {
374
    my $templateList = shift;
375
    my $templateVars = setVars(shift);
376 8166 tao
    my $c = Captcha::reCAPTCHA->new;
377
    my $captcha = 'captcha';
378
    #my $error=null;
379
    my $use_ssl= 1;
380
    #my $options=null;
381 8250 leinfelder
    # 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 4728 walbridge
    $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 8221 tao
392 8229 tao
#
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 8221 tao
403 2341 sgarg
#
404 8221 tao
# 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 8229 tao
sub handleSearchNameByEmail{
408 8221 tao
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 8229 tao
        fullTemplate(['lookupName'], { allParams => $allParams,
417 8221 tao
                                     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 8254 leinfelder
    if ($found) {
430 8221 tao
        $accountInfo = $found;
431
    } else {
432 8254 leinfelder
        $accountInfo = "There are no accounts associated with the email " . $mail . ".\n";
433 8221 tao
    }
434 8254 leinfelder
435 8221 tao
    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 8229 tao
                                                  fullTemplate( ['lookupName'], {allParams => $allParams,
443
                                                                errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " .
444
                                                                $skinProperties->getProperty("email.recipient") . "." });
445 8221 tao
                                                  exit(0);
446
                                               };
447
    $smtp->mail($sender);
448
    $smtp->to($recipient);
449
450
    my $message = <<"     ENDOFMESSAGE";
451
    To: $recipient
452
    From: $sender
453 8234 tao
    Subject: Your Account Information
454 8221 tao
455 8234 tao
    Somebody (hopefully you) looked up the account information associated with the email address.
456
    Here is the account information:
457 8221 tao
458
    $accountInfo
459
460
    Thanks,
461 8234 tao
        $sender
462 8221 tao
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 2341 sgarg
# 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 4080 daigle
  fullTemplate(['register'], {stage => "register"});
481 2341 sgarg
  exit();
482
}
483
484 8221 tao
485
486 2341 sgarg
#
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 8258 tao
    #print "Content-type: text/html\n\n";
493 8220 tao
    if ($query->param('o') =~ "LTER") {
494 8258 tao
      print "Content-type: text/html\n\n";
495 8220 tao
      fullTemplate( ['registerLter'] );
496
      exit(0);
497
    }
498 8166 tao
499 2341 sgarg
    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 8166 tao
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 8169 tao
        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},
516 8166 tao
        $challenge, $response
517
    );
518
519
    if ( $result->{is_valid} ) {
520
        #print "Yes!";
521
        #exit();
522
    }
523
    else {
524 8258 tao
        print "Content-type: text/html\n\n";
525 8166 tao
        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 2341 sgarg
    # 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 8258 tao
        print "Content-type: text/html\n\n";
538 2341 sgarg
        my $errorMessage = "Required information is missing. " .
539
            "Please fill in all required fields and resubmit the form.";
540 4080 daigle
        fullTemplate(['register'], { stage => "register",
541
                                     allParams => $allParams,
542
                                     errorMessage => $errorMessage });
543
        exit();
544 2341 sgarg
    } else {
545 8186 tao
         if ($query->param('userPassword') ne $query->param('userPassword2')) {
546 8258 tao
            print "Content-type: text/html\n\n";
547 8186 tao
            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 2972 jones
        my $o = $query->param('o');
554 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
555 2341 sgarg
    }
556 8351 leinfelder
557
    # Remove any expired temporary accounts for this subtree before continuing
558
    clearTemporaryAccounts();
559 2341 sgarg
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 8217 tao
    my @attrs = [ 'uid', 'o', 'ou', 'cn', 'mail', 'telephoneNumber', 'title' ];
582 2341 sgarg
    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 8261 tao
      print "Content-type: text/html\n\n";
587 4080 daigle
      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",
588
                                                     allParams => $allParams,
589
                                                     foundAccounts => $found });
590 2341 sgarg
    # Otherwise, create a new user in the LDAP directory
591
    } else {
592 8180 tao
        createTemporaryAccount($allParams);
593 2341 sgarg
    }
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 8207 tao
                      'o' => $query->param('o'),
608 2341 sgarg
                      '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 8258 tao
    #print "Content-type: text/html\n\n";
615 8180 tao
    createTemporaryAccount($allParams);
616 2341 sgarg
    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 2972 jones
        my $o = $query->param('o');
633
634 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
635 2341 sgarg
    }
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 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
645
                                        allParams => $allParams,
646
                                        errorMessage => $errorMessage });
647
        exit();
648 2341 sgarg
    }
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 2972 jones
        my $o = $query->param('o');
654 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
655
        $ldapUsername = $ldapConfig->{$o}{'user'};
656
        $ldapPassword = $ldapConfig->{$o}{'password'};
657 2341 sgarg
658 4080 daigle
        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;
659 2341 sgarg
        if ($query->param('o') =~ "LTER") {
660 4080 daigle
            fullTemplate( ['registerLter'] );
661 2341 sgarg
        } else {
662
            my $errorMessage = changePassword(
663
                    $dn, $query->param('userPassword'),
664
                    $dn, $query->param('oldpass'), $query->param('o'));
665 2972 jones
            if ($errorMessage) {
666 4080 daigle
                fullTemplate( ['changePass'], { stage => "changepass",
667
                                                allParams => $allParams,
668
                                                errorMessage => $errorMessage });
669
                exit();
670 2341 sgarg
            } else {
671 4080 daigle
                fullTemplate( ['changePassSuccess'], { stage => "changepass",
672
                                                       allParams => $allParams });
673
                exit();
674 2341 sgarg
            }
675
        }
676
    } else {
677
        my $errorMessage = "The passwords do not match. Try again.";
678 4080 daigle
        fullTemplate( ['changePass'], { stage => "changepass",
679
                                        allParams => $allParams,
680
                                        errorMessage => $errorMessage });
681
        exit();
682 2341 sgarg
    }
683
}
684
685
#
686 2414 sgarg
# 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 4080 daigle
    fullTemplate( ['changePass'], { stage => "changepass",
695
                                    errorMessage => $errorMessage });
696
    exit();
697 2414 sgarg
}
698
699
#
700 2341 sgarg
# 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 2972 jones
        my $o = $query->param('o');
713
714 4080 daigle
        $searchBase = $ldapConfig->{$o}{'base'};
715 4868 walbridge
        $ldapUsername = $ldapConfig->{$o}{'user'};
716 4080 daigle
        $ldapPassword = $ldapConfig->{$o}{'password'};
717 2341 sgarg
    }
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 4080 daigle
        fullTemplate( ['resetPass'],  { stage => "resetpass",
725
                                        allParams => $allParams,
726
                                        errorMessage => $errorMessage });
727
        exit();
728 2341 sgarg
    }
729
730
    # We have all of the info we need, so try to change the password
731
    my $o = $query->param('o');
732 4080 daigle
    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};
733 4866 walbridge
    debug("handleResetPassword: dn: $dn");
734 2341 sgarg
    if ($query->param('o') =~ "LTER") {
735 4080 daigle
        fullTemplate( ['registerLter'] );
736
        exit();
737 2341 sgarg
    } 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 4080 daigle
            $errorMessage = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));
748 2341 sgarg
        } else {
749
            $errorMessage = "User not found in database.  Please try again.";
750
        }
751
752
        if ($errorMessage) {
753 4080 daigle
            fullTemplate( ['resetPass'], { stage => "resetpass",
754
                                           allParams => $allParams,
755
                                           errorMessage => $errorMessage });
756
            exit();
757 2341 sgarg
        } else {
758
            my $errorMessage = sendPasswordNotification($query->param('uid'),
759 2972 jones
                    $query->param('o'), $userPass, $recipient, $cfg);
760 4080 daigle
            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",
761
                                                  allParams => $allParams,
762
                                                  errorMessage => $errorMessage });
763
            exit();
764 2341 sgarg
        }
765
    }
766
}
767
768
#
769 2414 sgarg
# 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 4080 daigle
    fullTemplate( ['resetPass'], { stage => "resetpass",
776
                                   errorMessage => $errorMessage });
777
    exit();
778 2414 sgarg
}
779
780
#
781 2341 sgarg
# 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 4080 daigle
    my $searchBase = $ldapConfig->{$o}{'base'};
806 4868 walbridge
807 2341 sgarg
    my $errorMessage = 0;
808 3177 tao
    my $ldap;
809 4868 walbridge
810 4771 walbridge
    #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 4394 walbridge
813 4849 daigle
    if ($ldap) {
814 4868 walbridge
        #$ldap->start_tls( verify => 'require',
815 2972 jones
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
816 4868 walbridge
        $ldap->start_tls( verify => 'none');
817
        debug("changePassword: attempting to bind to $bindDN");
818
        my $bindresult = $ldap->bind( version => 3, dn => $bindDN,
819 2341 sgarg
                                  password => $bindPass );
820 4868 walbridge
        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 2341 sgarg
826 4849 daigle
    	# Find the user here and change their entry
827
    	my $newpass = createSeededPassHash($userPass);
828
    	my $modifications = { userPassword => $newpass };
829 4868 walbridge
      debug("changePass: setting password for $userDN to $newpass");
830 4849 daigle
    	my $result = $ldap->modify( $userDN, replace => { %$modifications });
831 2341 sgarg
832 4849 daigle
    	if ($result->code()) {
833 4866 walbridge
            debug("changePass: error changing password: " . $result->error);
834
        	$errorMessage = "There was an error changing the password:" .
835 2341 sgarg
                           "<br />\n" . $result->error;
836 4849 daigle
    	}
837
    	$ldap->unbind;   # take down session
838
    }
839 2341 sgarg
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 3177 tao
    my $ldap;
874 4749 walbridge
    debug("ldap server: $ldapurl");
875 4394 walbridge
876
    #if main ldap server is down, a html file containing warning message will be returned
877 4771 walbridge
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
878 4849 daigle
879
    if ($ldap) {
880
    	$ldap->start_tls( verify => 'none');
881
    	my $bindresult = $ldap->bind;
882
    	if ($bindresult->code) {
883
        	return $entry;
884
    	}
885 2341 sgarg
886 4849 daigle
    	if($ldapConfig->{$org}{'filter'}){
887 4865 walbridge
            debug("getLdapEntry: filter set, searching for base=$base, " .
888
                  "(&(uid=$username)($ldapConfig->{$org}{'filter'})");
889 4849 daigle
        	$mesg = $ldap->search ( base   => $base,
890 4080 daigle
                filter => "(&(uid=$username)($ldapConfig->{$org}{'filter'}))");
891 4849 daigle
    	} else {
892 4865 walbridge
            debug("getLdapEntry: no filter, searching for $base, (uid=$username)");
893 4849 daigle
        	$mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
894
    	}
895 3177 tao
896 4849 daigle
    	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 4865 walbridge
                    debug("getLdapEntry: recursion found $host, $path, $username, $org");
911 4849 daigle
                	return $entry;
912
            	}
913
        	}
914
    	}
915 2341 sgarg
    }
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 2972 jones
    my $cfg = shift;
928 2341 sgarg
929
    my $errorMessage = "";
930
    if ($recipient) {
931 8254 leinfelder
932 4771 walbridge
        my $mailhost = $properties->getProperty('email.mailhost');
933 8197 tao
        my $sender;
934
        $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
935 2341 sgarg
        # 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 8234 tao
        Subject: Your Account Password Reset
944 2341 sgarg
945 8234 tao
        Somebody (hopefully you) requested that your account password be reset.
946 8259 leinfelder
        Your temporary password is below. Please change it as soon as possible
947
        at: $contextUrl.
948 2341 sgarg
949
            Username: $username
950
        Organization: $org
951
        New Password: $newPass
952
953
        Thanks,
954 8234 tao
            $sender
955 2341 sgarg
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 8221 tao
    my $notHtmlFormat = shift;
977 3175 tao
    my $ldap;
978 4847 daigle
    my $mesg;
979 2341 sgarg
980
    my $foundAccounts = 0;
981 4749 walbridge
982 4394 walbridge
    #if main ldap server is down, a html file containing warning message will be returned
983 4868 walbridge
    debug("findExistingAccounts: connecting to $ldapurl, $timeout");
984 4771 walbridge
    $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
985 4845 daigle
    if ($ldap) {
986
    	$ldap->start_tls( verify => 'none');
987
    	$ldap->bind( version => 3, anonymous => 1);
988 4848 daigle
		$mesg = $ldap->search (
989 4845 daigle
			base   => $base,
990
			filter => $filter,
991
			attrs => @$attref,
992
		);
993 2341 sgarg
994 4845 daigle
	    if ($mesg->count() > 0) {
995
			$foundAccounts = "";
996
			my $entry;
997
			foreach $entry ($mesg->all_entries) {
998 5650 walbridge
                # 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 8217 tao
                #if ($entry->dn !~ /ou=Account/) {
1001 8221 tao
                    if($notHtmlFormat) {
1002
                        $foundAccounts .= "\nAccount: ";
1003
                    } else {
1004
                        $foundAccounts .= "<p>\n<b><u>Account:</u> ";
1005
                    }
1006 5650 walbridge
                    $foundAccounts .= $entry->dn();
1007 8221 tao
                    if($notHtmlFormat) {
1008
                        $foundAccounts .= "\n";
1009
                    } else {
1010
                        $foundAccounts .= "</b><br />\n";
1011
                    }
1012 5650 walbridge
                    foreach my $attribute ($entry->attributes()) {
1013
                        my $value = $entry->get_value($attribute);
1014
                        $foundAccounts .= "$attribute: ";
1015
                        $foundAccounts .= $value;
1016 8221 tao
                         if($notHtmlFormat) {
1017
                            $foundAccounts .= "\n";
1018
                        } else {
1019
                            $foundAccounts .= "<br />\n";
1020
                        }
1021 5650 walbridge
                    }
1022 8221 tao
                    if($notHtmlFormat) {
1023
                        $foundAccounts .= "\n";
1024
                    } else {
1025
                        $foundAccounts .= "</p>\n";
1026
                    }
1027
1028 8217 tao
                #}
1029 4845 daigle
			}
1030 2341 sgarg
        }
1031 4845 daigle
    	$ldap->unbind;   # take down session
1032 2341 sgarg
1033 4848 daigle
    	# 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 8254 leinfelder
        	my $refFound = &findExistingAccounts($host, $path, $filter, $attref, $notHtmlFormat);
1041 4848 daigle
        	if ($refFound) {
1042
            	$foundAccounts .= $refFound;
1043
        	}
1044
    	}
1045 2341 sgarg
    }
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 8175 tao
# 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 8180 tao
    my $org = $query->param('o');
1082 8220 tao
    my $ldapUsername = $ldapConfig->{$org}{'user'};
1083
    my $ldapPassword = $ldapConfig->{$org}{'password'};
1084
    my $tmp = 1;
1085 8185 tao
1086 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
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 8175 tao
1104 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
1105 8201 tao
    my $filter = $ldapConfig->{$org}{'filter'};
1106 8220 tao
1107 8176 tao
    debug("search filer " . $filter);
1108
    debug("ldap server ". $ldapurl);
1109
    debug("sesarch base " . $tmpSearchBase);
1110 8262 tao
    #print "Content-type: text/html\n\n";
1111 8175 tao
    my @attrs = ['o', 'ou' ];
1112
    my $found = searchDirectory($ldapurl, $tmpSearchBase, $filter, \@attrs);
1113 8220 tao
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 8180 tao
1118 8176 tao
    if(!$found) {
1119 8180 tao
        debug("generate the subtree in the dc=tmp===========================");
1120 8176 tao
        #need to generate the subtree o or ou
1121 8220 tao
        my $additions;
1122 8207 tao
            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 8220 tao
        my $dn=$ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1136
        createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1137 8176 tao
    }
1138 8175 tao
1139 8180 tao
    ################create an account under tmp subtree
1140 8176 tao
1141 8180 tao
    #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 8201 tao
                                'inetOrgPerson', 'uidObject' ],
1156
                $organization   => $organizationName
1157 8180 tao
                ];
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 8201 tao
1171
1172
    #$$additions[$#$additions + 1] = 'o';
1173
    #$$additions[$#$additions + 1] = $org;
1174
    my $dn='uid=' . $query->param('uid') . ',' . $ldapConfig->{$org}{'org'} . ',' . $tmpSearchBase;
1175 8220 tao
    createItem($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1176 8176 tao
1177 8180 tao
1178
    ####################send the verification email to the user
1179 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.
1180 8180 tao
1181 8253 leinfelder
    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 8181 tao
    my $mailhost = $properties->getProperty('email.mailhost');
1191 8197 tao
    my $sender;
1192
    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');
1193
    debug("the sender is " . $sender);
1194 8181 tao
    my $recipient = $query->param('mail');
1195
    # Send the email message to them
1196 8191 tao
    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 8181 tao
    $smtp->mail($sender);
1202
    $smtp->to($recipient);
1203
1204
    my $message = <<"     ENDOFMESSAGE";
1205
    To: $recipient
1206
    From: $sender
1207 8239 leinfelder
    Subject: New Account Activation
1208 8181 tao
1209 8254 leinfelder
    Somebody (hopefully you) registered an account on $contextUrl.
1210 8181 tao
    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 8234 tao
        $sender
1217 8181 tao
1218
     ENDOFMESSAGE
1219
     $message =~ s/^[ \t\r\f]+//gm;
1220
1221
     $smtp->data($message);
1222
     $smtp->quit;
1223 8182 tao
    debug("the link is " . $link);
1224 8181 tao
    fullTemplate( ['success'] );
1225
1226 8175 tao
}
1227
1228
#
1229 8220 tao
# Bind to LDAP and create a new item (a user or subtree) using the information provided
1230 2341 sgarg
# by the user
1231
#
1232 8220 tao
sub createItem {
1233 8180 tao
    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 8185 tao
            $ldap->bind( version => 3, dn => $ldapUsername, password => $ldapPassword );
1255 8180 tao
            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 8220 tao
                exist(0);
1261 8180 tao
                # 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 8181 tao
                #fullTemplate( ['success'] );
1267 8180 tao
            }
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 2341 sgarg
1280
1281
1282
1283
1284 8185 tao
#
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 8211 tao
    #my $orgAuthBase;
1300
1301
    $ldapUsername = $ldapConfig->{$org}{'user'};
1302
    $ldapPassword = $ldapConfig->{$org}{'password'};
1303
    #$orgAuthBase = $ldapConfig->{$org}{'base'};
1304
1305 8185 tao
    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 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.
1315 8185 tao
        my $max = $mesg->count;
1316
        debug("the count is " . $max);
1317
        if($max < 1) {
1318
            $ldap->unbind;   # take down session
1319 8216 tao
            fullTemplate( ['verificationFailed'], {errorMessage => "No record matched the dn " . $dn . " for the activation. You probably already activated the account."});
1320 8185 tao
            #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 8211 tao
1335
1336
                my $orgDn = $ldapConfig->{$org}{'dn'}; #the DN for the organization.
1337 8185 tao
                $mesg = $ldap->moddn(
1338
                            dn => $dn,
1339
                            deleteoldrdn => 1,
1340
                            newrdn => "uid=" . $uid,
1341 8211 tao
                            newsuperior  =>  $orgDn);
1342 8185 tao
                $ldap->unbind;   # take down session
1343 8186 tao
                if($mesg->code()) {
1344 8216 tao
                    fullTemplate( ['verificationFailed'], {errorMessage => "Cannot move the account from the inactive area to the ative area since " . $mesg->error()});
1345 8185 tao
                    exit(0);
1346
                } else {
1347 8216 tao
                    fullTemplate( ['verificationSuccess'] );
1348 8185 tao
                }
1349
                #createAccount2($dn, $ldapUsername, $ldapPassword, $additions, $tmp, $allParams);
1350
            } else {
1351
                $ldap->unbind;   # take down session
1352 8216 tao
                fullTemplate( ['verificationFailed'], {errorMessage => "The hash string " . $hash . " from your link doesn't match our record."});
1353 8185 tao
                exit(0);
1354
            }
1355
1356
        }
1357
    } else {
1358
        handleLDAPBindFailure($ldapurl);
1359
        exit(0);
1360
    }
1361
1362
}
1363
1364 2341 sgarg
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 4080 daigle
  fullTemplate( [], { stage => $templates->{'stage'},
1370
                      errorMessage => $errorMessage });
1371
  exit();
1372 2341 sgarg
}
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 4080 daigle
    my $ldapurl = $ldapConfig->{$o}{'url'};
1384
    my $searchBase = $ldapConfig->{$o}{'base'};
1385 2341 sgarg
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 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
1427
                                         allParams => $allParams,
1428
                                         foundAccounts => $found });
1429 2341 sgarg
    } else {
1430
      $found = "No entries matched your criteria.  Please try again\n";
1431
1432 4080 daigle
      fullTemplate( ('searchResults'), { stage => "searchresults",
1433
                                         allParams => $allParams,
1434
                                         foundAccounts => $found });
1435 2341 sgarg
    }
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 4849 daigle
	my $mesg;
1450 2341 sgarg
    my $foundAccounts = 0;
1451 3177 tao
1452
    #if ldap server is down, a html file containing warning message will be returned
1453 4771 walbridge
    my $ldap = Net::LDAP->new($ldapurl, timeout => $timeout) or handleLDAPBindFailure($ldapurl);
1454 3177 tao
1455 4849 daigle
    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 2341 sgarg
1464 4849 daigle
    	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 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1471 4849 daigle
         		 $foundAccounts .= $entry->get_value('labeledURI') unless
1472 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1473 4849 daigle
          		$foundAccounts .= "\">\n" unless
1474 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1475 4849 daigle
          		$foundAccounts .= $entry->get_value('givenName');
1476
          		$foundAccounts .= "</a>\n" unless
1477 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1478 4849 daigle
          		$foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1479
          		$foundAccounts .= "<a href=\"" unless
1480 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1481 4849 daigle
          		$foundAccounts .= $entry->get_value('labeledURI') unless
1482 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1483 4849 daigle
          		$foundAccounts .= "\">\n" unless
1484 2341 sgarg
                    (!$entry->get_value('labeledURI'));
1485 4849 daigle
          		$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 2341 sgarg
    }
1501
    return $foundAccounts;
1502
}
1503
1504
sub debug {
1505
    my $msg = shift;
1506
1507
    if ($debug) {
1508 4747 walbridge
        print STDERR "LDAPweb: $msg\n";
1509 2341 sgarg
    }
1510
}
1511 3175 tao
1512 4771 walbridge
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 3177 tao
sub handleGeneralServerFailure {
1524
    my $errorMessage = shift;
1525 4728 walbridge
    fullTemplate( ['mainServerFailure'], { errorMessage => $errorMessage });
1526 3175 tao
    exit(0);
1527
   }
1528
1529 4080 daigle
sub setVars {
1530
    my $paramVars = shift;
1531
    # initialize default parameters
1532
    my $templateVars = { cfg => $cfg,
1533 4394 walbridge
                         styleSkinsPath => $contextUrl . "/style/skins",
1534
                         styleCommonPath => $contextUrl . "/style/common",
1535
                         contextUrl => $contextUrl,
1536 4770 daigle
                         cgiPrefix => $cgiPrefix,
1537 8206 tao
                         orgList => \@validDisplayOrgList,
1538 4394 walbridge
                         config  => $config,
1539 4080 daigle
    };
1540
1541
    # append customized params
1542
    while (my ($k, $v) = each (%$paramVars)) {
1543
        $templateVars->{$k} = $v;
1544
    }
1545
1546
    return $templateVars;
1547
}