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