Project

General

Profile

1
#!/usr/bin/perl -w
2
 #
3
 #  '$RCSfile$'
4
 #  Copyright: 2001 Regents of the University of California 
5
 #
6
 #   '$Author: jones $'
7
 #     '$Date: 2006-04-03 02:48:06 -0700 (Mon, 03 Apr 2006) $'
8
 # '$Revision: 2972 $' 
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
              'changepass'        => \&handleChangePassword,
116
              'initchangepass'    => \&handleInitialChangePassword,
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
                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
                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
        $$templateVars{'orgList'} = \@orglist;
339
        $template->process( "@defaultHeader@", $templateVars);
340
        $template->process( "@defaultChangePass@", $templateVars);
341
        $template->process( "@defaultFooter@", $templateVars);
342
        exit(0);
343
    }
344
}
345

    
346
#
347
# 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
# 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
        my $o = $query->param('o');
380
        
381
        $ldapurl = $config_ldapurl->{$o};
382
        $searchBase = $config_ldapsearchbase->{$o};
383
        $root = $config_user->{$o};
384
        $rootpw = $config_password->{$o};
385
    }
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
        $$templateVars{'orgList'} = \@orglist;
397
        $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
            $$templateVars{'orgList'} = \@orglist;
432
            $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
                    $query->param('o'), $userPass, $recipient, $cfg);
439
            my $templateVars = { stage => "resetpass",
440
                                 cfg => $cfg,
441
                                 allParams => $allParams,
442
                                 errorMessage => $errorMessage };
443
            $$templateVars{'orgList'} = \@orglist;
444
            $template->process( "@defaultHeader@", $templateVars);
445
            $template->process( "@resetPassSuccess@", $templateVars);
446
            $template->process( "@defaultFooter@", $templateVars);
447
            exit(0);
448
        }
449
    }
450
}
451

    
452
#
453
# 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
# 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
    #$ldap->start_tls( verify => 'require',
502
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
503
    $ldap->start_tls( verify => 'none');
504
    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
    $ldap->start_tls( verify => 'none');
558
    my $bindresult = $ldap->bind;
559
    if ($bindresult->code) {
560
        return $entry;
561
    }
562

    
563
    if($config_filter->{$org}){
564
        $mesg = $ldap->search ( base   => $base,
565
                filter => "(&(uid=$username)($config_filter->{$org}))");
566
    } else {
567
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
568
    }
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
    my $cfg = shift;
600

    
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
        @cgiurl@?stage=changepass&cfg=$cfg
618

    
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
    $ldap->start_tls( verify => 'none');
651
    $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
            $$templateVars{'orgList'} = \@orglist;
737
            $template->process( "@defaultHeader@", $templateVars);
738
            $template->process( "@registerFailed@", $templateVars);
739
            $template->process( "@register@", $templateVars);
740
            $template->process( "@defaultFooter@", $templateVars);
741
            exit(0);
742
        }
743

    
744
        my $o = $query->param('o');
745

    
746
        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

    
752
        my $ldap = Net::LDAP->new($ldapurl) or die "$@";
753
        $ldap->start_tls( verify => 'none');
754
        $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
            $$templateVars{'orgList'} = \@orglist;
794
            $template->process( "@defaultHeader@", $templateVars);
795
            $template->process( "@registerFailed@", $templateVars);
796
            $templateVars    = { stage => "register",
797
                                 cfg => $cfg,
798
                                 allParams => $allParams };
799
            $$templateVars{'orgList'} = \@orglist;
800
            $template->process( "@register@", $templateVars);
801
            $template->process( "@defaultFooter@", $templateVars);
802
        } else {
803
            my $templateVars    = { cfg => $cfg };
804
            $template->process( "@defaultHeader@", $templateVars);
805
            $template->process( "@registerSuccess@", $templateVars);
806
            $template->process( "@defaultFooter@", $templateVars);
807
        }
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
    $ldap->start_tls( verify => 'none');
918
    $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
}
(5-5/8)