Project

General

Profile

1
#!/usr/bin/perl -w
2
 #
3
 #  '$RCSfile$'
4
 #  Copyright: 2001 Regents of the University of California 
5
 #
6
 #   '$Author: sgarg $'
7
 #     '$Date: 2005-12-15 16:46:30 -0800 (Thu, 15 Dec 2005) $'
8
 # '$Revision: 2857 $' 
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
              'initchangepass'    => \&handleInitialChangePassword,
112
              'simplesearch'      => \&handleSimpleSearch,
113
              'initaddentry'      => \&handleInitAddEntry,
114
              'addentry'          => \&handleAddEntry,
115
              'initmodifyentry'   => \&handleInitModifyEntry,
116
              'modifyentry'       => \&handleModifyEntry,
117
              'resetpass'         => \&handleResetPassword,
118
              'initresetpass'     => \&handleInitialResetPassword,
119
             );
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
  $$templateVars{'orgList'} = \@orglist;
143
  $template->process( "@defaultHeader@", $templateVars);
144
  $template->process( "@register@", $templateVars);
145
  $template->process( "@defaultFooter@", $templateVars);
146

    
147
  exit();
148
}
149

    
150
#
151
# process input from the register stage, which occurs when
152
# a user submits form data to create a new account
153
#
154
sub handleRegister {
155
    
156
    print "Content-type: text/html\n\n";
157

    
158
    my $allParams = { 'givenName' => $query->param('givenName'), 
159
                      'sn' => $query->param('sn'),
160
                      'o' => $query->param('o'), 
161
                      'mail' => $query->param('mail'), 
162
                      'uid' => $query->param('uid'), 
163
                      'userPassword' => $query->param('userPassword'), 
164
                      'userPassword2' => $query->param('userPassword2'), 
165
                      'title' => $query->param('title'), 
166
                      'telephoneNumber' => $query->param('telephoneNumber') };
167
    # Check that all required fields are provided and not null
168
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
169
                           'uid', 'userPassword', 'userPassword2');
170
    if (! paramsAreValid(@requiredParams)) {
171
        my $errorMessage = "Required information is missing. " .
172
            "Please fill in all required fields and resubmit the form.";
173
        my $templateVars = { stage => "register",
174
                             cfg => $cfg,
175
                             allParams => $allParams,
176
                             errorMessage => $errorMessage };
177
	$$templateVars{'orgList'} = \@orglist;
178
        $template->process( "@defaultHeader@", $templateVars);
179
        $template->process( "@register@", $templateVars);
180
        $template->process( "@defaultFooter@", $templateVars);
181
        exit(0);
182
    } else {
183
	my $o = $query->param('o');    
184
	$ldapurl = $config_ldapurl->{$o};
185
	$searchBase = $config_ldapsearchbase->{$o};  
186
    }
187

    
188
    # Search LDAP for matching entries that already exist
189
    # Some forms use a single text search box, whereas others search per
190
    # attribute.
191
    my $filter;
192
    if ($query->param('searchField')) {
193

    
194
      $filter = "(|" . 
195
                "(uid=" . $query->param('searchField') . ") " .
196
                "(mail=" . $query->param('searchField') . ")" .
197
                "(&(sn=" . $query->param('searchField') . ") " . 
198
                "(givenName=" . $query->param('searchField') . "))" . 
199
                ")";
200
    } else {
201
      $filter = "(|" . 
202
                "(uid=" . $query->param('uid') . ") " .
203
                "(mail=" . $query->param('mail') . ")" .
204
                "(&(sn=" . $query->param('sn') . ") " . 
205
                "(givenName=" . $query->param('givenName') . "))" . 
206
                ")";
207
    }
208

    
209
    my @attrs = [ 'uid', 'o', 'cn', 'mail', 'telephoneNumber', 'title' ];
210

    
211
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
212

    
213
    # If entries match, send back a request to confirm new-user creation
