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: 2008-06-18 16:30:39 -0700 (Wed, 18 Jun 2008) $'
8
 # '$Revision: 4010 $' 
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
# 1.8.1 temporary baseUrl fix
53
my $baseUrl = "@systemidserver@@servlet-path@";
54
$baseUrl =~ s/metacat$//;
55

    
56
# Get the CGI input variables
57
my $query = new CGI;
58

    
59
my $debug = 0;
60

    
61
#--------------------------------------------------------------------------80c->
62
# Set up the Template Toolkit to read html form templates
63

    
64

    
65
# set some configuration options for the template object
66
my $config_templates = {
67
             INCLUDE_PATH => $templatesDir, 
68
             INTERPOLATE  => 0,                    
69
             POST_CHOMP   => 1,                   
70
             };
71

    
72
# create an instance of the template
73
my $template = Template->new($config_templates) || handleGeneralServerFailure($Template::ERROR);
74

    
75
# Read the ldapweb.cfg file
76
my $config = AppConfig->new({ 
77
    GLOBAL => { ARGCOUNT => ARGCOUNT_ONE, } });
78

    
79
$config->define("ldapurl", { ARGCOUNT => ARGCOUNT_HASH} );           
80
$config->define("ldapsearchbase", { ARGCOUNT => ARGCOUNT_HASH} );
81
$config->define("dn", { ARGCOUNT => ARGCOUNT_HASH} );
82
$config->define("filter", { ARGCOUNT => ARGCOUNT_HASH} );
83
$config->define("user", { ARGCOUNT => ARGCOUNT_HASH} );
84
$config->define("password", { ARGCOUNT => ARGCOUNT_HASH} );
85

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

    
95
my @orglist;
96
foreach my $neworg (keys %$config_dn) {
97
    push(@orglist, $neworg);
98
    debug($neworg);
99
}
100

    
101

    
102
#--------------------------------------------------------------------------80c->
103
# Define the main program logic that calls subroutines to do the work
104
#--------------------------------------------------------------------------80c->
105

    
106

    
107
# The processing step we are handling
108
my $stage = $query->param('stage') || '@defaultStage@';
109

    
110
my $cfg = $query->param('cfg');
111

    
112
# 1.8.1 temporary header/footer fixder =
113

    
114
my $header = ($cfg eq 'nceas') ? 'nceasHeader.tmpl' : '@defaultHeader@';
115
my $footer = ($cfg eq 'nceas') ? 'nceasFooter.tmpl' : '@defaultFooter@';
116

    
117
# define the possible stages
118
my %stages = (
119
              'initregister'      => \&handleInitRegister,
120
              'register'          => \&handleRegister,
121
              'registerconfirmed' => \&handleRegisterConfirmed,
122
              'simplesearch'      => \&handleSimpleSearch,
123
              'initaddentry'      => \&handleInitAddEntry,
124
              'addentry'          => \&handleAddEntry,
125
              'initmodifyentry'   => \&handleInitModifyEntry,
126
              'modifyentry'       => \&handleModifyEntry,
127
              'changepass'        => \&handleChangePassword,
128
              'initchangepass'    => \&handleInitialChangePassword,
129
              'resetpass'         => \&handleResetPassword,
130
              'initresetpass'     => \&handleInitialResetPassword,
131
             );
132
# call the appropriate routine based on the stage
133
if ( $stages{$stage} ) {
134
  $stages{$stage}->();
135
} else {
136
  &handleResponseMessage();
137
}
138

    
139
#--------------------------------------------------------------------------80c->
140
# Define the subroutines to do the work
141
#--------------------------------------------------------------------------80c->
142

    
143

    
144
#
145
# create the initial registration form 
146
#
147
sub handleInitRegister {
148
  my $vars = shift;
149

    
150
  print "Content-type: text/html\n\n";
151
  # process the template files:
152
  my $templateVars = { stage => "register", cfg => $cfg };
153
  #$$templateVars{'orgList'} = \@orglist;
154
  $$templateVars{'orgList'} = \@orglist;
155
  $$templateVars{'baseUrl'} = $baseUrl;
156
  $template->process( $header, $templateVars);
157
  $template->process( "@register@", $templateVars);
158
  $template->process( $footer, $templateVars);
159

    
160
  exit();
161
}
162

    
163
#
164
# process input from the register stage, which occurs when
165
# a user submits form data to create a new account
166
#
167
sub handleRegister {
168
    
169
    print "Content-type: text/html\n\n";
170

    
171
    my $allParams = { 'givenName' => $query->param('givenName'), 
172
                      'sn' => $query->param('sn'),
173
                      'o' => $query->param('o'), 
174
                      'mail' => $query->param('mail'), 
175
                      'uid' => $query->param('uid'), 
176
                      'userPassword' => $query->param('userPassword'), 
177
                      'userPassword2' => $query->param('userPassword2'), 
178
                      'title' => $query->param('title'), 
179
                      'telephoneNumber' => $query->param('telephoneNumber') };
180
    # Check that all required fields are provided and not null
181
    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail', 
182
                           'uid', 'userPassword', 'userPassword2');
