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