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 Template;           # load the template-toolkit module

use CGI;                # load the CGI module

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

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

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

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

use URI;                # for parsing URL syntax

use Config::Properties; # for parsing Java .properties files

use File::Basename;     # for path name parsing

my $cgiUrl = $ENV{'SCRIPT_FILENAME'};

my $workingDirectory = dirname($cgiUrl);

my $metacatProps = "${workingDirectory}/../WEB-INF/metacat.properties";

my $properties = new Config::Properties();

unless (open (METACAT_PROPERTIES, $metacatProps)) {

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

    print "Unable to locate Metacat properties. Working directory is set as " .

        $workingDirectory .", is this correct?";

    exit(0);

}

my $ldapProps = $properties->splitToTree(qr/\./, 'ldap');

my $ldapurl = $ldapProps->{'url'};

my $mainldapurl = $ldapProps->{'mainurl'};

my $ldapUsername = $ldapProps->{'user'};

my $ldapPassword = $ldapProps->{'password'};

my $searchBase = $ldapProps->{'searchbase'};

my $mailhost = $properties->getProperty('email.mailhost');

my $sender = $properties->getProperty('email.sender');

# Java uses miliseconds, Perl expects whole seconds

my $TIMEOUT = $ldapProps->{'connectTimeLimit'} / 1000;

my $mainldapdownmessage = "The main ldap server $mainldapurl is down!";

my $query = new CGI;

my $debug = 0;

#--------------------------------------------------------------------------80c->

# Set up the Template Toolkit to read html form templates

my $templates = $properties->splitToTree(qr/\./, 'ldap.templates');

# set some configuration options for the template object

my $config_templates = {

             POST_CHOMP   => 1,

             };

# create an instance of the template

my $ldapCustom = $properties->splitToTree(qr/\./, 'ldap');

my $ldapConfig;

    debug($o);

    # pull the raw tree in to prevent Perl pass-by-value shenanigans

    $ldapConfig->{$o} = $properties->splitToTree(qr/\./, 'ldap');

    if (defined $ldapCustom->{$o}) {

        my $custom = $ldapCustom->{$o};

        while (my ($key, $value) = each(%$custom)) {

            $ldapConfig->{$o}{$key} = $value;

        }

    }

#--------------------------------------------------------------------------80c->

# Define the main program logic that calls subroutines to do the work

#--------------------------------------------------------------------------80c->

# The processing step we are handling

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

# define the possible stages

my %stages = (

              'initregister'      => \&handleInitRegister,

              'register'          => \&handleRegister,

              'registerconfirmed' => \&handleRegisterConfirmed,

              'simplesearch'      => \&handleSimpleSearch,

              'initaddentry'      => \&handleInitAddEntry,

              'addentry'          => \&handleAddEntry,

              'initmodifyentry'   => \&handleInitModifyEntry,

              'modifyentry'       => \&handleModifyEntry,

              'initchangepass'    => \&handleInitialChangePassword,

# call the appropriate routine based on the stage

if ( $stages{$stage} ) {

  $stages{$stage}->();

} else {

  &handleResponseMessage();

}

#--------------------------------------------------------------------------80c->

# Define the subroutines to do the work

#--------------------------------------------------------------------------80c->

#

# create the initial registration form

#

sub handleInitRegister {

  my $vars = shift;

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

  # process the template files:

}

#

# process input from the register stage, which occurs when

# a user submits form data to create a new account

#

sub handleRegister {

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

    my $allParams = { 'givenName' => $query->param('givenName'),

                      'sn' => $query->param('sn'),

                      'o' => $query->param('o'),

                      'mail' => $query->param('mail'),

                      'uid' => $query->param('uid'),

                      'userPassword' => $query->param('userPassword'),

                      'userPassword2' => $query->param('userPassword2'),

                      'title' => $query->param('title'),

                      'telephoneNumber' => $query->param('telephoneNumber') };

    # Check that all required fields are provided and not null

    my @requiredParams = ( 'givenName', 'sn', 'o', 'mail',

                           'uid', 'userPassword', 'userPassword2');

    if (! paramsAreValid(@requiredParams)) {

        my $errorMessage = "Required information is missing. " .

            "Please fill in all required fields and resubmit the form.";

                                     allParams => $allParams,

                                     errorMessage => $errorMessage });

        exit();

        $searchBase = $ldapConfig->{$o}{'base'};

    # Search LDAP for matching entries that already exist

    # Some forms use a single text search box, whereas others search per

    # attribute.

    my $filter;

    if ($query->param('searchField')) {

      $filter = "(|" .

                "(uid=" . $query->param('searchField') . ") " .

                "(mail=" . $query->param('searchField') . ")" .

                "(&(sn=" . $query->param('searchField') . ") " .

                "(givenName=" . $query->param('searchField') . "))" .

                ")";

    } else {

      $filter = "(|" .

                "(uid=" . $query->param('uid') . ") " .

                "(mail=" . $query->param('mail') . ")" .

                "(&(sn=" . $query->param('sn') . ") " .

                "(givenName=" . $query->param('givenName') . "))" .

                ")";

    }

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

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

    # If entries match, send back a request to confirm new-user creation

    if ($found) {

                                                     allParams => $allParams,

                                                     foundAccounts => $found });

    } else {

    }

    exit();

}

