Project

General

Profile

1 2341 sgarg
#!/usr/bin/perl -w
2
 #
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
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
#
30
use strict;       # turn on strict syntax checking.
31
use Template;     # load the template-toolkit module.
32
use CGI;          # load the CGI module.
33
use Net::LDAP;    # load the LDAP net libraries
34
use Net::SMTP;    # load the SMTP net libraries
35
use Digest::SHA1; # for creating the password hash
36
use MIME::Base64; # for creating the password hash
37
use URI;          # for parsing URL syntax
38
use AppConfig qw(:expand :argcount);
39
40
# Set up our default configuration
41
my $ldapurl = "@ldapurl@";
42 3175 tao
my $mainldapurl = "@ldapurl@";
43 2341 sgarg
my $root = "@user@";
44
my $rootpw = "@password@";
45
my $searchBase = "@ldapSearchBase@";
46
my $templatesDir = "@templates.dir@";
47
my $mailhost = "@mailhost@";
48
my $sender = "@sender@";
49 3175 tao
my $TIMEOUT = 20;
50 3177 tao
my $mainldapdownmessage = "The main ldap server " . $mainldapurl . " is down!";
51 2341 sgarg
52 4010 tao
# 1.8.1 temporary baseUrl fix
53
my $baseUrl = "@systemidserver@@servlet-path@";
54
$baseUrl =~ s/metacat$//;
55
56 2341 sgarg
# Get the CGI input variables
57
my $query = new CGI;
58
59
my $debug = 0;
60
61
#--------------------------------------------------------------------------80c->
62
# Set up the Template Toolkit to read html form templates
63
64
65
# set some configuration options for the template object
66
my $config_templates = {
67
             INCLUDE_PATH => $templatesDir,
68
             INTERPOLATE  => 0,
69
             POST_CHOMP   => 1,
70
             };
71
72
# create an instance of the template
73 3177 tao
my $template = Template->new($config_templates) || handleGeneralServerFailure($Template::ERROR);
74 2341 sgarg
75
# Read the ldapweb.cfg file
76
my $config = AppConfig->new({
77
    GLOBAL => { ARGCOUNT => ARGCOUNT_ONE, } });
78
79
$config->define("ldapurl", { ARGCOUNT => ARGCOUNT_HASH} );
80
$config->define("ldapsearchbase", { ARGCOUNT => ARGCOUNT_HASH} );
81
$config->define("dn", { ARGCOUNT => ARGCOUNT_HASH} );
82
$config->define("filter", { ARGCOUNT => ARGCOUNT_HASH} );
83
$config->define("user", { ARGCOUNT => ARGCOUNT_HASH} );
84
$config->define("password", { ARGCOUNT => ARGCOUNT_HASH} );
85
86
my $cfgfile = "ldapweb.cfg";
87
$config->file($cfgfile);
88
my $config_ldapurl = $config->get('ldapurl');
89
my $config_ldapsearchbase = $config->get('ldapsearchbase');
90
my $config_dn = $config->get('dn');
91
my $config_filter = $config->get('filter');
92
my $config_user = $config->get('user');
93
my $config_password = $config->get('password');
94
95
my @orglist;
96
foreach my $neworg (keys %$config_dn) {
97
    push(@orglist, $neworg);
98
    debug($neworg);
99
}
100
101
102
#--------------------------------------------------------------------------80c->
103
# Define the main program logic that calls subroutines to do the work
104
#--------------------------------------------------------------------------80c->
105
106
107
# The processing step we are handling
108
my $stage = $query->param('stage') || '@defaultStage@';
109
110
my $cfg = $query->param('cfg');
111
112 4010 tao
# 1.8.1 temporary header/footer fixder =
113
114
my $header = ($cfg eq 'nceas') ? 'nceasHeader.tmpl' : '@defaultHeader@';
115
my $footer = ($cfg eq 'nceas') ? 'nceasFooter.tmpl' : '@defaultFooter@';
116
117 2341 sgarg
# define the possible stages
118
my %stages = (
119
              'initregister'      => \&handleInitRegister,
120
              'register'          => \&handleRegister,
121
              'registerconfirmed' => \&handleRegisterConfirmed,
122
              'simplesearch'      => \&handleSimpleSearch,
123
              'initaddentry'      => \&handleInitAddEntry,
124
              'addentry'          => \&handleAddEntry,
125
              'initmodifyentry'   => \&handleInitModifyEntry,
126
              'modifyentry'       => \&handleModifyEntry,
127 2972 jones
              'changepass'        => \&handleChangePassword,
128
              'initchangepass'    => \&handleInitialChangePassword,
129 2341 sgarg
              'resetpass'         => \&handleResetPassword,
130 2414 sgarg
              'initresetpass'     => \&handleInitialResetPassword,
131 2341 sgarg
             );