183
    if (! paramsAreValid(@requiredParams)) {
184
        my $errorMessage = "Required information is missing. " .
185
            "Please fill in all required fields and resubmit the form.";
186
        my $templateVars = { stage => "register",
187
                             cfg => $cfg,
188
                             allParams => $allParams,
189
                             errorMessage => $errorMessage };
190
        $$templateVars{'orgList'} = \@orglist;
191
        $$templateVars{'baseUrl'} = $baseUrl;
192
        $template->process( $header, $templateVars);
193
        $template->process( "@register@", $templateVars);
194
        $template->process( $footer, $templateVars);
195
        exit(0);
196
    } else {
197
        my $o = $query->param('o');    
198
        $ldapurl = $config_ldapurl->{$o};
199
        $searchBase = $config_ldapsearchbase->{$o};  
200
    }
201

    
202
    # Search LDAP for matching entries that already exist
203
    # Some forms use a single text search box, whereas others search per
204
    # attribute.
205
    my $filter;
206
    if ($query->param('searchField')) {
207

    
208
      $filter = "(|" . 
209
                "(uid=" . $query->param('searchField') . ") " .
210
                "(mail=" . $query->param('searchField') . ")" .
211
                "(&(sn=" . $query->param('searchField') . ") " . 
212
                "(givenName=" . $query->param('searchField') . "))" . 
213
                ")";
214
    } else {
215
      $filter = "(|" . 
216
                "(uid=" . $query->param('uid') . ") " .
217
                "(mail=" . $query->param('mail') . ")" .
218
                "(&(sn=" . $query->param('sn') . ") " . 
219
                "(givenName=" . $query->param('givenName') . "))" . 
220
                ")";
221
    }
222

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

    
226
    # If entries match, send back a request to confirm new-user creation
227
    if ($found) {
228
      my $templateVars = { stage => "registerconfirmed",
229
                           cfg => $cfg,
230
                           allParams => $allParams,
231
                           foundAccounts => $found };
232
      $$templateVars{'orgList'} = \@orglist;
233
      $$templateVars{'baseUrl'} = $baseUrl;
234
      $template->process( $header, $templateVars);
235
      $template->process( "@registerMatch@", $templateVars);
236
      $template->process( "@register@", $templateVars);
237
      $template->process( $footer, $templateVars);
238

    
239
    # Otherwise, create a new user in the LDAP directory
240
    } else {
241
        #print("ingore create account\n");
242
        createAccount($allParams);
243
    }
244

    
245
    exit();
