Project

General

Profile

1
#!/usr/bin/perl -w
2
 #
3
 #  '$RCSfile$'
4
 #  Copyright: 2001 Regents of the University of California 
5
 #
6
 #   '$Author: tao $'
7
 #     '$Date: 2007-02-11 17:22:05 -0800 (Sun, 11 Feb 2007) $'
8
 # '$Revision: 3177 $' 
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 $mainldapurl = "@ldapurl@";
43
my $root = "@user@";
44
my $rootpw = "@password@";
45
my $searchBase = "@ldapSearchBase@";
46
my $templatesDir = "@templates.dir@";
47
my $mailhost = "@mailhost@";
48
my $sender = "@sender@";
49
my $TIMEOUT = 20;
50
my $mainldapdownmessage = "The main ldap server " . $mainldapurl . " is down!";
51

    
52
# Get the CGI input variables
53
my $query = new CGI;
54

    
55
my $debug = 0;
56

    
57
#--------------------------------------------------------------------------80c->
58
# Set up the Template Toolkit to read html form templates
59

    
60

    
61
# set some configuration options for the template object
62
my $config_templates = {
63
             INCLUDE_PATH => $templatesDir, 
64
             INTERPOLATE  => 0,                    
65
             POST_CHOMP   => 1,                   
66
             };
67

    
68
# create an instance of the template
69
my $template = Template->new($config_templates) || handleGeneralServerFailure($Template::ERROR);
70

    
71
# Read the ldapweb.cfg file
72
my $config = AppConfig->new({ 
73
    GLOBAL => { ARGCOUNT => ARGCOUNT_ONE, } });
74

    
75
$config->define("ldapurl", { ARGCOUNT => ARGCOUNT_HASH} );           
76
$config->define("ldapsearchbase", { ARGCOUNT => ARGCOUNT_HASH} );
77
$config->define("dn", { ARGCOUNT => ARGCOUNT_HASH} );
78
$config->define("filter", { ARGCOUNT => ARGCOUNT_HASH} );
79
$config->define("user", { ARGCOUNT => ARGCOUNT_HASH} );
80
$config->define("password", { ARGCOUNT => ARGCOUNT_HASH} );
81

    
82
my $cfgfile = "ldapweb.cfg";
83
$config->file($cfgfile);
84
my $config_ldapurl = $config->get('ldapurl');
85
my $config_ldapsearchbase = $config->get('ldapsearchbase');
86
my $config_dn = $config->get('dn');
87
my $config_filter = $config->get('filter');
88
my $config_user = $config->get('user');
89
my $config_password = $config->get('password');
90

    
91
my @orglist;
92
foreach my $neworg (keys %$config_dn) {
93
    push(@orglist, $neworg);
94
    debug($neworg);
95
}
96

    
97

    
98
#--------------------------------------------------------------------------80c->
99
# Define the main program logic that calls subroutines to do the work
100
#--------------------------------------------------------------------------80c->
101

    
102

    
103
# The processing step we are handling
104
my $stage = $query->param('stage') || '@defaultStage@';
105

    
106
my $cfg = $query->param('cfg');
107

    
108
# define the possible stages
109
my %stages = (
110
              'initregister'      => \&handleInitRegister,
111
              'register'          => \&handleRegister,
112
              'registerconfirmed' => \&handleRegisterConfirmed,
113
              'simplesearch'      => \&handleSimpleSearch,
114
              'initaddentry'      => \&handleInitAddEntry,
115
              'addentry'          => \&handleAddEntry,
116
              'initmodifyentry'   => \&handleInitModifyEntry,
117
              'modifyentry'       => \&handleModifyEntry,
118
              'changepass'        => \&handleChangePassword,
119
              'initchangepass'    => \&handleInitialChangePassword,
120
              'resetpass'         => \&handleResetPassword,
121
              'initresetpass'     => \&handleInitialResetPassword,
122
             );