132
# call the appropriate routine based on the stage
133
if ( $stages{$stage} ) {
134
  $stages{$stage}->();
135
} else {
136
  &handleResponseMessage();
137
}
138
139
#--------------------------------------------------------------------------80c->
140
# Define the subroutines to do the work
141
#--------------------------------------------------------------------------80c->
142
143
144
#
145
# create the initial registration form
146
#
147
sub handleInitRegister {
148
  my $vars = shift;
149
150
  print "Content-type: text/html\n\n";
151
  # process the template files:
152
  my $templateVars = { stage => "register", cfg => $cfg };
153 2857 sgarg
  #$$templateVars{'orgList'} = \@orglist;
154 2341 sgarg
  $$templateVars{'orgList'} = \@orglist;
155 4010 tao
  $$templateVars{'baseUrl'} = $baseUrl;
156
  $template->process( $header, $templateVars);
157 2341 sgarg
  $template->process( "@register@", $templateVars);
158 4010 tao
  $template->process( $footer, $templateVars);
159 2341 sgarg
160
  exit();
161
}
162
163
#
164
# process input from the register stage, which occurs when
165
# a user submits form data to create a new account
166
#
167
sub handleRegister {
168
169
    print "Content-type: text/html\n\n";
170
171
    my $allParams = { 'givenName' => $query->param('givenName'),
172
                      'sn' => $query->param('sn'),
173
                      'o' => $query->param('o'),
174
                      'mail' => $query->param('mail'),
175
                      'uid' => $query->param('uid'),
176
                      'userPassword' => $query->param('userPassword'),
177
                      'userPassword2' => $query->param('userPassword2'),
178
                      'title' => $query->param('title'),
179
                      'telephoneNumber' => $query->param('telephoneNumber') };
180
    # Check that all required fields are provided and not null
181
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail',
182
                           'uid', 'userPassword', 'userPassword2');
183
    if (! paramsAreValid(@requiredParams)) {
184
        my $errorMessage = "Required information is missing. " .
185
            "Please fill in all required fields and resubmit the form.";
186
        my $templateVars = { stage => "register",
187
                             cfg => $cfg,
188
                             allParams => $allParams,
189
                             errorMessage => $errorMessage };
190 2972 jones
        $$templateVars{'orgList'} = \@orglist;
191 4010 tao
        $$templateVars{'baseUrl'} = $baseUrl;
192
        $template->process( $header, $templateVars);
193 2341 sgarg
        $template->process( "@register@", $templateVars);
194 4010 tao
        $template->process( $footer, $templateVars);
195 2341 sgarg
        exit(0);
196
    } else {
197 2972 jones
        my $o = $query->param('o');
198
        $ldapurl = $config_ldapurl->{$o};
199
        $searchBase = $config_ldapsearchbase->{$o};
200 2341 sgarg
    }
201
202
    # Search LDAP for matching entries that already exist
203
    # Some forms use a single text search box, whereas others search per
204
    # attribute.
205
    my $filter;
206
    if ($query->param('searchField')) {
207
208
      $filter = "(|" .
209
                "(uid=" . $query->param('searchField') . ") " .
210
                "(mail=" . $query->param('searchField') . ")" .
211
                "(&(sn=" . $query->param('searchField') . ") " .
212
                "(givenName=" . $query->param('searchField') . "))" .
213
                ")";
214
    } else {
215
      $filter = "(|" .
216
                "(uid=" . $query->param('uid') . ") " .
217
                "(mail=" . $query->param('mail') . ")" .
218
                "(&(sn=" . $query->param('sn') . ") " .
219
                "(givenName=" . $query->param('givenName') . "))" .
220
                ")";
221
    }
222
223
    my @attrs = [ 'uid', 'o', 'cn', 'mail', 'telephoneNumber', 'title' ];
224
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
225
226
    # If entries match, send back a request to confirm new-user creation
227
    if ($found) {
228
      my $templateVars = { stage => "registerconfirmed",
229
                           cfg => $cfg,
230
                           allParams => $allParams,
231
                           foundAccounts => $found };
232
      $$templateVars{'orgList'} = \@orglist;
233 4010 tao
      $$templateVars{'baseUrl'} = $baseUrl;
234
      $template->process( $header, $templateVars);
235 2341 sgarg
      $template->process( "@registerMatch@", $templateVars);
236
      $template->process( "@register@", $templateVars);
237 4010 tao
      $template->process( $footer, $templateVars);
238 2341 sgarg
239
    # Otherwise, create a new user in the LDAP directory
240
    } else {
241 3175 tao
        #print("ingore create account\n");
242 2341 sgarg
        createAccount($allParams);
243
    }
244
245
    exit();
