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