123
# call the appropriate routine based on the stage
124
if ( $stages{$stage} ) {
125
  $stages{$stage}->();
126
} else {
127
  &handleResponseMessage();
128
}
129

    
130
#--------------------------------------------------------------------------80c->
131
# Define the subroutines to do the work
132
#--------------------------------------------------------------------------80c->
133

    
134

    
135
#
136
# create the initial registration form 
137
#
138
sub handleInitRegister {
139
  my $vars = shift;
140

    
141
  print "Content-type: text/html\n\n";
142
  # process the template files:
143
  my $templateVars = { stage => "register", cfg => $cfg };
144
  #$$templateVars{'orgList'} = \@orglist;
145
  $$templateVars{'orgList'} = \@orglist;
146
  $template->process( "@defaultHeader@", $templateVars);
147
  $template->process( "@register@", $templateVars);
148
  $template->process( "@defaultFooter@", $templateVars);
149

    
150
  exit();
151
}
152

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

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

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

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

    
212
    my @attrs = [ 'uid', 'o', 'cn', 'mail', 'telephoneNumber', 'title' ];
213
    my $found = findExistingAccounts($ldapurl, $searchBase, $filter, \@attrs);
214

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

    
227
    # Otherwise, create a new user in the LDAP directory
228
    } else {
229
        #print("ingore create account\n");
230
        createAccount($allParams);
231
    }
232

    
233
    exit();
234
}
235

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

    
256
    exit();