246
}
247

    
248
#
249
# process input from the registerconfirmed stage, which occurs when
250
# a user chooses to create an account despite similarities to other
251
# existing accounts
252
#
253
sub handleRegisterConfirmed {
254
  
255
    my $allParams = { 'givenName' => $query->param('givenName'), 
256
                      'sn' => $query->param('sn'),
257
                      #'o' => $query->param('o'), 
258
                      'o' => 'unaffiliated', 
259
                      'mail' => $query->param('mail'), 
260
                      'uid' => $query->param('uid'), 
261
                      'userPassword' => $query->param('userPassword'), 
262
                      'userPassword2' => $query->param('userPassword2'), 
263
                      'title' => $query->param('title'), 
264
                      'telephoneNumber' => $query->param('telephoneNumber') };
265
    print "Content-type: text/html\n\n";
266
    createAccount($allParams);
267

    
268
    exit();
269
}
270

    
271
#
272
# change a user's password upon request
273
#
274
sub handleChangePassword {
275

    
276
    print "Content-type: text/html\n\n";
277

    
278
    my $allParams = { 'test' => "1", };
279
    if ($query->param('uid')) {
280
        $$allParams{'uid'} = $query->param('uid');
281
    }
282
    if ($query->param('o')) {
283
        $$allParams{'o'} = $query->param('o');
284
        my $o = $query->param('o');
285
        
286
        $ldapurl = $config_ldapurl->{$o};
287
        $searchBase = $config_ldapsearchbase->{$o};
288
    }
289

    
290

    
291
    # Check that all required fields are provided and not null
292
    my @requiredParams = ( 'uid', 'o', 'oldpass', 
293
                           'userPassword', 'userPassword2');
294
    if (! paramsAreValid(@requiredParams)) {
295
        my $errorMessage = "Required information is missing. " .
296
            "Please fill in all required fields and submit the form.";
297
        my $templateVars = { stage => "changepass",
298
                             cfg => $cfg,
299
                             allParams => $allParams,
300
                             errorMessage => $errorMessage };
301
        $$templateVars{'orgList'} = \@orglist;
302
        $$templateVars{'baseUrl'} = $baseUrl;
303
        $template->process( $header, $templateVars);
304
        $template->process( "@defaultChangePass@", $templateVars);
305
        $template->process( $footer, $templateVars);
306
        exit(0);
307
    }
308

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

    
312
        my $o = $query->param('o');
313
        $ldapurl = $config_ldapurl->{$o};
314
        $searchBase = $config_ldapsearchbase->{$o};
315
        $root = $config_user->{$o};
316
        $rootpw = $config_password->{$o};
317

    
318
        my $dn = "uid=" . $query->param('uid') . "," . $config_dn->{$o};;
319
        if ($query->param('o') =~ "LTER") {
320
            $template->process( $header);
321
            $template->process( "@registerLter@");
322
            $template->process( $footer);
323
        } else {
324
            my $errorMessage = changePassword(
325
                    $dn, $query->param('userPassword'), 
326
                    $dn, $query->param('oldpass'), $query->param('o'));
327
            if ($errorMessage) {
328
                my $templateVars = { stage => "changepass",
329
                                     cfg => $cfg,
330
                                     allParams => $allParams,
331
                                     errorMessage => $errorMessage };
332
                $$templateVars{'orgList'} = \@orglist;
333
                $$templateVars{'baseUrl'} = $baseUrl;
334
                $template->process( $header, $templateVars);
335
                $template->process( "@defaultChangePass@", $templateVars);
336
                $template->process( $footer, $templateVars);
337
                exit(0);
338
            } else {
339
                my $templateVars = { stage => "changepass",
340
                                     cfg => $cfg,
341
                                     allParams => $allParams };
342
                $$templateVars{'orgList'} = \@orglist;
343
                $$templateVars{'baseUrl'} = $baseUrl;
344
                $template->process( $header, $templateVars);
345
                $template->process( "@changePassSuccess@", $templateVars);
346
                $template->process( $footer, $templateVars);
347
                exit(0);
348
            }
349
        }
350
    } else {
351
        my $errorMessage = "The passwords do not match. Try again.";
352
        my $templateVars = { stage => "changepass",
353
                             cfg => $cfg,
354
                             allParams => $allParams,
355
                             errorMessage => $errorMessage };
356
        $$templateVars{'orgList'} = \@orglist;
357
        $$templateVars{'baseUrl'} = $baseUrl;
358
        $template->process( $header, $templateVars);
359
        $template->process( "@defaultChangePass@", $templateVars);
360
        $template->process( $footer, $templateVars);
361
        exit(0);
362
    }