246
}
247
248
#
249
# process input from the registerconfirmed stage, which occurs when
250
# a user chooses to create an account despite similarities to other
251
# existing accounts
252
#
253
sub handleRegisterConfirmed {
254
255
    my $allParams = { 'givenName' => $query->param('givenName'),
256
                      'sn' => $query->param('sn'),
257 2857 sgarg
                      #'o' => $query->param('o'),
258
                      'o' => 'unaffiliated',
259 2341 sgarg
                      'mail' => $query->param('mail'),
260
                      'uid' => $query->param('uid'),
261
                      'userPassword' => $query->param('userPassword'),
262
                      'userPassword2' => $query->param('userPassword2'),
263
                      'title' => $query->param('title'),
264
                      'telephoneNumber' => $query->param('telephoneNumber') };
265
    print "Content-type: text/html\n\n";
266
    createAccount($allParams);
267
268
    exit();
269
}
270
271
#
272
# change a user's password upon request
273
#
274
sub handleChangePassword {
275
276
    print "Content-type: text/html\n\n";
277
278
    my $allParams = { 'test' => "1", };
279
    if ($query->param('uid')) {
280
        $$allParams{'uid'} = $query->param('uid');
281
    }
282
    if ($query->param('o')) {
283
        $$allParams{'o'} = $query->param('o');
284 2972 jones
        my $o = $query->param('o');
285
286
        $ldapurl = $config_ldapurl->{$o};
287 2341 sgarg
        $searchBase = $config_ldapsearchbase->{$o};
288
    }
289
290
291
    # Check that all required fields are provided and not null
292
    my @requiredParams = ( 'uid', 'o', 'oldpass',
293
                           'userPassword', 'userPassword2');
294
    if (! paramsAreValid(@requiredParams)) {
295
        my $errorMessage = "Required information is missing. " .
296
            "Please fill in all required fields and submit the form.";
297
        my $templateVars = { stage => "changepass",
298
                             cfg => $cfg,
299
                             allParams => $allParams,
300
                             errorMessage => $errorMessage };
301 2972 jones
        $$templateVars{'orgList'} = \@orglist;
302 4010 tao
        $$templateVars{'baseUrl'} = $baseUrl;
303
        $template->process( $header, $templateVars);
304 2341 sgarg
        $template->process( "@defaultChangePass@", $templateVars);
305 4010 tao
        $template->process( $footer, $templateVars);
306 2341 sgarg
        exit(0);
307
    }
308
309
    # We have all of the info we need, so try to change the password
310
    if ($query->param('userPassword') =~ $query->param('userPassword2')) {
311
312 2972 jones
        my $o = $query->param('o');
313
        $ldapurl = $config_ldapurl->{$o};
314 2341 sgarg
        $searchBase = $config_ldapsearchbase->{$o};
315 2972 jones
        $root = $config_user->{$o};
316
        $rootpw = $config_password->{$o};
317 2341 sgarg
318
        my $dn = "uid=" . $query->param('uid') . "," . $config_dn->{$o};;
319
        if ($query->param('o') =~ "LTER") {
320 4010 tao
            $template->process( $header);
321 2341 sgarg
            $template->process( "@registerLter@");
322 4010 tao
            $template->process( $footer);
323 2341 sgarg
        } else {
324
            my $errorMessage = changePassword(
325
                    $dn, $query->param('userPassword'),
326
                    $dn, $query->param('oldpass'), $query->param('o'));
327 2972 jones
            if ($errorMessage) {
328 2341 sgarg
                my $templateVars = { stage => "changepass",
329
                                     cfg => $cfg,
330
                                     allParams => $allParams,
331
                                     errorMessage => $errorMessage };
332 2972 jones
                $$templateVars{'orgList'} = \@orglist;
333 4010 tao
                $$templateVars{'baseUrl'} = $baseUrl;
334
                $template->process( $header, $templateVars);
335 2341 sgarg
                $template->process( "@defaultChangePass@", $templateVars);
336 4010 tao
                $template->process( $footer, $templateVars);
337 2341 sgarg
                exit(0);
338
            } else {
339 2972 jones
                my $templateVars = { stage => "changepass",
340
                                     cfg => $cfg,
341
                                     allParams => $allParams };
342
                $$templateVars{'orgList'} = \@orglist;
343 4010 tao
                $$templateVars{'baseUrl'} = $baseUrl;
344
                $template->process( $header, $templateVars);
345 2972 jones
                $template->process( "@changePassSuccess@", $templateVars);
346 4010 tao
                $template->process( $footer, $templateVars);
347 2341 sgarg
                exit(0);
348
            }
349
        }
350
    } else {
351
        my $errorMessage = "The passwords do not match. Try again.";
352
        my $templateVars = { stage => "changepass",
353
                             cfg => $cfg,
354
                             allParams => $allParams,
355
                             errorMessage => $errorMessage };
356 2972 jones
        $$templateVars{'orgList'} = \@orglist;
357 4010 tao
        $$templateVars{'baseUrl'} = $baseUrl;
358
        $template->process( $header, $templateVars);
359 2341 sgarg
        $template->process( "@defaultChangePass@", $templateVars);
360 4010 tao
        $template->process( $footer, $templateVars);
361 2341 sgarg
        exit(0);
362
    }
363
}
364
365
#
366 2414 sgarg
# change a user's password upon request - no input params
367
# only display chagepass template without any error
368
#
369
sub handleInitialChangePassword {
370
    print "Content-type: text/html\n\n";
371
372
    my $allParams = { 'test' => "1", };
373
    my $errorMessage = "";
374
    my $templateVars = { stage => "changepass",
375
                         cfg => $cfg,
376
                         allParams => $allParams,
377
                         errorMessage => $errorMessage };
378
    $$templateVars{'orgList'} = \@orglist;
379 4010 tao
    $$templateVars{'baseUrl'} = $baseUrl;
380
    $template->process( $header, $templateVars);
381 2414 sgarg
    $template->process( "@defaultChangePass@", $templateVars);
382 4010 tao
    $template->process( $footer, $templateVars);
383 2414 sgarg
    exit(0);
384
}
385
386
#
387 2341 sgarg
# reset a user's password upon request
388
#
389
sub handleResetPassword {
390
391
    print "Content-type: text/html\n\n";
392
393
    my $allParams = { 'test' => "1", };
394
    if ($query->param('uid')) {
395
        $$allParams{'uid'} = $query->param('uid');
396
    }
397
    if ($query->param('o')) {
398
        $$allParams{'o'} = $query->param('o');
399 2972 jones
        my $o = $query->param('o');
400
401
        $ldapurl = $config_ldapurl->{$o};
402 2341 sgarg
        $searchBase = $config_ldapsearchbase->{$o};
403 2972 jones
        $root = $config_user->{$o};
404
        $rootpw = $config_password->{$o};
405 2341 sgarg
    }
406
407
    # Check that all required fields are provided and not null
408
    my @requiredParams = ( 'uid', 'o' );
409
    if (! paramsAreValid(@requiredParams)) {
410
        my $errorMessage = "Required information is missing. " .
411
            "Please fill in all required fields and submit the form.";
412
        my $templateVars = { stage => "resetpass",
413
                             cfg => $cfg,
414
                             allParams => $allParams,
415
                             errorMessage => $errorMessage };
416 2972 jones
        $$templateVars{'orgList'} = \@orglist;
417 4010 tao
        $$templateVars{'baseUrl'} = $baseUrl;
418
        $template->process( $header, $templateVars);
419 2341 sgarg
        $template->process( "@defaultResetPass@", $templateVars);
420 4010 tao
        $template->process( $footer, $templateVars);
421 2341 sgarg
        exit(0);
422
    }
423
424
    # We have all of the info we need, so try to change the password
425
    my $o = $query->param('o');
426
    my $dn = "uid=" . $query->param('uid') . "," . $config_dn->{$o};
427
    if ($query->param('o') =~ "LTER") {
428 4010 tao
        $template->process( $header);
429 2341 sgarg
        $template->process( "@registerLter@");
430 4010 tao
        $template->process( $footer);
431 2341 sgarg
        exit(0);
432
    } else {
433
        my $errorMessage = "";
434
        my $recipient;
435
        my $userPass;
436
        my $entry = getLdapEntry($ldapurl, $searchBase,
437
                $query->param('uid'), $query->param('o'));
438
439
        if ($entry) {
440
            $recipient = $entry->get_value('mail');
441
            $userPass = getRandomPassword();
442
            $errorMessage = changePassword($dn, $userPass, $root, $rootpw, $query->param('o'));
443
        } else {
444
            $errorMessage = "User not found in database.  Please try again.";
445
        }
446
447
        if ($errorMessage) {
448
            my $templateVars = { stage => "resetpass",
449
                                 cfg => $cfg,
450
                                 allParams => $allParams,
451
                                 errorMessage => $errorMessage };
452 2972 jones
            $$templateVars{'orgList'} = \@orglist;
453 4010 tao
            $$templateVars{'baseUrl'} = $baseUrl;
454
            $template->process( $header, $templateVars);
455 2341 sgarg
            $template->process( "@defaultResetPass@", $templateVars);
456 4010 tao
            $template->process( $footer, $templateVars);
457 2341 sgarg
            exit(0);
458
        } else {
459
            my $errorMessage = sendPasswordNotification($query->param('uid'),
460 2972 jones
                    $query->param('o'), $userPass, $recipient, $cfg);
461 2341 sgarg
            my $templateVars = { stage => "resetpass",
462
                                 cfg => $cfg,
463
                                 allParams => $allParams,
464
                                 errorMessage => $errorMessage };
465 2972 jones
            $$templateVars{'orgList'} = \@orglist;
466 4010 tao
            $$templateVars{'baseUrl'} = $baseUrl;
467
            $template->process( $header, $templateVars);
468 2341 sgarg
            $template->process( "@resetPassSuccess@", $templateVars);
469 4010 tao
            $template->process( $footer, $templateVars);
470 2341 sgarg
            exit(0);
471
        }
472
    }
473
}
474
475
#
476 2414 sgarg
# reset a user's password upon request- no initial params
477
# only display resetpass template without any error
478
#
479
sub handleInitialResetPassword {
480
    print "Content-type: text/html\n\n";
481
    my $errorMessage = "";
482
    my $allParams = { 'test' => "1", };
483
    my $templateVars = { stage => "resetpass",
484
                         cfg => $cfg,
485
                         allParams => $allParams,
486
                         errorMessage => $errorMessage };
487
    $$templateVars{'orgList'} = \@orglist;
488 4010 tao
    $$templateVars{'baseUrl'} = $baseUrl;
489
    $template->process( $header, $templateVars);
490 2414 sgarg
    $template->process( "@defaultResetPass@", $templateVars);
491 4010 tao
    $template->process( $footer, $templateVars);
492 2414 sgarg
    exit(0);
493
}
494
495
#
496 2341 sgarg
# Construct a random string to use for a newly reset password
497
#
498
sub getRandomPassword {
499
    my $length = shift;
500
    if (!$length) {
501
        $length = 8;
502
    }
503
    my $newPass = "";
504
505
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
506
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
507
    return $newPass;
508
}
509
510
#
511
# Change a password to a new value, binding as the provided user
512
#
513
sub changePassword {
514
    my $userDN = shift;
515
    my $userPass = shift;
516
    my $bindDN = shift;
517
    my $bindPass = shift;
518
    my $o = shift;
519
520
    my $ldapurl = $config_ldapurl->{$o};
521
    my $searchBase = $config_ldapsearchbase->{$o};
522
523
    my $errorMessage = 0;
524 3177 tao
    my $ldap;
525
    if ($ldapurl =~ $mainldapurl){
526
        #if main ldap server is down, a html file containing warning message will be returned
527
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
528
    }
529
    else{
530
        #if a referral ldap server is down, we will ignore it silently
531
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
532
    }
533 2972 jones
    #$ldap->start_tls( verify => 'require',
534
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
535
    $ldap->start_tls( verify => 'none');
536 2341 sgarg
    my $bindresult = $ldap->bind( version => 3, dn => $bindDN,
537
                                  password => $bindPass );
538
    if ($bindresult->code) {
539
        $errorMessage = "Failed to log in. Are you sure your old " .
540
                        "password is correct? Try again...";
541
        return $errorMessage;
542
    }
543
544
    # Find the user here and change their entry
545
    my $newpass = createSeededPassHash($userPass);
546
    my $modifications = { userPassword => $newpass };
547
    my $result = $ldap->modify( $userDN, replace => { %$modifications });
548
549
    if ($result->code()) {
550
        my $errorMessage = "There was an error changing the password." .
551
                           "<br />\n" . $result->error;
552
    }
553
    $ldap->unbind;   # take down session
554
555
    return $errorMessage;
556
}
557
558
#
559
# generate a Seeded SHA1 hash of a plaintext password
560
#
561
sub createSeededPassHash {
562
    my $secret = shift;
563
564
    my $salt = "";
565
    for (my $i=0; $i < 4; $i++) {
566
        $salt .= int(rand(10));
567
    }
568
569
    my $ctx = Digest::SHA1->new;
570
    $ctx->add($secret);
571
    $ctx->add($salt);
572
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
573
574
    return $hashedPasswd;
575
}
576
577
#
578
# Look up an ldap entry for a user
579
#
580
sub getLdapEntry {
581
    my $ldapurl = shift;
582
    my $base = shift;
583
    my $username = shift;
584
    my $org = shift;
585
586
    my $entry = "";
587
    my $mesg;
588 3177 tao
    my $ldap;
589
    print("ldap server ", $ldapurl, "\n");
590
    if ($ldapurl =~ $mainldapurl){
591
        #if main ldap server is down, a html file containing warning message will be returned
592
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
593
    }
594
    else{
595
        #if a referral ldap server is down, we will ignore it silently
596
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
597
    }
598 2972 jones
    $ldap->start_tls( verify => 'none');
599 2341 sgarg
    my $bindresult = $ldap->bind;
600
    if ($bindresult->code) {
601
        return $entry;
602
    }
603
604
    if($config_filter->{$org}){
605 2972 jones
        $mesg = $ldap->search ( base   => $base,
606
                filter => "(&(uid=$username)($config_filter->{$org}))");
607 2341 sgarg
    } else {
608 2972 jones
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
609 2341 sgarg
    }
610 3177 tao
611 2341 sgarg
    if ($mesg->count > 0) {
612
        $entry = $mesg->pop_entry;
613
        $ldap->unbind;   # take down session
614
    } else {
615
        $ldap->unbind;   # take down session
616
        # Follow references by recursive call to self
617
        my @references = $mesg->references();
618
        for (my $i = 0; $i <= $#references; $i++) {
619
            my $uri = URI->new($references[$i]);
620
            my $host = $uri->host();
621
            my $path = $uri->path();
622
            $path =~ s/^\///;
623
            $entry = &getLdapEntry($host, $path, $username, $org);
624
            if ($entry) {
625
                return $entry;
626
            }
627
        }
628
    }
629
    return $entry;
630
}
631
632
#
633
# send an email message notifying the user of the pw change
634
#
635
sub sendPasswordNotification {
636
    my $username = shift;
637
    my $org = shift;
638
    my $newPass = shift;
639
    my $recipient = shift;
640 2972 jones
    my $cfg = shift;
641 2341 sgarg
642
    my $errorMessage = "";
643
    if ($recipient) {
644
        # Send the email message to them
645
        my $smtp = Net::SMTP->new($mailhost);
646
        $smtp->mail($sender);
647
        $smtp->to($recipient);
648
649
        my $message = <<"        ENDOFMESSAGE";
650
        To: $recipient
651
        From: $sender
652
        Subject: KNB Password Reset
653
654
        Somebody (hopefully you) requested that your KNB password be reset.
655
        This is generally done when somebody forgets their password.  Your
656
        password can be changed by visiting the following URL:
657
658 2972 jones
        @cgiurl@?stage=changepass&cfg=$cfg
659 2341 sgarg
660
            Username: $username
661
        Organization: $org
662
        New Password: $newPass
663
664
        Thanks,
665
            The KNB Development Team
666
667
        ENDOFMESSAGE
668
        $message =~ s/^[ \t\r\f]+//gm;
669
670
        $smtp->data($message);
671
        $smtp->quit;
672
    } else {
673
        $errorMessage = "Failed to send password because I " .
674
                        "couldn't find a valid email address.";
675
    }
676
    return $errorMessage;
677
}
678
679
#
680
# search the LDAP directory to see if a similar account already exists
681
#
682
sub findExistingAccounts {
683
    my $ldapurl = shift;
684
    my $base = shift;
685
    my $filter = shift;
686
    my $attref = shift;
687 3175 tao
    my $ldap;
688 2341 sgarg
689
    my $foundAccounts = 0;
690 3175 tao
    #print("the ldapurl in findExstingAccounts is ", $ldapurl, "\n");
691
    if ($ldapurl =~ $mainldapurl){
692
        #if main ldap server is down, a html file containing warning message will be returned
693 3177 tao
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
694 3175 tao
    }
695
    else{
696
        #if a referral ldap server is down, we will ignore it silently
697
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
698
    }
699 2972 jones
    $ldap->start_tls( verify => 'none');
700 2341 sgarg
    $ldap->bind( version => 3, anonymous => 1);
701
    my $mesg = $ldap->search (
702
        base   => $base,
703
        filter => $filter,
704
        attrs => @$attref,
705
    );
706
707
    if ($mesg->count() > 0) {
708
        $foundAccounts = "";
709
        my $entry;
710
        foreach $entry ($mesg->all_entries) {
711
            $foundAccounts .= "<p>\n<b><u>Account:</u> ";
712
            $foundAccounts .= $entry->dn();
713
            $foundAccounts .= "</b><br />\n";
714
            foreach my $attribute ($entry->attributes()) {
715
                $foundAccounts .= "$attribute: ";
716
                $foundAccounts .= $entry->get_value($attribute);
717
                $foundAccounts .= "<br />\n";
718
            }
719
            $foundAccounts .= "</p>\n";
720
        }
721
    }
722
    $ldap->unbind;   # take down session
723
724
    # Follow references
725
    my @references = $mesg->references();
726
    for (my $i = 0; $i <= $#references; $i++) {
727
        my $uri = URI->new($references[$i]);
728
        my $host = $uri->host();
729
        my $path = $uri->path();
730
        $path =~ s/^\///;
731
        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
732
        if ($refFound) {
733
            $foundAccounts .= $refFound;
734
        }
735
    }
736
737
    #print "<p>Checking referrals...</p>\n";
738
    #my @referrals = $mesg->referrals();
739
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
740
    #for (my $i = 0; $i <= $#referrals; $i++) {
741
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
742
    #}
743
744
    return $foundAccounts;
745
}
746
747
#
748
# Validate that we have the proper set of input parameters
749
#
750
sub paramsAreValid {
751
    my @pnames = @_;
752
753
    my $allValid = 1;
754
    foreach my $parameter (@pnames) {
755
        if (!defined($query->param($parameter)) ||
756
            ! $query->param($parameter) ||
757
            $query->param($parameter) =~ /^\s+$/) {
758
            $allValid = 0;
759
        }
760
    }
761
762
    return $allValid;
763
}
764
765
#
766
# Bind to LDAP and create a new account using the information provided
767
# by the user
768
#
769
sub createAccount {
770
    my $allParams = shift;
771
772
    if ($query->param('o') =~ "LTER") {
773 4010 tao
        $template->process( $header);
774 2341 sgarg
        $template->process( "@registerLter@");
775 4010 tao
        $template->process( $footer);
776 2341 sgarg
    } else {
777
778
        # Be sure the passwords match
779
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
780
            my $errorMessage = "The passwords do not match. Try again.";
781
            my $templateVars = { stage => "register",
782
                                 cfg => $cfg,
783
                                 allParams => $allParams,
784
                                 errorMessage => $errorMessage };
785 2972 jones
            $$templateVars{'orgList'} = \@orglist;
786 4010 tao
            $$templateVars{'baseUrl'} = $baseUrl;
787
            $template->process( $header, $templateVars);
788 2540 sgarg
            $template->process( "@registerFailed@", $templateVars);
789 2341 sgarg
            $template->process( "@register@", $templateVars);
790 4010 tao
            $template->process( $footer, $templateVars);
791 2341 sgarg
            exit(0);
792
        }
793
794 2972 jones
        my $o = $query->param('o');
795 2341 sgarg
796 2972 jones
        my $ldapurl = $config_ldapurl->{$o};
797
        my $root = $config_user->{$o};
798
        my $rootpw = $config_password->{$o};
799
        my $searchBase = $config_ldapsearchbase->{$o};
800
        my $dnBase = $config_dn->{$o};
801 2341 sgarg
802 3177 tao
803
        #if main ldap server is down, a html file containing warning message will be returned
804
        my $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
805
806
807 2972 jones
        $ldap->start_tls( verify => 'none');
808 2341 sgarg
        $ldap->bind( version => 3, dn => $root, password => $rootpw );
809
        #print "Inserting new entry...\n";
810
        my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
811
812
        # Create a hashed version of the password
813
        my $shapass = createSeededPassHash($query->param('userPassword'));
814
815
        # Do the insertion
816
        my $additions = [
817
                'uid'   => $query->param('uid'),
818
                'o'   => $query->param('o'),
819
                'cn'   => join(" ", $query->param('givenName'),
820
                                    $query->param('sn')),
821
                'sn'   => $query->param('sn'),
822
                'givenName'   => $query->param('givenName'),
823
                'mail' => $query->param('mail'),
824
                'userPassword' => $shapass,
825
                'objectclass' => ['top', 'person', 'organizationalPerson',
826
                                'inetOrgPerson', 'uidObject' ]
827
            ];
828
        if (defined($query->param('telephoneNumber')) &&
829
            $query->param('telephoneNumber') &&
830
            ! $query->param('telephoneNumber') =~ /^\s+$/) {
831
            $$additions[$#$additions + 1] = 'telephoneNumber';
832
            $$additions[$#$additions + 1] = $query->param('telephoneNumber');
833
        }
834
        if (defined($query->param('title')) &&
835
            $query->param('title') &&
836
            ! $query->param('title') =~ /^\s+$/) {
837
            $$additions[$#$additions + 1] = 'title';
838
            $$additions[$#$additions + 1] = $query->param('title');
839
        }
840
        my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
841
842
        if ($result->code()) {
843
            my $templateVars = { stage => "register",
844
                                 cfg => $cfg,
845
                                 allParams => $allParams,
846
                                 errorMessage => $result->error };
847 2972 jones
            $$templateVars{'orgList'} = \@orglist;
848 4010 tao
            $$templateVars{'baseUrl'} = $baseUrl;
849
            $template->process( $header, $templateVars);
850 2341 sgarg
            $template->process( "@registerFailed@", $templateVars);
851
            $templateVars    = { stage => "register",
852
                                 cfg => $cfg,
853
                                 allParams => $allParams };
854 2972 jones
            $$templateVars{'orgList'} = \@orglist;
855 4010 tao
            $$templateVars{'baseUrl'} = $baseUrl;
856 2341 sgarg
            $template->process( "@register@", $templateVars);
857 4010 tao
            $template->process( $footer, $templateVars);
858 2341 sgarg
        } else {
859 2972 jones
            my $templateVars    = { cfg => $cfg };
860 4010 tao
            $$templateVars{'baseUrl'} = $baseUrl;
861
            $template->process( $header, $templateVars);
862 2414 sgarg
            $template->process( "@registerSuccess@", $templateVars);
863 4010 tao
            $template->process( $footer, $templateVars);
864 2341 sgarg
        }
865
866
        $ldap->unbind;   # take down session
867
    }
868
}
869
870
sub handleResponseMessage {
871
872
  print "Content-type: text/html\n\n";
873
  my $errorMessage = "You provided invalid input to the script. " .
874
                     "Try again please.";
875
  my $templateVars = { stage => "@defaultStage@",
876
                       cfg => $cfg,
877
                       errorMessage => $errorMessage };
878
  $$templateVars{'orgList'} = \@orglist;
879 4010 tao
  $$templateVars{'baseUrl'} = $baseUrl;
880
  $template->process( $header, $templateVars);
881
  $template->process( $footer, $templateVars);
882 2341 sgarg
  exit(0);
883
}
884
885
#
886
# perform a simple search against the LDAP database using
887
# a small subset of attributes of each dn and return it
888
# as a table to the calling browser.
889
#
890
sub handleSimpleSearch {
891
892
    my $o = $query->param('o');
893
894
    my $ldapurl = $config_ldapurl->{$o};
895
    my $searchBase = $config_ldapsearchbase->{$o};
896
897
    print "Content-type: text/html\n\n";
898
899
    my $allParams = {
900
                      'cn' => $query->param('cn'),
901
                      'sn' => $query->param('sn'),
902
                      'gn' => $query->param('gn'),
903
                      'o'  => $query->param('o'),
904
                      'facsimiletelephonenumber'
905
                      => $query->param('facsimiletelephonenumber'),
906
                      'mail' => $query->param('cmail'),
907
                      'telephonenumber' => $query->param('telephonenumber'),
908
                      'title' => $query->param('title'),
909
                      'uid' => $query->param('uid'),
910
                      'ou' => $query->param('ou'),
911
                    };
912
913
    # Search LDAP for matching entries that already exist
914
    my $filter = "(" .
915
                 $query->param('searchField') . "=" .
916
                 "*" .
917
                 $query->param('searchValue') .
918
                 "*" .
919
                 ")";
920
921
    my @attrs = [ 'sn',
922
                  'gn',
923
                  'cn',
924
                  'o',
925
                  'facsimiletelephonenumber',
926
                  'mail',
927
                  'telephoneNumber',
928
                  'title',
929
                  'uid',
930
                  'labeledURI',
931
                  'ou' ];
932
933
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
934
935
    # Send back the search results
936
    if ($found) {
937
      my $templateVars = { stage => "searchResults",
938
                           cfg => $cfg,
939
                           allParams => $allParams,
940
                           foundAccounts => $found };
941
      $$templateVars{'orgList'} = \@orglist;
942 4010 tao
      $$templateVars{'baseUrl'} = $baseUrl;
943
      $template->process( $header, $templateVars);
944 2341 sgarg
      $template->process( "@searchResults@", $templateVars);
945 4010 tao
      $template->process( $footer, $templateVars);
946 2341 sgarg
947
    } else {
948
      $found = "No entries matched your criteria.  Please try again\n";
949
950
      my $templateVars = { stage => "searchResults",
951
                           cfg => $cfg,
952
                           allParams => $allParams,
953
                           foundAccounts => $found };
954
      $$templateVars{'orgList'} = \@orglist;
955 4010 tao
      $$templateVars{'baseUrl'} = $baseUrl;
956
      $template->process( $header, $templateVars);
957 2341 sgarg
      $template->process( "@searchResults@", $templateVars);
958 4010 tao
      $template->process( $footer, $templateVars);
959 2341 sgarg
960
    }
961
962
    exit();
963
}
964
965
#
966
# search the LDAP directory to see if a similar account already exists
967
#
968
sub searchDirectory {
969
    my $ldapurl = shift;
970
    my $base = shift;
971
    my $filter = shift;
972
    my $attref = shift;
973
974
    my $foundAccounts = 0;
975
976 3177 tao
977
978
    #if ldap server is down, a html file containing warning message will be returned
979
    my $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
980
981 2972 jones
    $ldap->start_tls( verify => 'none');
982 2341 sgarg
    $ldap->bind( version => 3, anonymous => 1);
983
    my $mesg = $ldap->search (
984
        base   => $base,
985
        filter => $filter,
986
        attrs => @$attref,
987
    );
988
989
    if ($mesg->count() > 0) {
990
        $foundAccounts = "";
991
        my $entry;
992
        foreach $entry ($mesg->sorted(['sn'])) {
993
          $foundAccounts .= "<tr>\n<td class=\"main\">\n";
994
          $foundAccounts .= "<a href=\"" unless
995
                    (!$entry->get_value('labeledURI'));
996
          $foundAccounts .= $entry->get_value('labeledURI') unless
997
                    (!$entry->get_value('labeledURI'));
998
          $foundAccounts .= "\">\n" unless
999
                    (!$entry->get_value('labeledURI'));
1000
          $foundAccounts .= $entry->get_value('givenName');
1001
          $foundAccounts .= "</a>\n" unless
1002
                    (!$entry->get_value('labeledURI'));
1003
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1004
          $foundAccounts .= "<a href=\"" unless
1005
                    (!$entry->get_value('labeledURI'));
1006
          $foundAccounts .= $entry->get_value('labeledURI') unless
1007
                    (!$entry->get_value('labeledURI'));
1008
          $foundAccounts .= "\">\n" unless
1009
                    (!$entry->get_value('labeledURI'));
1010
          $foundAccounts .= $entry->get_value('sn');
1011
          $foundAccounts .= "</a>\n";
1012
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1013
          $foundAccounts .= $entry->get_value('mail');
1014
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1015
          $foundAccounts .= $entry->get_value('telephonenumber');
1016
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1017
          $foundAccounts .= $entry->get_value('title');
1018
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1019
          $foundAccounts .= $entry->get_value('ou');
1020
          $foundAccounts .= "\n</td>\n";
1021
          $foundAccounts .= "</tr>\n";
1022
        }
1023
    }
1024
    $ldap->unbind;   # take down session
1025
    return $foundAccounts;
1026
}
1027
1028
sub debug {
1029
    my $msg = shift;
1030
1031
    if ($debug) {
1032
        print STDERR "$msg\n";
1033
    }
1034
}
1035 3175 tao
1036 3177 tao
sub handleGeneralServerFailure {
1037
    my $errorMessage = shift;
1038 3175 tao
    my $templateVars = { cfg => $cfg,
1039
                         errorMessage => $errorMessage };
1040 4010 tao
    $$templateVars{'baseUrl'} = $baseUrl;
1041
    $template->process( $header, $templateVars);
1042 3175 tao
    $template->process( "@ldapMainServerFailure@", $templateVars);
1043 4010 tao
    $template->process( $footer, $templateVars);
1044 3175 tao
    exit(0);
1045
   }
1046