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