363
}
364

    
365
#
366
# change a user's password upon request - no input params
367
# only display chagepass template without any error
368
#
369
sub handleInitialChangePassword {
370
    print "Content-type: text/html\n\n";
371

    
372
    my $allParams = { 'test' => "1", };
373
    my $errorMessage = "";
374
    my $templateVars = { stage => "changepass",
375
                         cfg => $cfg,
376
                         allParams => $allParams,
377
                         errorMessage => $errorMessage };
378
    $$templateVars{'orgList'} = \@orglist;
379
    $$templateVars{'baseUrl'} = $baseUrl;
380
    $template->process( $header, $templateVars);
381
    $template->process( "@defaultChangePass@", $templateVars);
382
    $template->process( $footer, $templateVars);
383
    exit(0);
384
}
385

    
386
#
387
# reset a user's password upon request
388
#
389
sub handleResetPassword {
390

    
391
    print "Content-type: text/html\n\n";
392

    
393
    my $allParams = { 'test' => "1", };
394
    if ($query->param('uid')) {
395
        $$allParams{'uid'} = $query->param('uid');
396
    }
397
    if ($query->param('o')) {
398
        $$allParams{'o'} = $query->param('o');
399
        my $o = $query->param('o');
400
        
401
        $ldapurl = $config_ldapurl->{$o};
402
        $searchBase = $config_ldapsearchbase->{$o};
403
        $root = $config_user->{$o};
404
        $rootpw = $config_password->{$o};
405
    }
406

    
407
    # Check that all required fields are provided and not null
408
    my @requiredParams = ( 'uid', 'o' );
409
    if (! paramsAreValid(@requiredParams)) {
410
        my $errorMessage = "Required information is missing. " .
411
            "Please fill in all required fields and submit the form.";
412
        my $templateVars = { stage => "resetpass",
413
                             cfg => $cfg,
414
                             allParams => $allParams,
415
                             errorMessage => $errorMessage };
416
        $$templateVars{'orgList'} = \@orglist;
417
        $$templateVars{'baseUrl'} = $baseUrl;
418
        $template->process( $header, $templateVars);
419
        $template->process( "@defaultResetPass@", $templateVars);
420
        $template->process( $footer, $templateVars);
421
        exit(0);
422
    }
423

    
424
    # We have all of the info we need, so try to change the password
425
    my $o = $query->param('o');
426
    my $dn = "uid=" . $query->param('uid') . "," . $config_dn->{$o};
427
    if ($query->param('o') =~ "LTER") {
428
        $template->process( $header);
429
        $template->process( "@registerLter@");
430
        $template->process( $footer);
431
        exit(0);
432
    } else {
433
        my $errorMessage = "";
434
        my $recipient;
435
        my $userPass;
436
        my $entry = getLdapEntry($ldapurl, $searchBase, 
437
                $query->param('uid'), $query->param('o'));
438

    
439
        if ($entry) {
440
            $recipient = $entry->get_value('mail');
441
            $userPass = getRandomPassword();
442
            $errorMessage = changePassword($dn, $userPass, $root, $rootpw, $query->param('o'));
443
        } else {
444
            $errorMessage = "User not found in database.  Please try again.";
445
        }
446

    
447
        if ($errorMessage) {
448
            my $templateVars = { stage => "resetpass",
449
                                 cfg => $cfg,
450
                                 allParams => $allParams,
451
                                 errorMessage => $errorMessage };
452
            $$templateVars{'orgList'} = \@orglist;
453
            $$templateVars{'baseUrl'} = $baseUrl;
454
            $template->process( $header, $templateVars);
455
            $template->process( "@defaultResetPass@", $templateVars);
456
            $template->process( $footer, $templateVars);
457
            exit(0);
458
        } else {
459
            my $errorMessage = sendPasswordNotification($query->param('uid'),
460
                    $query->param('o'), $userPass, $recipient, $cfg);
461
            my $templateVars = { stage => "resetpass",
462
                                 cfg => $cfg,
463
                                 allParams => $allParams,
464
                                 errorMessage => $errorMessage };
465
            $$templateVars{'orgList'} = \@orglist;
466
            $$templateVars{'baseUrl'} = $baseUrl;
467
            $template->process( $header, $templateVars);
468
            $template->process( "@resetPassSuccess@", $templateVars);
469
            $template->process( $footer, $templateVars);
470
            exit(0);
471
        }
472
    }
473
}
474

    
475
#
476
# reset a user's password upon request- no initial params
477
# only display resetpass template without any error
478
#
479
sub handleInitialResetPassword {
480
    print "Content-type: text/html\n\n";
481
    my $errorMessage = "";
482
    my $allParams = { 'test' => "1", };
483
    my $templateVars = { stage => "resetpass",
484
                         cfg => $cfg,
485
                         allParams => $allParams,
486
                         errorMessage => $errorMessage };
487
    $$templateVars{'orgList'} = \@orglist;
488
    $$templateVars{'baseUrl'} = $baseUrl;
489
    $template->process( $header, $templateVars);
490
    $template->process( "@defaultResetPass@", $templateVars);
491
    $template->process( $footer, $templateVars);
492
    exit(0);
493
}
494

    
495
#
496
# Construct a random string to use for a newly reset password
497
#
498
sub getRandomPassword {
499
    my $length = shift;
500
    if (!$length) {
501
        $length = 8;
502
    }
503
    my $newPass = "";
504

    
505
    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );
506
    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);
507
    return $newPass;