#

# process input from the registerconfirmed stage, which occurs when

# a user chooses to create an account despite similarities to other

# existing accounts

#

sub handleRegisterConfirmed {

    my $allParams = { 'givenName' => $query->param('givenName'),

                      'sn' => $query->param('sn'),

                      'uid' => $query->param('uid'),

                      'userPassword' => $query->param('userPassword'),

                      'userPassword2' => $query->param('userPassword2'),

                      'title' => $query->param('title'),

                      'telephoneNumber' => $query->param('telephoneNumber') };

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

    createAccount($allParams);

    exit();

}

#

# change a user's password upon request

#

sub handleChangePassword {

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

    my $allParams = { 'test' => "1", };

    if ($query->param('uid')) {

        $$allParams{'uid'} = $query->param('uid');

    }

    if ($query->param('o')) {

        $$allParams{'o'} = $query->param('o');

        $searchBase = $ldapConfig->{$o}{'base'};

    # Check that all required fields are provided and not null

    my @requiredParams = ( 'uid', 'o', 'oldpass',

                           'userPassword', 'userPassword2');

    if (! paramsAreValid(@requiredParams)) {

        my $errorMessage = "Required information is missing. " .

            "Please fill in all required fields and submit the form.";

                                        allParams => $allParams,

                                        errorMessage => $errorMessage });

        exit();

    # We have all of the info we need, so try to change the password

    if ($query->param('userPassword') =~ $query->param('userPassword2')) {

        $searchBase = $ldapConfig->{$o}{'base'};

        $ldapUsername = $ldapConfig->{$o}{'user'};

        $ldapPassword = $ldapConfig->{$o}{'password'};

            my $errorMessage = changePassword(

                    $dn, $query->param('userPassword'),

                    $dn, $query->param('oldpass'), $query->param('o'));

                                                allParams => $allParams,

                                                errorMessage => $errorMessage });

                exit();

                                                       allParams => $allParams });

                exit();

        }

    } else {

        my $errorMessage = "The passwords do not match. Try again.";

                                        allParams => $allParams,

                                        errorMessage => $errorMessage });

        exit();

}

#

# only display chagepass template without any error

#

sub handleInitialChangePassword {

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

    my $allParams = { 'test' => "1", };

    my $errorMessage = "";

                                    errorMessage => $errorMessage });

    exit();

#

#

sub handleResetPassword {

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

    my $allParams = { 'test' => "1", };

    if ($query->param('uid')) {

        $$allParams{'uid'} = $query->param('uid');

    }

    if ($query->param('o')) {

        $$allParams{'o'} = $query->param('o');

        $searchBase = $ldapConfig->{$o}{'base'};

        $ldapUsername = $ldapConfig->{$o}{'user'};

        $ldapPassword = $ldapConfig->{$o}{'password'};

    # Check that all required fields are provided and not null

    my @requiredParams = ( 'uid', 'o' );

    if (! paramsAreValid(@requiredParams)) {

        my $errorMessage = "Required information is missing. " .

            "Please fill in all required fields and submit the form.";

                                        allParams => $allParams,

                                        errorMessage => $errorMessage });

        exit();

    # We have all of the info we need, so try to change the password

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

        exit();

        my $errorMessage = "";

        my $recipient;

        my $userPass;

        my $entry = getLdapEntry($ldapurl, $searchBase,

                $query->param('uid'), $query->param('o'));

        if ($entry) {

            $recipient = $entry->get_value('mail');

            $userPass = getRandomPassword();

            $errorMessage = "User not found in database.  Please try again.";

        }

        if ($errorMessage) {

                                           allParams => $allParams,

                                           errorMessage => $errorMessage });

            exit();

            my $errorMessage = sendPasswordNotification($query->param('uid'),

                                                  allParams => $allParams,

                                                  errorMessage => $errorMessage });

            exit();

    }

}

#

# only display resetpass template without any error

#

sub handleInitialResetPassword {

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

    my $errorMessage = "";

                                   errorMessage => $errorMessage });

    exit();

#

#

sub getRandomPassword {

    my $length = shift;

    if (!$length) {

        $length = 8;

    }

    my $newPass = "";

    my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9, qw(! @ $ ^) );

    $newPass = join("", @chars[ map { rand @chars } ( 1 .. $length ) ]);

    return $newPass;

}

#

# Change a password to a new value, binding as the provided user

#

