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