214
    if ($found) {
215
      my $templateVars = { stage => "registerconfirmed",
216
                           cfg => $cfg,
217
                           allParams => $allParams,
218
                           foundAccounts => $found };
219
      $$templateVars{'orgList'} = \@orglist;
220
      $template->process( "@defaultHeader@", $templateVars);
221
      $template->process( "@registerMatch@", $templateVars);
222
      $template->process( "@register@", $templateVars);
223
      $template->process( "@defaultFooter@", $templateVars);
224

    
225
    # Otherwise, create a new user in the LDAP directory
226
    } else {
227
        createAccount($allParams);
228
    }
229

    
230
    exit();
231
}
232

    
233
#
234
# process input from the registerconfirmed stage, which occurs when
235
# a user chooses to create an account despite similarities to other
236
# existing accounts
237
#
238
sub handleRegisterConfirmed {
239
  
240
    my $allParams = { 'givenName' => $query->param('givenName'), 
241
                      'sn' => $query->param('sn'),
242
                      #'o' => $query->param('o'), 
243
                      'o' => 'unaffiliated', 
244
                      'mail' => $query->param('mail'), 
245
                      'uid' => $query->param('uid'), 
246
                      'userPassword' => $query->param('userPassword'), 
247
                      'userPassword2' => $query->param('userPassword2'), 
248
                      'title' => $query->param('title'), 
249
                      'telephoneNumber' => $query->param('telephoneNumber') };
250
    print "Content-type: text/html\n\n";
251
    createAccount($allParams);
252

    
253
    exit();
254
}
255

    
256
#
257
# change a user's password upon request
258
#
259
sub handleChangePassword {
260

    
261
    print "Content-type: text/html\n\n";
262

    
263
    my $allParams = { 'test' => "1", };
264
    if ($query->param('uid')) {
265
        $$allParams{'uid'} = $query->param('uid');
266
    }
267
    if ($query->param('o')) {
268
        $$allParams{'o'} = $query->param('o');
269
	my $o = $query->param('o');
270
	
271
	$ldapurl = $config_ldapurl->{$o};
272
        $searchBase = $config_ldapsearchbase->{$o};
273
    }
274

    
275

    
276
    # Check that all required fields are provided and not null
277
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
278
                           'userPassword', 'userPassword2');
279
    if (! paramsAreValid(@requiredParams)) {
280
        my $errorMessage = "Required information is missing. " .
281
            "Please fill in all required fields and submit the form.";
282
        my $templateVars = { stage => "changepass",
283
                             cfg => $cfg,
284
                             allParams => $allParams,
285
                             errorMessage => $errorMessage };
286
	$$templateVars{'orgList'} = \@orglist;
287
        $template->process( "@defaultHeader@", $templateVars);
288
        $template->process( "@defaultChangePass@", $templateVars);
289
        $template->process( "@defaultFooter@", $templateVars);
290
        exit(0);
291
    }
292

    
293
    # We have all of the info we need, so try to change the password
