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