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-03-16 15:37:21 -0800 (Wed, 16 Mar 2005) $'
8
 # '$Revision: 2414 $' 
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
  $template->process( "@defaultHeader@", $templateVars);
143
  $template->process( "@register@", $templateVars);
144
  $template->process( "@defaultFooter@", $templateVars);
145

    
146
  exit();
147
}
148

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

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

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

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

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

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

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

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

    
229
    exit();
230
}
231

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

    
251
    exit();
252
}
253

    
254
#
255
# change a user's password upon request
256
#
257
sub handleChangePassword {
258

    
259
    print "Content-type: text/html\n\n";
260

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

    
273

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

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

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

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

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

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

    
360
#
361
# reset a user's password upon request
362
#
363
sub handleResetPassword {
364

    
365
    print "Content-type: text/html\n\n";
366

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

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

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

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

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

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

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

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

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

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

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

    
514
    return $errorMessage;
515
}
516

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

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

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

    
533
    return $hashedPasswd;
534
}
535

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

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

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

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

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

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

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

    
609
        @cgiurl@?stage=changepass
610

    
611
            Username: $username
612
        Organization: $org
613
        New Password: $newPass
614

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

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

    
639
    my $foundAccounts = 0;
640

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

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

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

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

    
686
    return $foundAccounts;
687
}
688

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

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

    
704
    return $allValid;
705
}
706

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

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

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

    
734
	my $o = $query->param('o');
735

    
736
	my $ldapurl = $config_ldapurl->{$o};
737
	my $root = $config_user->{$o};
738
	my $rootpw = $config_password->{$o};
739
	my $searchBase = $config_ldapsearchbase->{$o};
740
	my $dnBase = $config_dn->{$o};
741

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

    
747
        # Create a hashed version of the password
748
        my $shapass = createSeededPassHash($query->param('userPassword'));
749

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

    
798
        $ldap->unbind;   # take down session
799
    }
800
}
801

    
802
sub handleResponseMessage {
803

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

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

    
823
    my $o = $query->param('o');
824

    
825
    my $ldapurl = $config_ldapurl->{$o};
826
    my $searchBase = $config_ldapsearchbase->{$o};
827

    
828
    print "Content-type: text/html\n\n";
829

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

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

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

    
864
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
865

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

    
877
    } else {
878
      $found = "No entries matched your criteria.  Please try again\n";
879

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

    
889
    }
890

    
891
    exit();
892
}
893

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

    
903
    my $foundAccounts = 0;
904

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

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

    
952
sub debug {
953
    my $msg = shift;
954
    
955
    if ($debug) {
956
        print STDERR "$msg\n";
957
    }
958
}
(2-2/5)