294
    if ($query->param('userPassword') =~ $query->param('userPassword2')) {
295

    
296
	my $o = $query->param('o');
297
	$ldapurl = $config_ldapurl->{$o};
298
        $searchBase = $config_ldapsearchbase->{$o};
299
	$root = $config_user->{$o};
300
	$rootpw = $config_password->{$o};
301

    
302
        my $dn = "uid=" . $query->param('uid') . "," . $config_dn->{$o};;
303
        if ($query->param('o') =~ "LTER") {
304
            $template->process( "@defaultHeader@");
305
            $template->process( "@registerLter@");
306
            $template->process( "@defaultFooter@");
307
        } else {
308
            my $errorMessage = changePassword(
309
                    $dn, $query->param('userPassword'), 
310
                    $dn, $query->param('oldpass'), $query->param('o'));
311
            if ($errorMessage) {	
312
                my $templateVars = { stage => "changepass",
313
                                     cfg => $cfg,
314
                                     allParams => $allParams,
315
                                     errorMessage => $errorMessage };
316
		$$templateVars{'orgList'} = \@orglist;
317
                $template->process( "@defaultHeader@", $templateVars);
318
                $template->process( "@defaultChangePass@", $templateVars);
319
                $template->process( "@defaultFooter@", $templateVars);
320
                exit(0);
321
            } else {
322
                $template->process( "@defaultHeader@");
323
                $template->process( "@changePassSuccess@");
324
                $template->process( "@defaultFooter@");
325
                exit(0);
326
            }
327
        }
328
    } else {
329
        my $errorMessage = "The passwords do not match. Try again.";
330
        my $templateVars = { stage => "changepass",
331
                             cfg => $cfg,
332
                             allParams => $allParams,
333
                             errorMessage => $errorMessage };
334
	$$templateVars{'orgList'} = \@orglist;
335
        $template->process( "@defaultHeader@", $templateVars);
336
        $template->process( "@defaultChangePass@", $templateVars);
337
        $template->process( "@defaultFooter@", $templateVars);
338
        exit(0);
339
    }
