Metacat

#!/usr/bin/perl -w

 #

 #  '$RCSfile$'

 #  Copyright: 2001 Regents of the University of California

 #

 #   '$Author$'

 #     '$Date$'

 # '$Revision$'

 #

 # This program is free software; you can redistribute it and/or modify

 # it under the terms of the GNU General Public License as published by

 # the Free Software Foundation; either version 2 of the License, or

 # (at your option) any later version.

 #

 # This program is distributed in the hope that it will be useful,

 # but WITHOUT ANY WARRANTY; without even the implied warranty of

 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 # GNU General Public License for more details.

 #

 # You should have received a copy of the GNU General Public License

 # along with this program; if not, write to the Free Software

 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

 #

#

# This is a web-based application for allowing users to register a new

# account for Metacat access.  We currently only support LDAP even

# though metacat could potentially support other types of directories.

#

use strict;       # turn on strict syntax checking.

use Net::LDAP;    # load the LDAP net libraries

use Digest::SHA1; # for creating the password hash

use MIME::Base64; # for creating the password hash

use Term::ReadKey;# for not displaying the password on command line

# Set up our default configuration

my $ldapurl = "@ldapurl@";

my $bindDN = "@user@";

my $searchBase = "@ldapSearchBase@";

my $userDN = readReqdParam("Enter the user DN:");

ReadMode('noecho'); # set no echo mode on the term so that passwords are not displayed

my $userPass = readReqdParam("Enter the new user password:");

my $bindPass = readReqdParam("Enter the root password:");

ReadMode('normal'); # set terminal mode back to normal

my $errorMessage = 0;

my $ldap = Net::LDAP->new($ldapurl) or die "$@";

my $bindresult = $ldap->bind( version => 3, dn => $bindDN,

                                  password => $bindPass );

if ($bindresult->code) {

    $errorMessage = "Failed to log in. Are you sure your old " .

                    "password is correct? Try again...\n";

    print $errorMessage;

    exit 0;

}

# Find the user here and change their entry

my $newpass = createSeededPassHash($userPass);

my $modifications = { userPassword => $newpass };

my $result = $ldap->modify( $userDN, replace => { %$modifications });

if ($result->code()) {

   $errorMessage = "There was an error changing the password: " .

                      $result->error."\n";

} else {

   $errorMessage = "The password has been changed.\n";

}

$ldap->unbind;   # take down session

print $errorMessage;

#

# generate a Seeded SHA1 hash of a plaintext password

#

sub createSeededPassHash {

    my $secret = shift;

    my $salt = "";

    for (my $i=0; $i < 4; $i++) {

        $salt .= int(rand(10));

    }

    my $ctx = Digest::SHA1->new;

    $ctx->add($secret);

    $ctx->add($salt);

    my $hashedPasswd = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');

    return $hashedPasswd;

}

sub readReqdParam{

    my $printString = shift;

    print "$printString\n";

    my $returnVal = <>;

    chomp $returnVal;

    while($returnVal eq ""){

        print "This value is required. $printString\n";

        $returnVal = <>;

        chomp $returnVal;

    }

    return $returnVal;

}