508
}
509

    
510
#
511
# Change a password to a new value, binding as the provided user
512
#
513
sub changePassword {
514
    my $userDN = shift;
515
    my $userPass = shift;
516
    my $bindDN = shift;
517
    my $bindPass = shift;
518
    my $o = shift;
519

    
520
    my $ldapurl = $config_ldapurl->{$o};
521
    my $searchBase = $config_ldapsearchbase->{$o};
522
    
523
    my $errorMessage = 0;
524
    my $ldap;
525
    if ($ldapurl =~ $mainldapurl){
526
        #if main ldap server is down, a html file containing warning message will be returned
527
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
528
    }
529
    else{
530
        #if a referral ldap server is down, we will ignore it silently
531
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
532
    } 
533
    #$ldap->start_tls( verify => 'require',
534
                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');
535
    $ldap->start_tls( verify => 'none');
536
    my $bindresult = $ldap->bind( version => 3, dn => $bindDN, 
537
                                  password => $bindPass );
538
    if ($bindresult->code) {
539
        $errorMessage = "Failed to log in. Are you sure your old " .
540
                        "password is correct? Try again...";
541
        return $errorMessage;
542
    }
543

    
544
    # Find the user here and change their entry
545
    my $newpass = createSeededPassHash($userPass);
546
    my $modifications = { userPassword => $newpass };
547
    my $result = $ldap->modify( $userDN, replace => { %$modifications });
548
    
549
    if ($result->code()) {
550
        my $errorMessage = "There was an error changing the password." .
551
                           "<br />\n" . $result->error;
552
    } 
553
    $ldap->unbind;   # take down session
554

    
555
    return $errorMessage;
556
}
557

    
558
#
559
# generate a Seeded SHA1 hash of a plaintext password
560
#
561
sub createSeededPassHash {
562
    my $secret = shift;
563

    
564
    my $salt = "";
565
    for (my $i=0; $i < 4; $i++) {
566
        $salt .= int(rand(10));
567
    }
568

    
569
    my $ctx = Digest::SHA1->new;
570
    $ctx->add($secret);
571
    $ctx->add($salt);
572
    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
573

    
574
    return $hashedPasswd;
575
}
576

    
577
#
578
# Look up an ldap entry for a user
579
#
580
sub getLdapEntry {
581
    my $ldapurl = shift;
582
    my $base = shift;
583
    my $username = shift;
584
    my $org = shift;
585

    
586
    my $entry = "";
587
    my $mesg;
588
    my $ldap;
589
    print("ldap server ", $ldapurl, "\n");
590
    if ($ldapurl =~ $mainldapurl){
591
        #if main ldap server is down, a html file containing warning message will be returned
592
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
593
    }
594
    else{
595
        #if a referral ldap server is down, we will ignore it silently
596
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
597
    }
598
    $ldap->start_tls( verify => 'none');
599
    my $bindresult = $ldap->bind;
600
    if ($bindresult->code) {
601
        return $entry;
602
    }
603

    
604
    if($config_filter->{$org}){
605
        $mesg = $ldap->search ( base   => $base,
606
                filter => "(&(uid=$username)($config_filter->{$org}))");
607
    } else {
608
        $mesg = $ldap->search ( base   => $base, filter => "(uid=$username)");
609
    }
610
    
611
    if ($mesg->count > 0) {
612
        $entry = $mesg->pop_entry;
613
        $ldap->unbind;   # take down session
614
    } else {
615
        $ldap->unbind;   # take down session
616
        # Follow references by recursive call to self
617
        my @references = $mesg->references();
618
        for (my $i = 0; $i <= $#references; $i++) {
619
            my $uri = URI->new($references[$i]);
620
            my $host = $uri->host();
621
            my $path = $uri->path();
622
            $path =~ s/^\///;
623
            $entry = &getLdapEntry($host, $path, $username, $org);
624
            if ($entry) {
625
                return $entry;
626
            }
627
        }
628
    }
629
    return $entry;
630
}
631

    
632
# 
633
# send an email message notifying the user of the pw change
634
#
635
sub sendPasswordNotification {
636
    my $username = shift;
637
    my $org = shift;
638
    my $newPass = shift;
639
    my $recipient = shift;
640
    my $cfg = shift;
641

    
642
    my $errorMessage = "";
643
    if ($recipient) {
644
        # Send the email message to them
645
        my $smtp = Net::SMTP->new($mailhost);
646
        $smtp->mail($sender);
647
        $smtp->to($recipient);
648

    
649
        my $message = <<"        ENDOFMESSAGE";
650
        To: $recipient
651
        From: $sender
652
        Subject: KNB Password Reset
653
        
654
        Somebody (hopefully you) requested that your KNB password be reset.  
655
        This is generally done when somebody forgets their password.  Your 
656
        password can be changed by visiting the following URL:
657

    
658
        @cgiurl@?stage=changepass&cfg=$cfg
659

    
660
            Username: $username
661
        Organization: $org
662
        New Password: $newPass
663

    
664
        Thanks,
665
            The KNB Development Team
666
    
667
        ENDOFMESSAGE
668
        $message =~ s/^[ \t\r\f]+//gm;
669
    
670
        $smtp->data($message);
671
        $smtp->quit;
672
    } else {
673
        $errorMessage = "Failed to send password because I " .
674
                        "couldn't find a valid email address.";
675
    }
676
    return $errorMessage;
677
}
678

    
679
#
680
# search the LDAP directory to see if a similar account already exists
681
#
682
sub findExistingAccounts {
683
    my $ldapurl = shift;
684
    my $base = shift;
685
    my $filter = shift;
686
    my $attref = shift;
687
    my $ldap;
688

    
689
    my $foundAccounts = 0;
690
    #print("the ldapurl in findExstingAccounts is ", $ldapurl, "\n");
691
    if ($ldapurl =~ $mainldapurl){
692
        #if main ldap server is down, a html file containing warning message will be returned
693
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);
694
    }