340
}
341

    
342
#
343
# change a user's password upon request - no input params
344
# only display chagepass template without any error
345
#
346
sub handleInitialChangePassword {
347
    print "Content-type: text/html\n\n";
348

    
349
    my $allParams = { 'test' => "1", };
350
    my $errorMessage = "";
351
    my $templateVars = { stage => "changepass",
352
                         cfg => $cfg,
353
                         allParams => $allParams,
354
                         errorMessage => $errorMessage };
355
    $$templateVars{'orgList'} = \@orglist;
356
    $template->process( "@defaultHeader@", $templateVars);
357
    $template->process( "@defaultChangePass@", $templateVars);
358
    $template->process( "@defaultFooter@", $templateVars);
359
    exit(0);
360
}
361

    
362
#
363
# reset a user's password upon request
364
#
365
sub handleResetPassword {
366

    
367
    print "Content-type: text/html\n\n";
368

    
369
    my $allParams = { 'test' => "1", };
370
    if ($query->param('uid')) {
371
        $$allParams{'uid'} = $query->param('uid');
372
    }
373
    if ($query->param('o')) {
374
        $$allParams{'o'} = $query->param('o');
375
	my $o = $query->param('o');
376
	
377
	$ldapurl = $config_ldapurl->{$o};
378
        $searchBase = $config_ldapsearchbase->{$o};
379
	$root = $config_user->{$o};
380
	$rootpw = $config_password->{$o};
381
    }
382

    
383
    # Check that all required fields are provided and not null
384
    my @requiredParams = ( 'uid', 'o' );
385
    if (! paramsAreValid(@requiredParams)) {
386
        my $errorMessage = "Required information is missing. " .
387
            "Please fill in all required fields and submit the form.";
388
        my $templateVars = { stage => "resetpass",
389
                             cfg => $cfg,
390
                             allParams => $allParams,
391
                             errorMessage => $errorMessage };
392
	$$templateVars{'orgList'} = \@orglist;
393
        $template->process( "@defaultHeader@", $templateVars);
394
        $template->process( "@defaultResetPass@", $templateVars);
395
        $template->process( "@defaultFooter@", $templateVars);
396
        exit(0);
397
    }
398

    
399
    # We have all of the info we need, so try to change the password
400
    my $o = $query->param('o');
401
    my $dn = "uid=" . $query->param('uid') . "," . $config_dn->{$o};
402
    if ($query->param('o') =~ "LTER") {
403
        $template->process( "@defaultHeader@");
404
        $template->process( "@registerLter@");
405
        $template->process( "@defaultFooter@");
406
        exit(0);
407
    } else {
408
        my $errorMessage = "";
409
        my $recipient;
410
        my $userPass;
411
        my $entry = getLdapEntry($ldapurl, $searchBase, 
412
                $query->param('uid'), $query->param('o'));
413

    
414
        if ($entry) {
415
            $recipient = $entry->get_value('mail');
416
            $userPass = getRandomPassword();
417
            $errorMessage = changePassword($dn, $userPass, $root, $rootpw, $query->param('o'));
418
        } else {
419
            $errorMessage = "User not found in database.  Please try again.";
420
        }
421

    
422
        if ($errorMessage) {
423
            my $templateVars = { stage => "resetpass",
424
                                 cfg => $cfg,
425
                                 allParams => $allParams,
426
                                 errorMessage => $errorMessage };
427
	    $$templateVars{'orgList'} = \@orglist;
428
            $template->process( "@defaultHeader@", $templateVars);
429
            $template->process( "@defaultResetPass@", $templateVars);
430
            $template->process( "@defaultFooter@", $templateVars);
431
            exit(0);
432
        } else {
433
            my $errorMessage = sendPasswordNotification($query->param('uid'),
434
                    $query->param('o'), $userPass, $recipient);
435
            my $templateVars = { stage => "resetpass",
436
                                 cfg => $cfg,
437
                                 allParams => $allParams,
438
                                 errorMessage => $errorMessage };
439
	    $$templateVars{'orgList'} = \@orglist;
440
            $template->process( "@defaultHeader@", $templateVars);
441
            $template->process( "@resetPassSuccess@", $templateVars);
442
            $template->process( "@defaultFooter@", $templateVars);
443
            exit(0);
444
        }
445
    }
446
}
447

    
448
#
449
# reset a user's password upon request- no initial params
450
# only display resetpass template without any error
451
#
452
sub handleInitialResetPassword {
453
    print "Content-type: text/html\n\n";
454
    my $errorMessage = "";
455
    my $allParams = { 'test' => "1", };
456
    my $templateVars = { stage => "resetpass",
457
                         cfg => $cfg,
458
                         allParams => $allParams,
459
                         errorMessage => $errorMessage };
460
    $$templateVars{'orgList'} = \@orglist;
461
    $template->process( "@defaultHeader@", $templateVars);
462
    $template->process( "@defaultResetPass@", $templateVars);
463
    $template->process( "@defaultFooter@", $templateVars);
464
    exit(0);
465
}
466

    
467
#
468
# Construct a random string to use for a newly reset password
469
#
470
sub getRandomPassword {
471
    my $length = shift;
472
    if (!$length) {
473
        $length = 8;
474
    }
475
    my $newPass = "";
476

    
477
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
478
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
479
    return $newPass;
480
}
481

    
482
#
483
# Change a password to a new value, binding as the provided user
484
#
485
sub changePassword {
486
    my $userDN = shift;
487
    my $userPass = shift;
488
    my $bindDN = shift;
489
    my $bindPass = shift;
490
    my $o = shift;
491

    
492
    my $ldapurl = $config_ldapurl->{$o};
493
    my $searchBase = $config_ldapsearchbase->{$o};
494
    
495
    my $errorMessage = 0;
496
    my $ldap = Net::LDAP->new($ldapurl) or die "$@"; 
497
    my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
498
                                  password => $bindPass );
499
    if ($bindresult->code) {
500
        $errorMessage = "Failed to log in. Are you sure your old " .
501
                        "password is correct? Try again...";
502
        return $errorMessage;
503
    }
504

    
505
    # Find the user here and change their entry
506
    my $newpass = createSeededPassHash($userPass);
507
    my $modifications = { userPassword => $newpass };
508
    my $result = $ldap->modify( $userDN, replace => { %$modifications });
509
    
510
    if ($result->code()) {
511
        my $errorMessage = "There was an error changing the password." .
512
                           "<br />\n" . $result->error;
513
    } 
514
    $ldap->unbind;   # take down session
515

    
516
    return $errorMessage;