257
}
258

    
259
#
260
# change a user's password upon request
261
#
262
sub handleChangePassword {
263

    
264
    print "Content-type: text/html\n\n";
265

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

    
278

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

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

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

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

    
349
#
350
# change a user's password upon request - no input params
351
# only display chagepass template without any error
352
#
353
sub handleInitialChangePassword {
354
    print "Content-type: text/html\n\n";
355

    
356
    my $allParams = { 'test' => "1", };
357
    my $errorMessage = "";
358
    my $templateVars = { stage => "changepass",
359
                         cfg => $cfg,
360
                         allParams => $allParams,
361
                         errorMessage => $errorMessage };
362
    $$templateVars{'orgList'} = \@orglist;
363
    $template->process( "@defaultHeader@", $templateVars);
364
    $template->process( "@defaultChangePass@", $templateVars);
365
    $template->process( "@defaultFooter@", $templateVars);
366
    exit(0);
367
}
368

    
369
#
370
# reset a user's password upon request
371
#
372
sub handleResetPassword {
373

    
374
    print "Content-type: text/html\n\n";
375

    
376
    my $allParams = { 'test' => "1", };
377
    if ($query->param('uid')) {
378
        $$allParams{'uid'} = $query->param('uid');
379
    }
380
    if ($query->param('o')) {
381
        $$allParams{'o'} = $query->param('o');
382
        my $o = $query->param('o');
383
        
384
        $ldapurl = $config_ldapurl->{$o};
385
        $searchBase = $config_ldapsearchbase->{$o};
386
        $root = $config_user->{$o};
387
        $rootpw = $config_password->{$o};
388
    }
389

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

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

    
421
        if ($entry) {
422
            $recipient = $entry->get_value('mail');
423
            $userPass = getRandomPassword();
424
            $errorMessage = changePassword($dn, $userPass, $root, $rootpw, $query->param('o'));
425
        } else {
426
            $errorMessage = "User not found in database.  Please try again.";
427
        }
428

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

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

    
474
#
475
# Construct a random string to use for a newly reset password
476
#
477
sub getRandomPassword {
478
    my $length = shift;
479
    if (!$length) {
480
        $length = 8;
481
    }
482
    my $newPass = "";
483

    
484
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
485
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
486
    return $newPass;
487
}
488

    
489
#
490
# Change a password to a new value, binding as the provided user
491
#
492
sub changePassword {
493
    my $userDN = shift;
494
    my $userPass = shift;
495
    my $bindDN = shift;
496
    my $bindPass = shift;
497
    my $o = shift;
498

    
499
    my $ldapurl = $config_ldapurl->{$o};
500
    my $searchBase = $config_ldapsearchbase->{$o};
501
    
502
    my $errorMessage = 0;
503
    my $ldap;
504
    if ($ldapurl =~ $mainldapurl){
505
        #if main ldap server is down, a html file containing warning message will be returned
506
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
507
    }
508
    else{
509
        #if a referral ldap server is down, we will ignore it silently
510
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
511
    } 
512
    #$ldap->start_tls( verify => 'require',
513
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
514
    $ldap->start_tls( verify => 'none');
515
    my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
516
                                  password => $bindPass );
517
    if ($bindresult->code) {
518
        $errorMessage = "Failed to log in. Are you sure your old " .
519
                        "password is correct? Try again...";
520
        return $errorMessage;
521
    }
522

    
523
    # Find the user here and change their entry
524
    my $newpass = createSeededPassHash($userPass);
525
    my $modifications = { userPassword => $newpass };
526
    my $result = $ldap->modify( $userDN, replace => { %$modifications });
527
    
528
    if ($result->code()) {
529
        my $errorMessage = "There was an error changing the password." .
530
                           "<br />\n" . $result->error;
531
    } 
532
    $ldap->unbind;   # take down session
533

    
534
    return $errorMessage;
535
}
536

    
537
#
538
# generate a Seeded SHA1 hash of a plaintext password
539
#
540
sub createSeededPassHash {
541
    my $secret = shift;
542

    
543
    my $salt = "";
544
    for (my $i=0; $i < 4; $i++) {
545
        $salt .= int(rand(10));
546
    }
547

    
548
    my $ctx = Digest::SHA1->new;
549
    $ctx->add($secret);
550
    $ctx->add($salt);
551
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
552

    
553
    return $hashedPasswd;
554
}
555

    
556
#
557
# Look up an ldap entry for a user
558
#
559
sub getLdapEntry {
560
    my $ldapurl = shift;
561
    my $base = shift;
562
    my $username = shift;
563
    my $org = shift;
564

    
565
    my $entry = "";
566
    my $mesg;
567
    my $ldap;
568
    print("ldap server ", $ldapurl, "\n");
569
    if ($ldapurl =~ $mainldapurl){
570
        #if main ldap server is down, a html file containing warning message will be returned
571
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
572
    }
573
    else{
574
        #if a referral ldap server is down, we will ignore it silently
575
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
576
    }
577
    $ldap->start_tls( verify => 'none');
578
    my $bindresult = $ldap->bind;
579
    if ($bindresult->code) {
580
        return $entry;
581
    }
582

    
583
    if($config_filter->{$org}){
584
        $mesg = $ldap->search ( base   => $base,
585
                filter => "(&(uid=$username)($config_filter->{$org}))");
586
    } else {
587
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
588
    }
589
    
590
    if ($mesg->count > 0) {
591
        $entry = $mesg->pop_entry;
592
        $ldap->unbind;   # take down session
593
    } else {
594
        $ldap->unbind;   # take down session
595
        # Follow references by recursive call to self
596
        my @references = $mesg->references();
597
        for (my $i = 0; $i <= $#references; $i++) {
598
            my $uri = URI->new($references[$i]);
599
            my $host = $uri->host();
600
            my $path = $uri->path();
601
            $path =~ s/^\///;
602
            $entry = &getLdapEntry($host, $path, $username, $org);
603
            if ($entry) {
604
                return $entry;
605
            }
606
        }
607
    }
608
    return $entry;
609
}
610

    
611
# 
612
# send an email message notifying the user of the pw change
613
#
614
sub sendPasswordNotification {
615
    my $username = shift;
616
    my $org = shift;
617
    my $newPass = shift;
618
    my $recipient = shift;
619
    my $cfg = shift;
620

    
621
    my $errorMessage = "";
622
    if ($recipient) {
623
        # Send the email message to them
624
        my $smtp = Net::SMTP->new($mailhost);
625
        $smtp->mail($sender);
626
        $smtp->to($recipient);
627

    
628
        my $message = <<"        ENDOFMESSAGE";
629
        To: $recipient
630
        From: $sender
631
        Subject: KNB Password Reset
632
        
633
        Somebody (hopefully you) requested that your KNB password be reset.  
634
        This is generally done when somebody forgets their password.  Your 
635
        password can be changed by visiting the following URL:
636

    
637
        @cgiurl@?stage=changepass&cfg=$cfg
638

    
639
            Username: $username
640
        Organization: $org
641
        New Password: $newPass
642

    
643
        Thanks,
644
            The KNB Development Team
645
    
646
        ENDOFMESSAGE
647
        $message =~ s/^[ \t\r\f]+//gm;
648
    
649
        $smtp->data($message);
650
        $smtp->quit;
651
    } else {
652
        $errorMessage = "Failed to send password because I " .
653
                        "couldn't find a valid email address.";
654
    }
655
    return $errorMessage;
656
}
657

    
658
#
659
# search the LDAP directory to see if a similar account already exists
660
#
661
sub findExistingAccounts {
662
    my $ldapurl = shift;
663
    my $base = shift;
664
    my $filter = shift;
665
    my $attref = shift;
666
    my $ldap;
667

    
668
    my $foundAccounts = 0;
669
    #print("the ldapurl in findExstingAccounts is ", $ldapurl, "\n");
670
    if ($ldapurl =~ $mainldapurl){
671
        #if main ldap server is down, a html file containing warning message will be returned
672
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
673
    }
674
    else{
675
        #if a referral ldap server is down, we will ignore it silently
676
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
677
    }
678
    $ldap->start_tls( verify => 'none');
679
    $ldap->bind( version => 3, anonymous => 1);
680
    my $mesg = $ldap->search (
681
        base   => $base,
682
        filter => $filter,
683
        attrs => @$attref,
684
    );
685

    
686
    if ($mesg->count() > 0) {
687
        $foundAccounts = "";
688
        my $entry;
689
        foreach $entry ($mesg->all_entries) { 
690
            $foundAccounts .= "<p>\n<b><u>Account:</u> ";
691
            $foundAccounts .= $entry->dn();
692
            $foundAccounts .= "</b><br />\n";
693
            foreach my $attribute ($entry->attributes()) {
694
                $foundAccounts .= "$attribute: ";
695
                $foundAccounts .= $entry->get_value($attribute);
696
                $foundAccounts .= "<br />\n";
697
            }
698
            $foundAccounts .= "</p>\n";
699
        }
700
    }
701
    $ldap->unbind;   # take down session
702

    
703
    # Follow references
704
    my @references = $mesg->references();
705
    for (my $i = 0; $i <= $#references; $i++) {
706
        my $uri = URI->new($references[$i]);
707
        my $host = $uri->host();
708
        my $path = $uri->path();
709
        $path =~ s/^\///;
710
        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
711
        if ($refFound) {
712
            $foundAccounts .= $refFound;
713
        }
714
    }
715

    
716
    #print "<p>Checking referrals...</p>\n";
717
    #my @referrals = $mesg->referrals();
718
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
719
    #for (my $i = 0; $i <= $#referrals; $i++) {
720
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
721
    #}
722

    
723
    return $foundAccounts;
724
}
725

    
726
#
727
# Validate that we have the proper set of input parameters
728
#
729
sub paramsAreValid {
730
    my @pnames = @_;
731

    
732
    my $allValid = 1;
733
    foreach my $parameter (@pnames) {
734
        if (!defined($query->param($parameter)) || 
735
            ! $query->param($parameter) ||
736
            $query->param($parameter) =~ /^\s+$/) {
737
            $allValid = 0;
738
        }
739
    }
740

    
741
    return $allValid;
742
}
743

    
744
#
745
# Bind to LDAP and create a new account using the information provided
746
# by the user
747
#
748
sub createAccount {
749
    my $allParams = shift;
750

    
751
    if ($query->param('o') =~ "LTER") {
752
        $template->process( "@defaultHeader@");
753
        $template->process( "@registerLter@");
754
        $template->process( "@defaultFooter@");
755
    } else {
756

    
757
        # Be sure the passwords match
758
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
759
            my $errorMessage = "The passwords do not match. Try again.";
760
            my $templateVars = { stage => "register",
761
                                 cfg => $cfg,
762
                                 allParams => $allParams,
763
                                 errorMessage => $errorMessage };
764
            $$templateVars{'orgList'} = \@orglist;
765
            $template->process( "@defaultHeader@", $templateVars);
766
            $template->process( "@registerFailed@", $templateVars);
767
            $template->process( "@register@", $templateVars);
768
            $template->process( "@defaultFooter@", $templateVars);
769
            exit(0);
770
        }
771

    
772
        my $o = $query->param('o');
773

    
774
        my $ldapurl = $config_ldapurl->{$o};
775
        my $root = $config_user->{$o};
776
        my $rootpw = $config_password->{$o};
777
        my $searchBase = $config_ldapsearchbase->{$o};
778
        my $dnBase = $config_dn->{$o};
779

    
780
        
781
        #if main ldap server is down, a html file containing warning message will be returned
782
        my $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
783
        
784
        
785
        $ldap->start_tls( verify => 'none');
786
        $ldap->bind( version => 3, dn => $root, password => $rootpw );
787
        #print "Inserting new entry...\n";
788
        my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
789

    
790
        # Create a hashed version of the password
791
        my $shapass = createSeededPassHash($query->param('userPassword'));
792

    
793
        # Do the insertion
794
        my $additions = [ 
795
                'uid'   => $query->param('uid'),
796
                'o'   => $query->param('o'),
797
                'cn'   => join(" ", $query->param('givenName'), 
798
                                    $query->param('sn')),
799
                'sn'   => $query->param('sn'),
800
                'givenName'   => $query->param('givenName'),
801
                'mail' => $query->param('mail'),
802
                'userPassword' => $shapass,
803
                'objectclass' => ['top', 'person', 'organizationalPerson', 
804
                                'inetOrgPerson', 'uidObject' ]
805
            ];
806
        if (defined($query->param('telephoneNumber')) && 
807
            $query->param('telephoneNumber') &&
808
            ! $query->param('telephoneNumber') =~ /^\s+$/) {
809
            $$additions[$#$additions + 1] = 'telephoneNumber';
810
            $$additions[$#$additions + 1] = $query->param('telephoneNumber');
811
        }
812
        if (defined($query->param('title')) && 
813
            $query->param('title') &&
814
            ! $query->param('title') =~ /^\s+$/) {
815
            $$additions[$#$additions + 1] = 'title';
816
            $$additions[$#$additions + 1] = $query->param('title');
817
        }
818
        my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
819
    
820
        if ($result->code()) {
821
            my $templateVars = { stage => "register",
822
                                 cfg => $cfg,
823
                                 allParams => $allParams,
824
                                 errorMessage => $result->error };
825
            $$templateVars{'orgList'} = \@orglist;
826
            $template->process( "@defaultHeader@", $templateVars);
827
            $template->process( "@registerFailed@", $templateVars);
828
            $templateVars    = { stage => "register",
829
                                 cfg => $cfg,
830
                                 allParams => $allParams };
831
            $$templateVars{'orgList'} = \@orglist;
832
            $template->process( "@register@", $templateVars);
833
            $template->process( "@defaultFooter@", $templateVars);
834
        } else {
835
            my $templateVars    = { cfg => $cfg };
836
            $template->process( "@defaultHeader@", $templateVars);
837
            $template->process( "@registerSuccess@", $templateVars);
838
            $template->process( "@defaultFooter@", $templateVars);
839
        }
840

    
841
        $ldap->unbind;   # take down session
842
    }
843
}
844

    
845
sub handleResponseMessage {
846

    
847
  print "Content-type: text/html\n\n";
848
  my $errorMessage = "You provided invalid input to the script. " .
849
                     "Try again please.";
850
  my $templateVars = { stage => "@defaultStage@",
851
                       cfg => $cfg,
852
                       errorMessage => $errorMessage };
853
  $$templateVars{'orgList'} = \@orglist;
854
  $template->process( "@defaultHeader@", $templateVars);
855
  $template->process( "@defaultFooter@", $templateVars);
856
  exit(0);
857
}
858

    
859
#
860
# perform a simple search against the LDAP database using 
861
# a small subset of attributes of each dn and return it
862
# as a table to the calling browser.
863
#
864
sub handleSimpleSearch {
865

    
866
    my $o = $query->param('o');
867

    
868
    my $ldapurl = $config_ldapurl->{$o};
869
    my $searchBase = $config_ldapsearchbase->{$o};
870

    
871
    print "Content-type: text/html\n\n";
872

    
873
    my $allParams = { 
874
                      'cn' => $query->param('cn'),
875
                      'sn' => $query->param('sn'),
876
                      'gn' => $query->param('gn'),
877
                      'o'  => $query->param('o'),
878
                      'facsimiletelephonenumber' 
879
                      => $query->param('facsimiletelephonenumber'),
880
                      'mail' => $query->param('cmail'),
881
                      'telephonenumber' => $query->param('telephonenumber'),
882
                      'title' => $query->param('title'),
883
                      'uid' => $query->param('uid'),
884
                      'ou' => $query->param('ou'),
885
                    };
886

    
887
    # Search LDAP for matching entries that already exist
888
    my $filter = "(" . 
889
                 $query->param('searchField') . "=" .
890
                 "*" .
891
                 $query->param('searchValue') .
892
                 "*" .
893
                 ")";
894

    
895
    my @attrs = [ 'sn', 
896
                  'gn', 
897
                  'cn', 
898
                  'o', 
899
                  'facsimiletelephonenumber', 
900
                  'mail', 
901
                  'telephoneNumber', 
902
                  'title', 
903
                  'uid', 
904
                  'labeledURI', 
905
                  'ou' ];
906

    
907
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
908

    
909
    # Send back the search results
910
    if ($found) {
911
      my $templateVars = { stage => "searchResults",
912
                           cfg => $cfg,
913
                           allParams => $allParams,
914
                           foundAccounts => $found };
915
      $$templateVars{'orgList'} = \@orglist;
916
      $template->process( "@defaultHeader@", $templateVars);
917
      $template->process( "@searchResults@", $templateVars);
918
      $template->process( "@defaultFooter@", $templateVars);
919

    
920
    } else {
921
      $found = "No entries matched your criteria.  Please try again\n";
922

    
923
      my $templateVars = { stage => "searchResults",
924
                           cfg => $cfg,
925
                           allParams => $allParams,
926
                           foundAccounts => $found };
927
      $$templateVars{'orgList'} = \@orglist;
928
      $template->process( "@defaultHeader@", $templateVars);
929
      $template->process( "@searchResults@", $templateVars);
930
      $template->process( "@defaultFooter@", $templateVars);
931

    
932
    }
933

    
934
    exit();
935
}
936

    
937
#
938
# search the LDAP directory to see if a similar account already exists
939
#
940
sub searchDirectory {
941
    my $ldapurl = shift;
942
    my $base = shift;
943
    my $filter = shift;
944
    my $attref = shift;
945

    
946
    my $foundAccounts = 0;
947

    
948
    
949
    
950
    #if ldap server is down, a html file containing warning message will be returned
951
    my $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
952
    
953
    $ldap->start_tls( verify => 'none');
954
    $ldap->bind( version => 3, anonymous => 1);
955
    my $mesg = $ldap->search (
956
        base   => $base,
957
        filter => $filter,
958
        attrs => @$attref,
959
    );
960

    
961
    if ($mesg->count() > 0) {
962
        $foundAccounts = "";
963
        my $entry;
964
        foreach $entry ($mesg->sorted(['sn'])) {
965
          $foundAccounts .= "<tr>\n<td class=\"main\">\n";
966
          $foundAccounts .= "<a href=\"" unless 
967
                    (!$entry->get_value('labeledURI'));
968
          $foundAccounts .= $entry->get_value('labeledURI') unless
969
                    (!$entry->get_value('labeledURI'));
970
          $foundAccounts .= "\">\n" unless 
971
                    (!$entry->get_value('labeledURI'));
972
          $foundAccounts .= $entry->get_value('givenName');
973
          $foundAccounts .= "</a>\n" unless 
974
                    (!$entry->get_value('labeledURI'));
975
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
976
          $foundAccounts .= "<a href=\"" unless 
977
                    (!$entry->get_value('labeledURI'));
978
          $foundAccounts .= $entry->get_value('labeledURI') unless
979
                    (!$entry->get_value('labeledURI'));
980
          $foundAccounts .= "\">\n" unless 
981
                    (!$entry->get_value('labeledURI'));
982
          $foundAccounts .= $entry->get_value('sn');
983
          $foundAccounts .= "</a>\n";
984
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
985
          $foundAccounts .= $entry->get_value('mail');
986
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
987
          $foundAccounts .= $entry->get_value('telephonenumber');
988
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
989
          $foundAccounts .= $entry->get_value('title');
990
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
991
          $foundAccounts .= $entry->get_value('ou');
992
          $foundAccounts .= "\n</td>\n";
993
          $foundAccounts .= "</tr>\n";
994
        }
995
    }
996
    $ldap->unbind;   # take down session
997
    return $foundAccounts;
998
}
999

    
1000
sub debug {
1001
    my $msg = shift;
1002
    
1003
    if ($debug) {
1004
        print STDERR "$msg\n";
1005
    }
1006
}
1007

    
1008
sub handleGeneralServerFailure {
1009
    my $errorMessage = shift;
1010
    my $templateVars = { cfg => $cfg,
1011
                         errorMessage => $errorMessage };
1012
    $template->process( "@defaultHeader@", $templateVars);
1013
    $template->process( "@ldapMainServerFailure@", $templateVars);
1014
    $template->process( "@defaultFooter@", $templateVars);
1015
    exit(0);   
1016
   }
1017
    
1018

    
(7-7/10)