695
    else{
696
        #if a referral ldap server is down, we will ignore it silently
697
        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;
698
    }
699
    $ldap->start_tls( verify => 'none');
700
    $ldap->bind( version => 3, anonymous => 1);
701
    my $mesg = $ldap->search (
702
        base   => $base,
703
        filter => $filter,
704
        attrs => @$attref,
705
    );
706

    
707
    if ($mesg->count() > 0) {
708
        $foundAccounts = "";
709
        my $entry;
710
        foreach $entry ($mesg->all_entries) { 
711
            $foundAccounts .= "<p>\n<b><u>Account:</u> ";
712
            $foundAccounts .= $entry->dn();
713
            $foundAccounts .= "</b><br />\n";
714
            foreach my $attribute ($entry->attributes()) {
715
                $foundAccounts .= "$attribute: ";
716
                $foundAccounts .= $entry->get_value($attribute);
717
                $foundAccounts .= "<br />\n";
718
            }
719
            $foundAccounts .= "</p>\n";
720
        }
721
    }
722
    $ldap->unbind;   # take down session
723

    
724
    # Follow references
725
    my @references = $mesg->references();
726
    for (my $i = 0; $i <= $#references; $i++) {
727
        my $uri = URI->new($references[$i]);
728
        my $host = $uri->host();
729
        my $path = $uri->path();
730
        $path =~ s/^\///;
731
        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);
732
        if ($refFound) {
733
            $foundAccounts .= $refFound;
734
        }
735
    }
736

    
737
    #print "<p>Checking referrals...</p>\n";
738
    #my @referrals = $mesg->referrals();
739
    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";
740
    #for (my $i = 0; $i <= $#referrals; $i++) {
741
        #print "<p>Referral: ", $referrals[$i], "</p>\n";
742
    #}
743

    
744
    return $foundAccounts;