517
}
518

    
519
#
520
# generate a Seeded SHA1 hash of a plaintext password
521
#
522
sub createSeededPassHash {
523
    my $secret = shift;
524

    
525
    my $salt = "";
526
    for (my $i=0; $i < 4; $i++) {
527
        $salt .= int(rand(10));
528
    }
529

    
530
    my $ctx = Digest::SHA1->new;
531
    $ctx->add($secret);
532
    $ctx->add($salt);
533
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
534

    
535
    return $hashedPasswd;
536
}
537

    
538
#
539
# Look up an ldap entry for a user
540
#
541
sub getLdapEntry {
542
    my $ldapurl = shift;
543
    my $base = shift;
544
    my $username = shift;
545
    my $org = shift;
546

    
547
    my $entry = "";
548
    my $mesg;
549
    my $ldap = Net::LDAP->new($ldapurl) or die "$@";
550
    my $bindresult = $ldap->bind;
551
    if ($bindresult->code) {
552
        return $entry;
553
    }
554

    
555
    if($config_filter->{$org}){
556
	$mesg = $ldap->search ( base   => $base,
557
				   filter => "(&(uid=$username)($config_filter->{$org}))"
558
				   );
559
    } else {
560
	$mesg = $ldap->search ( base   => $base,
561
				   filter => "(&(uid=$username))"
562
				   );
563
    }
564

    
565
    if ($mesg->count > 0) {
566
        $entry = $mesg->pop_entry;
567
        $ldap->unbind;   # take down session
568
    } else {
569
        $ldap->unbind;   # take down session
570
        # Follow references by recursive call to self
571
        my @references = $mesg->references();
572
        for (my $i = 0; $i <= $#references; $i++) {
573
            my $uri = URI->new($references[$i]);
574
            my $host = $uri->host();
575
            my $path = $uri->path();
576
            $path =~ s/^\///;
577
            $entry = &getLdapEntry($host, $path, $username, $org);
578
            if ($entry) {
579
                return $entry;
580
            }
581
        }
582
    }
583
    return $entry;
584
}
585

    
586
# 
587
# send an email message notifying the user of the pw change
588
#
589
sub sendPasswordNotification {
590
    my $username = shift;
591
    my $org = shift;
592
    my $newPass = shift;
593
    my $recipient = shift;
594

    
595
    my $errorMessage = "";
596
    if ($recipient) {
597
        # Send the email message to them
598
        my $smtp = Net::SMTP->new($mailhost);
599
        $smtp->mail($sender);
600
        $smtp->to($recipient);
601

    
602
        my $message = <<"        ENDOFMESSAGE";
603
        To: $recipient
604
        From: $sender
605
        Subject: KNB Password Reset
606
        
607
        Somebody (hopefully you) requested that your KNB password be reset.  
608
        This is generally done when somebody forgets their password.  Your 
609
        password can be changed by visiting the following URL:
610

    
611
        @cgiurl@?stage=changepass
612

    
613
            Username: $username
614
        Organization: $org
615
        New Password: $newPass
616

    
617
        Thanks,
618
            The KNB Development Team
619
    
620
        ENDOFMESSAGE
621
        $message =~ s/^[ \t\r\f]+//gm;
622
    
623
        $smtp->data($message);
624
        $smtp->quit;
625
    } else {
626
        $errorMessage = "Failed to send password because I " .
627
                        "couldn't find a valid email address.";
628
    }
629
    return $errorMessage;
630
}
631

    
632
#
633
# search the LDAP directory to see if a similar account already exists
634
#
635
sub findExistingAccounts {
636
    my $ldapurl = shift;
637
    my $base = shift;
638
    my $filter = shift;
639
    my $attref = shift;
640

    
641
    my $foundAccounts = 0;
642

    
643
    my $ldap = Net::LDAP->new($ldapurl) or die "$@";
644
    $ldap->bind( version => 3, anonymous => 1);
645
    my $mesg = $ldap->search (
646
        base   => $base,
647
        filter => $filter,
648
        attrs => @$attref,
649
    );
650

    
651
    if ($mesg->count() > 0) {
652
        $foundAccounts = "";
653
        my $entry;
654
        foreach $entry ($mesg->all_entries) { 
655
            $foundAccounts .= "<p>\n<b><u>Account:</u> ";
656
            $foundAccounts .= $entry->dn();
657
            $foundAccounts .= "</b><br />\n";
658
            foreach my $attribute ($entry->attributes()) {
659
                $foundAccounts .= "$attribute: ";
660
                $foundAccounts .= $entry->get_value($attribute);
661
                $foundAccounts .= "<br />\n";
662
            }
663
            $foundAccounts .= "</p>\n";
664
        }
665
    }
666
    $ldap->unbind;   # take down session
667

    
668
    # Follow references
669
    my @references = $mesg->references();
670
    for (my $i = 0; $i <= $#references; $i++) {
671
        my $uri = URI->new($references[$i]);
672
        my $host = $uri->host();
673
        my $path = $uri->path();
674
        $path =~ s/^\///;
675
        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
676
        if ($refFound) {
677
            $foundAccounts .= $refFound;
678
        }
679
    }
680

    
681
    #print "<p>Checking referrals...</p>\n";
682
    #my @referrals = $mesg->referrals();
683
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
684
    #for (my $i = 0; $i <= $#referrals; $i++) {
685
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
686
    #}
687

    
688
    return $foundAccounts;
689
}
690

    
691
#
692
# Validate that we have the proper set of input parameters
693
#
694
sub paramsAreValid {
695
    my @pnames = @_;
696

    
697
    my $allValid = 1;
698
    foreach my $parameter (@pnames) {
699
        if (!defined($query->param($parameter)) || 
700
            ! $query->param($parameter) ||
701
            $query->param($parameter) =~ /^\s+$/) {
702
            $allValid = 0;
703
        }
704
    }
705

    
706
    return $allValid;
707
}
708

    
709
#
710
# Bind to LDAP and create a new account using the information provided
711
# by the user
712
#
713
sub createAccount {
714
    my $allParams = shift;
715

    
716
    if ($query->param('o') =~ "LTER") {
717
        $template->process( "@defaultHeader@");
718
        $template->process( "@registerLter@");
719
        $template->process( "@defaultFooter@");
720
    } else {
721

    
722
        # Be sure the passwords match
723
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
724
            my $errorMessage = "The passwords do not match. Try again.";
725
            my $templateVars = { stage => "register",
726
                                 cfg => $cfg,
727
                                 allParams => $allParams,
728
                                 errorMessage => $errorMessage };
729
	    $$templateVars{'orgList'} = \@orglist;
730
            $template->process( "@defaultHeader@", $templateVars);
731
            $template->process( "@registerFailed@", $templateVars);
732
            $template->process( "@register@", $templateVars);
733
            $template->process( "@defaultFooter@", $templateVars);
734
            exit(0);
735
        }
736

    
737
	my $o = $query->param('o');
738

    
739
	my $ldapurl = $config_ldapurl->{$o};
740
	my $root = $config_user->{$o};
741
	my $rootpw = $config_password->{$o};
742
	my $searchBase = $config_ldapsearchbase->{$o};
743
	my $dnBase = $config_dn->{$o};
744

    
745
        my $ldap = Net::LDAP->new($ldapurl) or die "$@";
746
        $ldap->bind( version => 3, dn => $root, password => $rootpw );
747
        #print "Inserting new entry...\n";
748
        my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
749

    
750
        # Create a hashed version of the password
751
        my $shapass = createSeededPassHash($query->param('userPassword'));
752

    
753
        # Do the insertion
754
        my $additions = [ 
755
                'uid'   => $query->param('uid'),
756
                'o'   => $query->param('o'),
757
                'cn'   => join(" ", $query->param('givenName'), 
758
                                    $query->param('sn')),
759
                'sn'   => $query->param('sn'),
760
                'givenName'   => $query->param('givenName'),
761
                'mail' => $query->param('mail'),
762
                'userPassword' => $shapass,
763
                'objectclass' => ['top', 'person', 'organizationalPerson', 
764
                                'inetOrgPerson', 'uidObject' ]
765
            ];
766
        if (defined($query->param('telephoneNumber')) && 
767
            $query->param('telephoneNumber') &&
768
            ! $query->param('telephoneNumber') =~ /^\s+$/) {
769
            $$additions[$#$additions + 1] = 'telephoneNumber';
770
            $$additions[$#$additions + 1] = $query->param('telephoneNumber');
771
        }
772
        if (defined($query->param('title')) && 
773
            $query->param('title') &&
774
            ! $query->param('title') =~ /^\s+$/) {
775
            $$additions[$#$additions + 1] = 'title';
776
            $$additions[$#$additions + 1] = $query->param('title');
777
        }
778
        my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
779
    
780
        if ($result->code()) {
781
            my $templateVars = { stage => "register",
782
                                 cfg => $cfg,
783
                                 allParams => $allParams,
784
                                 errorMessage => $result->error };
785
	    $$templateVars{'orgList'} = \@orglist;
786
            $template->process( "@defaultHeader@", $templateVars);
787
            $template->process( "@registerFailed@", $templateVars);
788
            $templateVars    = { stage => "register",
789
                                 cfg => $cfg,
790
                                 allParams => $allParams };
791
	    $$templateVars{'orgList'} = \@orglist;
792
            $template->process( "@register@", $templateVars);
793
            $template->process( "@defaultFooter@", $templateVars);
794
        } else {
795
	    my $templateVars    = { cfg => $cfg };
796
            $template->process( "@defaultHeader@", $templateVars);
797
            $template->process( "@registerSuccess@", $templateVars);
798
            $template->process( "@defaultFooter@", $templateVars);
799
        }
800

    
801
        $ldap->unbind;   # take down session
802
    }
803
}
804

    
805
sub handleResponseMessage {
806

    
807
  print "Content-type: text/html\n\n";
808
  my $errorMessage = "You provided invalid input to the script. " .
809
                     "Try again please.";
810
  my $templateVars = { stage => "@defaultStage@",
811
                       cfg => $cfg,
812
                       errorMessage => $errorMessage };
813
  $$templateVars{'orgList'} = \@orglist;
814
  $template->process( "@defaultHeader@", $templateVars);
815
  $template->process( "@defaultFooter@", $templateVars);
816
  exit(0);
817
}
818

    
819
#
820
# perform a simple search against the LDAP database using 
821
# a small subset of attributes of each dn and return it
822
# as a table to the calling browser.
823
#
824
sub handleSimpleSearch {
825

    
826
    my $o = $query->param('o');
827

    
828
    my $ldapurl = $config_ldapurl->{$o};
829
    my $searchBase = $config_ldapsearchbase->{$o};
830

    
831
    print "Content-type: text/html\n\n";
832

    
833
    my $allParams = { 
834
                      'cn' => $query->param('cn'),
835
                      'sn' => $query->param('sn'),
836
                      'gn' => $query->param('gn'),
837
                      'o'  => $query->param('o'),
838
                      'facsimiletelephonenumber' 
839
                      => $query->param('facsimiletelephonenumber'),
840
                      'mail' => $query->param('cmail'),
841
                      'telephonenumber' => $query->param('telephonenumber'),
842
                      'title' => $query->param('title'),
843
                      'uid' => $query->param('uid'),
844
                      'ou' => $query->param('ou'),
845
                    };
846

    
847
    # Search LDAP for matching entries that already exist
848
    my $filter = "(" . 
849
                 $query->param('searchField') . "=" .
850
                 "*" .
851
                 $query->param('searchValue') .
852
                 "*" .
853
                 ")";
854

    
855
    my @attrs = [ 'sn', 
856
                  'gn', 
857
                  'cn', 
858
                  'o', 
859
                  'facsimiletelephonenumber', 
860
                  'mail', 
861
                  'telephoneNumber', 
862
                  'title', 
863
                  'uid', 
864
                  'labeledURI', 
865
                  'ou' ];
866

    
867
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
868

    
869
    # Send back the search results
870
    if ($found) {
871
      my $templateVars = { stage => "searchResults",
872
                           cfg => $cfg,
873
                           allParams => $allParams,
874
                           foundAccounts => $found };
875
      $$templateVars{'orgList'} = \@orglist;
876
      $template->process( "@defaultHeader@", $templateVars);
877
      $template->process( "@searchResults@", $templateVars);
878
      $template->process( "@defaultFooter@", $templateVars);
879

    
880
    } else {
881
      $found = "No entries matched your criteria.  Please try again\n";
882

    
883
      my $templateVars = { stage => "searchResults",
884
                           cfg => $cfg,
885
                           allParams => $allParams,
886
                           foundAccounts => $found };
887
      $$templateVars{'orgList'} = \@orglist;
888
      $template->process( "@defaultHeader@", $templateVars);
889
      $template->process( "@searchResults@", $templateVars);
890
      $template->process( "@defaultFooter@", $templateVars);
891

    
892
    }
893

    
894
    exit();
895
}
896

    
897
#
898
# search the LDAP directory to see if a similar account already exists
899
#
900
sub searchDirectory {
901
    my $ldapurl = shift;
902
    my $base = shift;
903
    my $filter = shift;
904
    my $attref = shift;
905

    
906
    my $foundAccounts = 0;
907

    
908
    my $ldap = Net::LDAP->new($ldapurl) or die "$@";
909
    $ldap->bind( version => 3, anonymous => 1);
910
    my $mesg = $ldap->search (
911
        base   => $base,
912
        filter => $filter,
913
        attrs => @$attref,
914
    );
915

    
916
    if ($mesg->count() > 0) {
917
        $foundAccounts = "";
918
        my $entry;
919
        foreach $entry ($mesg->sorted(['sn'])) {
920
          $foundAccounts .= "<tr>\n<td class=\"main\">\n";
921
          $foundAccounts .= "<a href=\"" unless 
922
                    (!$entry->get_value('labeledURI'));
923
          $foundAccounts .= $entry->get_value('labeledURI') unless
924
                    (!$entry->get_value('labeledURI'));
925
          $foundAccounts .= "\">\n" unless 
926
                    (!$entry->get_value('labeledURI'));
927
          $foundAccounts .= $entry->get_value('givenName');
928
          $foundAccounts .= "</a>\n" unless 
929
                    (!$entry->get_value('labeledURI'));
930
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
931
          $foundAccounts .= "<a href=\"" unless 
932
                    (!$entry->get_value('labeledURI'));
933
          $foundAccounts .= $entry->get_value('labeledURI') unless
934
                    (!$entry->get_value('labeledURI'));
935
          $foundAccounts .= "\">\n" unless 
936
                    (!$entry->get_value('labeledURI'));
937
          $foundAccounts .= $entry->get_value('sn');
938
          $foundAccounts .= "</a>\n";
939
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
940
          $foundAccounts .= $entry->get_value('mail');
941
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
942
          $foundAccounts .= $entry->get_value('telephonenumber');
943
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
944
          $foundAccounts .= $entry->get_value('title');
945
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
946
          $foundAccounts .= $entry->get_value('ou');
947
          $foundAccounts .= "\n</td>\n";
948
          $foundAccounts .= "</tr>\n";
949
        }
950
    }
951
    $ldap->unbind;   # take down session
952
    return $foundAccounts;
953
}
954

    
955
sub debug {
956
    my $msg = shift;
957
    
958
    if ($debug) {
959
        print STDERR "$msg\n";
960
    }
961
}
(5-5/8)