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