745
}
746

    
747
#
748
# Validate that we have the proper set of input parameters
749
#
750
sub paramsAreValid {
751
    my @pnames = @_;
752

    
753
    my $allValid = 1;
754
    foreach my $parameter (@pnames) {
755
        if (!defined($query->param($parameter)) || 
756
            ! $query->param($parameter) ||
757
            $query->param($parameter) =~ /^\s+$/) {
758
            $allValid = 0;
759
        }
760
    }
761

    
762
    return $allValid;
763
}
764

    
765
#
766
# Bind to LDAP and create a new account using the information provided
767
# by the user
768
#
769
sub createAccount {
770
    my $allParams = shift;
771

    
772
    if ($query->param('o') =~ "LTER") {
773
        $template->process( $header);
774
        $template->process( "@registerLter@");
775
        $template->process( $footer);
776
    } else {
777

    
778
        # Be sure the passwords match
779
        if ($query->param('userPassword') !~ $query->param('userPassword2')) {
780
            my $errorMessage = "The passwords do not match. Try again.";
781
            my $templateVars = { stage => "register",
782
                                 cfg => $cfg,
783
                                 allParams => $allParams,
784
                                 errorMessage => $errorMessage };
785
            $$templateVars{'orgList'} = \@orglist;
786
            $$templateVars{'baseUrl'} = $baseUrl;
787
            $template->process( $header, $templateVars);
788
            $template->process( "@registerFailed@", $templateVars);
789
            $template->process( "@register@", $templateVars);
790
            $template->process( $footer, $templateVars);
791
            exit(0);
792
        }
793

    
794
        my $o = $query->param('o');
795

    
796
        my $ldapurl = $config_ldapurl->{$o};
797
        my $root = $config_user->{$o};
798
        my $rootpw = $config_password->{$o};
799
        my $searchBase = $config_ldapsearchbase->{$o};
800
        my $dnBase = $config_dn->{$o};
801

    
802
        
803
        #if main ldap server is down, a html file containing warning message will be returned
804
        my $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
805
        
806
        
807
        $ldap->start_tls( verify => 'none');
808
        $ldap->bind( version => 3, dn => $root, password => $rootpw );
809
        #print "Inserting new entry...\n";
810
        my $dn = 'uid=' . $query->param('uid') . ',' . $dnBase;
811

    
812
        # Create a hashed version of the password
813
        my $shapass = createSeededPassHash($query->param('userPassword'));
814

    
815
        # Do the insertion
816
        my $additions = [ 
817
                'uid'   => $query->param('uid'),
818
                'o'   => $query->param('o'),
819
                'cn'   => join(" ", $query->param('givenName'), 
820
                                    $query->param('sn')),
821
                'sn'   => $query->param('sn'),
822
                'givenName'   => $query->param('givenName'),
823
                'mail' => $query->param('mail'),
824
                'userPassword' => $shapass,
825
                'objectclass' => ['top', 'person', 'organizationalPerson', 
826
                                'inetOrgPerson', 'uidObject' ]
827
            ];
828
        if (defined($query->param('telephoneNumber')) && 
829
            $query->param('telephoneNumber') &&
830
            ! $query->param('telephoneNumber') =~ /^\s+$/) {
831
            $$additions[$#$additions + 1] = 'telephoneNumber';
832
            $$additions[$#$additions + 1] = $query->param('telephoneNumber');
833
        }
834
        if (defined($query->param('title')) && 
835
            $query->param('title') &&
836
            ! $query->param('title') =~ /^\s+$/) {
837
            $$additions[$#$additions + 1] = 'title';
838
            $$additions[$#$additions + 1] = $query->param('title');
839
        }
840
        my $result = $ldap->add ( 'dn' => $dn, 'attr' => [ @$additions ]);
841
    
842
        if ($result->code()) {
843
            my $templateVars = { stage => "register",
844
                                 cfg => $cfg,
845
                                 allParams => $allParams,
846
                                 errorMessage => $result->error };
847
            $$templateVars{'orgList'} = \@orglist;
848
            $$templateVars{'baseUrl'} = $baseUrl;
849
            $template->process( $header, $templateVars);
850
            $template->process( "@registerFailed@", $templateVars);
851
            $templateVars    = { stage => "register",
852
                                 cfg => $cfg,
853
                                 allParams => $allParams };
854
            $$templateVars{'orgList'} = \@orglist;
855
            $$templateVars{'baseUrl'} = $baseUrl;
856
            $template->process( "@register@", $templateVars);
857
            $template->process( $footer, $templateVars);
858
        } else {
859
            my $templateVars    = { cfg => $cfg };
860
            $$templateVars{'baseUrl'} = $baseUrl;
861
            $template->process( $header, $templateVars);
862
            $template->process( "@registerSuccess@", $templateVars);
863
            $template->process( $footer, $templateVars);
864
        }
865

    
866
        $ldap->unbind;   # take down session
867
    }
868
}
869

    
870
sub handleResponseMessage {
871

    
872
  print "Content-type: text/html\n\n";
873
  my $errorMessage = "You provided invalid input to the script. " .
874
                     "Try again please.";
875
  my $templateVars = { stage => "@defaultStage@",
876
                       cfg => $cfg,
877
                       errorMessage => $errorMessage };
878
  $$templateVars{'orgList'} = \@orglist;
879
  $$templateVars{'baseUrl'} = $baseUrl;
880
  $template->process( $header, $templateVars);
881
  $template->process( $footer, $templateVars);
882
  exit(0);
883
}
884

    
885
#
886
# perform a simple search against the LDAP database using 
887
# a small subset of attributes of each dn and return it
888
# as a table to the calling browser.
889
#
890
sub handleSimpleSearch {
891

    
892
    my $o = $query->param('o');
893

    
894
    my $ldapurl = $config_ldapurl->{$o};
895
    my $searchBase = $config_ldapsearchbase->{$o};
896

    
897
    print "Content-type: text/html\n\n";
898

    
899
    my $allParams = { 
900
                      'cn' => $query->param('cn'),
901
                      'sn' => $query->param('sn'),
902
                      'gn' => $query->param('gn'),
903
                      'o'  => $query->param('o'),
904
                      'facsimiletelephonenumber' 
905
                      => $query->param('facsimiletelephonenumber'),
906
                      'mail' => $query->param('cmail'),
907
                      'telephonenumber' => $query->param('telephonenumber'),
908
                      'title' => $query->param('title'),
909
                      'uid' => $query->param('uid'),
910
                      'ou' => $query->param('ou'),
911
                    };
912

    
913
    # Search LDAP for matching entries that already exist
914
    my $filter = "(" . 
915
                 $query->param('searchField') . "=" .
916
                 "*" .
917
                 $query->param('searchValue') .
918
                 "*" .
919
                 ")";
920

    
921
    my @attrs = [ 'sn', 
922
                  'gn', 
923
                  'cn', 
924
                  'o', 
925
                  'facsimiletelephonenumber', 
926
                  'mail', 
927
                  'telephoneNumber', 
928
                  'title', 
929
                  'uid', 
930
                  'labeledURI', 
931
                  'ou' ];
932

    
933
    my $found = searchDirectory($ldapurl, $searchBase, $filter, \@attrs);
934

    
935
    # Send back the search results
936
    if ($found) {
937
      my $templateVars = { stage => "searchResults",
938
                           cfg => $cfg,
939
                           allParams => $allParams,
940
                           foundAccounts => $found };
941
      $$templateVars{'orgList'} = \@orglist;
942
      $$templateVars{'baseUrl'} = $baseUrl;
943
      $template->process( $header, $templateVars);
944
      $template->process( "@searchResults@", $templateVars);
945
      $template->process( $footer, $templateVars);
946

    
947
    } else {
948
      $found = "No entries matched your criteria.  Please try again\n";
949

    
950
      my $templateVars = { stage => "searchResults",
951
                           cfg => $cfg,
952
                           allParams => $allParams,
953
                           foundAccounts => $found };
954
      $$templateVars{'orgList'} = \@orglist;
955
      $$templateVars{'baseUrl'} = $baseUrl;
956
      $template->process( $header, $templateVars);
957
      $template->process( "@searchResults@", $templateVars);
958
      $template->process( $footer, $templateVars);
959

    
960
    }
961

    
962
    exit();
963
}
964

    
965
#
966
# search the LDAP directory to see if a similar account already exists
967
#
968
sub searchDirectory {
969
    my $ldapurl = shift;
970
    my $base = shift;
971
    my $filter = shift;
972
    my $attref = shift;
973

    
974
    my $foundAccounts = 0;
975

    
976
    
977
    
978
    #if ldap server is down, a html file containing warning message will be returned
979
    my $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure("The ldap server " . $ldapurl . " is down!");
980
    
981
    $ldap->start_tls( verify => 'none');
982
    $ldap->bind( version => 3, anonymous => 1);
983
    my $mesg = $ldap->search (
984
        base   => $base,
985
        filter => $filter,
986
        attrs => @$attref,
987
    );
988

    
989
    if ($mesg->count() > 0) {
990
        $foundAccounts = "";
991
        my $entry;
992
        foreach $entry ($mesg->sorted(['sn'])) {
993
          $foundAccounts .= "<tr>\n<td class=\"main\">\n";
994
          $foundAccounts .= "<a href=\"" unless 
995
                    (!$entry->get_value('labeledURI'));
996
          $foundAccounts .= $entry->get_value('labeledURI') unless
997
                    (!$entry->get_value('labeledURI'));
998
          $foundAccounts .= "\">\n" unless 
999
                    (!$entry->get_value('labeledURI'));
1000
          $foundAccounts .= $entry->get_value('givenName');
1001
          $foundAccounts .= "</a>\n" unless 
1002
                    (!$entry->get_value('labeledURI'));
1003
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1004
          $foundAccounts .= "<a href=\"" unless 
1005
                    (!$entry->get_value('labeledURI'));
1006
          $foundAccounts .= $entry->get_value('labeledURI') unless
1007
                    (!$entry->get_value('labeledURI'));
1008
          $foundAccounts .= "\">\n" unless 
1009
                    (!$entry->get_value('labeledURI'));
1010
          $foundAccounts .= $entry->get_value('sn');
1011
          $foundAccounts .= "</a>\n";
1012
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1013
          $foundAccounts .= $entry->get_value('mail');
1014
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1015
          $foundAccounts .= $entry->get_value('telephonenumber');
1016
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1017
          $foundAccounts .= $entry->get_value('title');
1018
          $foundAccounts .= "\n</td>\n<td class=\"main\">\n";
1019
          $foundAccounts .= $entry->get_value('ou');
1020
          $foundAccounts .= "\n</td>\n";
1021
          $foundAccounts .= "</tr>\n";
1022
        }
1023
    }
1024
    $ldap->unbind;   # take down session
1025
    return $foundAccounts;
1026
}
1027

    
1028
sub debug {
1029
    my $msg = shift;
1030
    
1031
    if ($debug) {
1032
        print STDERR "$msg\n";
1033
    }
1034
}
1035

    
1036
sub handleGeneralServerFailure {
1037
    my $errorMessage = shift;
1038
    my $templateVars = { cfg => $cfg,
1039
                         errorMessage => $errorMessage };
1040
    $$templateVars{'baseUrl'} = $baseUrl;
1041
    $template->process( $header, $templateVars);
1042
    $template->process( "@ldapMainServerFailure@", $templateVars);
1043
    $template->process( $footer, $templateVars);
1044
    exit(0);   
1045
   }
1046
    
1047

    
(7-7/10)