sub changePassword {

    my $userDN = shift;

    my $userPass = shift;

    my $bindDN = shift;

    my $bindPass = shift;

    my $o = shift;

    my $searchBase = $ldapConfig->{$o}{'base'};

    my $errorMessage = 0;

    if ($ldapurl =~ $mainldapurl){

        #if main ldap server is down, a html file containing warning message will be returned

        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);

    }

    else{

        #if a referral ldap server is down, we will ignore it silently

        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;

    }

                      #cafile => '/usr/share/ssl/ldapcerts/cacert.pem');

    $ldap->start_tls( verify => 'none');

                                  password => $bindPass );

    if ($bindresult->code) {

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

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

        return $errorMessage;

    }

    # 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()) {

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

                           "<br />\n" . $result->error;

    }

    $ldap->unbind;   # take down session

    return $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;

}

#

# Look up an ldap entry for a user

#

sub getLdapEntry {

    my $ldapurl = shift;

    my $base = shift;

    my $username = shift;

    my $org = shift;

    my $entry = "";

    my $mesg;

    print("ldap server ", $ldapurl, "\n");

    if ($ldapurl =~ $mainldapurl){

        #if main ldap server is down, a html file containing warning message will be returned

        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or handleGeneralServerFailure($mainldapdownmessage);

    }

    else{

        #if a referral ldap server is down, we will ignore it silently

        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;

    }

    if ($bindresult->code) {

        return $entry;

    }

        $entry = $mesg->pop_entry;

        $ldap->unbind;   # take down session

    } else {

        $ldap->unbind;   # take down session

        # Follow references by recursive call to self

        my @references = $mesg->references();

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

            my $uri = URI->new($references[$i]);

            my $host = $uri->host();

            my $path = $uri->path();

            $path =~ s/^\///;

            $entry = &getLdapEntry($host, $path, $username, $org);

            if ($entry) {

                return $entry;

            }

        }

    }

    return $entry;

}

#

# send an email message notifying the user of the pw change

#

sub sendPasswordNotification {

    my $username = shift;

    my $org = shift;

    my $newPass = shift;

    my $recipient = shift;

    my $errorMessage = "";

    if ($recipient) {

        # Send the email message to them

        my $smtp = Net::SMTP->new($mailhost);

        $smtp->mail($sender);

        $smtp->to($recipient);

        my $message = <<"        ENDOFMESSAGE";

        To: $recipient

        From: $sender

        Subject: KNB Password Reset

        Somebody (hopefully you) requested that your KNB password be reset.

        This is generally done when somebody forgets their password.  Your

        password can be changed by visiting the following URL:

            Username: $username

        Organization: $org

        New Password: $newPass

        Thanks,

            The KNB Development Team

        ENDOFMESSAGE

        $message =~ s/^[ \t\r\f]+//gm;

        $smtp->data($message);

        $smtp->quit;

    } else {

        $errorMessage = "Failed to send password because I " .

                        "couldn't find a valid email address.";

    }

    return $errorMessage;

}

#

# search the LDAP directory to see if a similar account already exists

#

sub findExistingAccounts {

    my $ldapurl = shift;

    my $base = shift;

    my $filter = shift;

    my $attref = shift;

    my $foundAccounts = 0;

    if ($ldapurl =~ $mainldapurl){

        #if main ldap server is down, a html file containing warning message will be returned

    else{

        #if a referral ldap server is down, we will ignore it silently

        $ldap = Net::LDAP->new($ldapurl, timeout => $TIMEOUT) or return;

    }

    my $mesg = $ldap->search (

        base   => $base,

        filter => $filter,

        attrs => @$attref,

    );

    if ($mesg->count() > 0) {

        $foundAccounts = "";

        my $entry;

        foreach $entry ($mesg->all_entries) {

            $foundAccounts .= "<p>\n<b><u>Account:</u> ";

            $foundAccounts .= $entry->dn();

            $foundAccounts .= "</b><br />\n";

            foreach my $attribute ($entry->attributes()) {

                $foundAccounts .= "$attribute: ";

                $foundAccounts .= $entry->get_value($attribute);

                $foundAccounts .= "<br />\n";

            }

            $foundAccounts .= "</p>\n";

        }

    }

    $ldap->unbind;   # take down session

    # Follow references

    my @references = $mesg->references();

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

        my $uri = URI->new($references[$i]);

        my $host = $uri->host();

        my $path = $uri->path();

        $path =~ s/^\///;

        my $refFound = &findExistingAccounts($host, $path, $filter, $attref);

        if ($refFound) {

            $foundAccounts .= $refFound;

        }

    }

    #print "<p>Checking referrals...</p>\n";

    #my @referrals = $mesg->referrals();

    #print "<p>Referrals count: ", scalar(@referrals), "</p>\n";

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

        #print "<p>Referral: ", $referrals[$i], "</p>\n";

    #}

    return $foundAccounts;

}

#

# Validate that we have the proper set of input parameters

#

sub paramsAreValid {

    my @pnames = @_;

    my $allValid = 1;

    foreach my $parameter (@pnames) {

        if (!defined($query->param($parameter)) ||