Metacat

#!/usr/bin/perl -w

#

#  '$RCSfile$'

#  Copyright: 2001 Regents of the University of California 

#

#   '$Author: tao $'

#     '$Date: 2013-09-17 15:22:35 -0700 (Tue, 17 Sep 2013) $'

# '$Revision: 8221 $' 

# 

# 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 lib '../WEB-INF/lib';

use strict;             # turn on strict syntax checking

use Template;           # load the template-toolkit module

use CGI qw/:standard :html3/; # 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

use Captcha::reCAPTCHA; # for protection against spams

use Cwd 'abs_path';

# Global configuration paramters

# This entire block (including skin parsing) could be pushed out to a separate .pm file

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);

}

$properties->load(*METACAT_PROPERTIES);

# local directory configuration

my $skinsDir = "${workingDirectory}/../style/skins";

my $templatesDir = abs_path("${workingDirectory}/../style/common/templates");

my $tempDir = $properties->getProperty('application.tempDir');

# url configuration

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

my $protocol = 'http://';

if ( $properties->getProperty('server.httpPort') eq '443' ) {

	$protocol = 'https://';

}

my $contextUrl = $protocol . $properties->getProperty('server.name');

if ($properties->getProperty('server.httpPort') ne '80') {

        $contextUrl = $contextUrl . ':' . $properties->getProperty('server.httpPort');

}

$contextUrl = $contextUrl . '/' .  $properties->getProperty('application.context');

my $metacatUrl = $contextUrl . "/metacat";

my $cgiPrefix = "/" . $properties->getProperty('application.context') . "/cgi-bin";

my $styleSkinsPath = $contextUrl . "/style/skins";

my $styleCommonPath = $contextUrl . "/style/common";

#recaptcha key information

my $recaptchaPublicKey=$properties->getProperty('ldap.recaptcha.publickey');

my $recaptchaPrivateKey=$properties->getProperty('ldap.recaptcha.privatekey');

my @errorMessages;

my $error = 0;

my $emailVerification= 'emailverification';

# Import all of the HTML form fields as variables

import_names('FORM');

# Must have a config to use Metacat

my $skinName = "";

if ($FORM::cfg) {

    $skinName = $FORM::cfg;

} elsif ($ARGV[0]) {

    $skinName = $ARGV[0];

} else {

    debug("No configuration set.");

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

    print 'LDAPweb Error: The registry requires a skin name to continue.';

    exit();

}

# Metacat isn't initialized, the registry will fail in strange ways.

if (!($metacatUrl)) {

    debug("No Metacat.");

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

    'Registry Error: Metacat is not initialized! Make sure' .

        ' MetacatUrl is set correctly in ' .  $skinName . '.properties';

    exit();

}

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

if (!($skinName)) {

    $error = "Application misconfigured.  Please contact the administrator.";

    push(@errorMessages, $error);

} else {

    my $skinProps = "$skinsDir/$skinName/$skinName.properties";

    unless (open (SKIN_PROPERTIES, $skinProps)) {

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

        print "Unable to locate skin properties at $skinProps.  Is this path correct?";

        exit(0);

    }

    $skinProperties->load(*SKIN_PROPERTIES);

}

my $config = $skinProperties->splitToTree(qr/\./, 'registry.config');

# XXX HACK: this is a temporary fix to pull out the UCNRS password property from the

#           NRS skin instead of metacat.properties. The intent is to prevent editing

#           of our core properties file, which is manipulated purely through the web.

#           Once organizations are editable, this section should be removed as should

#           the properties within nrs/nrs.properties.

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

my $nrsProps = "$skinsDir/nrs/nrs.properties";

unless (open (NRS_PROPERTIES, $nrsProps)) {

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

    print "Unable to locate skin properties at $nrsProps.  Is this path correct?";

    exit(0);

}

$nrsProperties->load(*NRS_PROPERTIES);

my $nrsConfig = $nrsProperties->splitToTree(qr/\./, 'registry.config');

# XXX END HACK

my $searchBase;

my $ldapUsername;

my $ldapPassword;

# TODO: when should we use surl instead? Is there a setting promoting one over the other?

# TODO: the default tree for accounts should be exposed somewhere, defaulting to unaffiliated

my $ldapurl = $properties->getProperty('auth.url');

# Java uses miliseconds, Perl expects whole seconds

my $timeout = $properties->getProperty('ldap.connectTimeLimit') / 1000;

# Get the CGI input variables

my $query = new CGI;

my $debug = 1;

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

# Set up the Template Toolkit to read html form templates

# templates hash, imported from ldap.templates tree in metacat.properties

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

$$templates{'header'} = $skinProperties->getProperty("registry.templates.header");

$$templates{'footer'} = $skinProperties->getProperty("registry.templates.footer");

# set some configuration options for the template object

my $ttConfig = {

             INCLUDE_PATH => $templatesDir,

             INTERPOLATE  => 0,

             POST_CHOMP   => 1,

             DEBUG        => 1, 

             };

# create an instance of the template

my $template = Template->new($ttConfig) || handleGeneralServerFailure($Template::ERROR);

# custom LDAP properties hash

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

# This is a hash which has the keys of the organization's properties 'name', 'base', 'organization'.

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

#This is a hash which has the keys of the ldap sub tree names of the organizations, such as 'NCEAS', 'LTER' and 'KU', and values are real name of the organization.

my $orgNames = $properties->splitToTree(qr/\./, 'organization.name');

# pull out properties available e.g. 'name', 'base'

my @orgData = keys(%$orgProps);

my @orgList; #An array has the names (i.e, sub tree names, such as 'NCEAS', 'LTER' and 'KU')  of the all organizations in the metacat.properties. 

while (my ($oKey, $oVal) = each(%$orgNames)) {

    push(@orgList, $oKey);

}

my $authBase = $properties->getProperty("auth.base");

my $ldapConfig;

foreach my $o (@orgList) {

    foreach my $d (@orgData) {

        $ldapConfig->{$o}{$d} = $properties->getProperty("organization.$d.$o");

    }

    # XXX hack, remove after 1.9

    if ($o eq 'UCNRS') {

        $ldapConfig->{'UCNRS'}{'base'} = $nrsConfig->{'base'};

        $ldapConfig->{'UCNRS'}{'user'} = $nrsConfig->{'username'};

        $ldapConfig->{'UCNRS'}{'password'} = $nrsConfig->{'password'};

    }

    # set default base

    if (!$ldapConfig->{$o}{'base'}) {

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

    }

    # include filter information. By default, our filters are 'o=$name', e.g. 'o=NAPIER'

    # these can be overridden by specifying them in metacat.properties. Non-default configs

    # such as UCNRS must specify all LDAP properties.

    if ($ldapConfig->{$o}{'base'} eq $authBase) {

        my $filter = "o=$o";

        if (!$ldapConfig->{$o}{'org'}) {

            $ldapConfig->{$o}{'org'} = $filter;

        }

        if (!$ldapConfig->{$o}{'filter'}) {

            #$ldapConfig->{$o}{'filter'} = $filter;

            $ldapConfig->{$o}{'filter'} = $ldapConfig->{$o}{'org'};

        }

        # also include DN, which is just org + base

        if ($ldapConfig->{$o}{'org'}) {

            $ldapConfig->{$o}{'dn'} = $ldapConfig->{$o}{'org'} . "," . $ldapConfig->{$o}{'base'};

        }

    } else {

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

    }

    # set LDAP administrator user account

    if (!$ldapConfig->{$o}{'user'}) {

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

    }

    # check for a fully qualified LDAP name. If it doesn't exist, append base.

    my @userParts = split(',', $ldapConfig->{$o}{'user'});

    if (scalar(@userParts) == 1) {

        $ldapConfig->{$o}{'user'} = $ldapConfig->{$o}{'user'} . "," . $ldapConfig->{$o}{'base'};

    }

    if (!$ldapConfig->{$o}{'password'}) {

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

    }

}

### Determine the display organization list (such as NCEAS, Account ) in the ldap template files

my $displayOrgListStr;

$displayOrgListStr = $skinProperties->getProperty("ldap.templates.organizationList") or $displayOrgListStr = $properties->getProperty('ldap.templates.organizationList');

debug("the string of the org from properties : " . $displayOrgListStr);

my @displayOrgList = split(';', $displayOrgListStr);

my @validDisplayOrgList; #this array contains the org list which will be shown in the templates files.

my %orgNamesHash = %$orgNames;

foreach my $element (@displayOrgList) {

    if(exists $orgNamesHash{$element}) {

         debug("push the organization " . $element . " into the dispaly array");

         #if the name is found in the organization part of metacat.properties, put it into the valid array

         push(@validDisplayOrgList, $element);

    } 

}

if(!@validDisplayOrgList) {

     my $sender;

     $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');

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

    print "The value of property ldap.templates.organizationList in " 

     . $skinName . ".properties file or metacat.properties file (if the property doesn't exist in the " 

     . $skinName . ".properties file) is invalid. Please send the information to ". $sender;

    exit(0);

}

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

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

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

# The processing step we are handling

my $stage = $query->param('stage') || $templates->{'stage'};

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

debug("started with stage $stage, cfg $cfg");

# define the possible stages

my %stages = (

              'initregister'      => \&handleInitRegister,

              'register'          => \&handleRegister,

              'registerconfirmed' => \&handleRegisterConfirmed,

              'simplesearch'      => \&handleSimpleSearch,

              'initaddentry'      => \&handleInitAddEntry,

              'addentry'          => \&handleAddEntry,

              'initmodifyentry'   => \&handleInitModifyEntry,

              'modifyentry'       => \&handleModifyEntry,

              'changepass'        => \&handleChangePassword,

              'initchangepass'    => \&handleInitialChangePassword,

              'resetpass'         => \&handleResetPassword,

              'initresetpass'     => \&handleInitialResetPassword,

              'emailverification' => \&handleEmailVerification,

              'lookupname' => \&handleLookupName,

             );

# call the appropriate routine based on the stage

if ( $stages{$stage} ) {

  $stages{$stage}->();

} else {

  &handleResponseMessage();

}

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

# Define the subroutines to do the work

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

sub fullTemplate {

    my $templateList = shift;

    my $templateVars = setVars(shift);

    my $c = Captcha::reCAPTCHA->new;

    my $captcha = 'captcha';

    #my $error=null;

    my $use_ssl= 1;

    #my $options=null;

    $templateVars->{$captcha} = $c->get_html($recaptchaPublicKey,undef, $use_ssl, undef);

    $template->process( $templates->{'header'}, $templateVars );

    foreach my $tmpl (@{$templateList}) {

        $template->process( $templates->{$tmpl}, $templateVars );

    }

    $template->process( $templates->{'footer'}, $templateVars );

}

#

# Handle the user's request to look up account names with a specified email address.

# This relates to "Forget your user name"

#

sub handleLookupName {

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

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

    my @requiredParams = ('mail');

    if (! paramsAreValid(@requiredParams)) {

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

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

        fullTemplate(['lookupname'], { stage => "lookupname",

                                     allParams => $allParams,

                                     errorMessage => $errorMessage });

        exit();

    }

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

    #search accounts with the specified emails 

    $searchBase = $authBase; 

    my $filter = "(mail=" . $mail . ")";

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

    my $notHtmlFormat = 1;

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

    my $accountInfo;

    if($found) {

        $accountInfo = $found;

    } else {

        my $link = $contextUrl. '/cgi-bin/ldapweb.cgi?cfg=' . $skinName;

        $accountInfo = "There are no KNB accounts associated with the email " . $mail . ".\n" .

                       "You may create a new one by the following link: \n" . $link

    }

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

    my $sender;

    $sender = $skinProperties->getProperty("email.sender") or $sender = $properties->getProperty('email.sender');

    debug("the sender is " . $sender);

    my $recipient = $query->param('mail');

    # Send the email message to them

    my $smtp = Net::SMTP->new($mailhost) or do {  

                                                  fullTemplate( ['lookupNameFailed'], {errorMessage => "Our mail server currently is experiencing some difficulties. Please contact " . 

                                                  $skinProperties->getProperty("email.recipient") . "." });  

                                                  exit(0);

                                               };

    $smtp->mail($sender);

    $smtp->to($recipient);

    my $message = <<"     ENDOFMESSAGE";

    To: $recipient

    From: $sender

    Subject: KNB Account

    Somebody (hopefully you) looked up the KNB accounts associated with the email address.  

    Here is the accounts information:

    $accountInfo

    Thanks,

        The KNB Development Team

     ENDOFMESSAGE

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

     $smtp->data($message);

     $smtp->quit;

     fullTemplate( ['lookupNameSuccess'] );

}

#

# create the initial registration form 

#

sub handleInitRegister {

  my $vars = shift;

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

  # process the template files:

  fullTemplate(['register'], {stage => "register"}); 

  exit();

}

#

# 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";

    if ($query->param('o') =~ "LTER") {

      fullTemplate( ['registerLter'] );

      exit(0);

    } 

    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 the recaptcha

    my $c = Captcha::reCAPTCHA->new;

    my $challenge = $query->param('recaptcha_challenge_field');

    my $response = $query->param('recaptcha_response_field');

    # Verify submission

    my $result = $c->check_answer(

        $recaptchaPrivateKey, $ENV{'REMOTE_ADDR'},

        $challenge, $response

    );

    if ( $result->{is_valid} ) {

        #print "Yes!";

        #exit();

    }

    else {

        my $errorMessage = "The verification code is wrong. Please input again.";

        fullTemplate(['register'], { stage => "register",

                                     allParams => $allParams,

                                     errorMessage => $errorMessage });

        exit();

    }

    # 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.";

        fullTemplate(['register'], { stage => "register",

                                     allParams => $allParams,

                                     errorMessage => $errorMessage });

        exit();

    } else {

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

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

            fullTemplate( ['registerFailed', 'register'], { stage => "register",

                                                            allParams => $allParams,

                                                            errorMessage => $errorMessage });

            exit();

        }

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

        $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', 'ou', '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) {

      fullTemplate( ['registerMatch', 'register'], { stage => "registerconfirmed",

                                                     allParams => $allParams,

                                                     foundAccounts => $found });

    # Otherwise, create a new user in the LDAP directory

    } else {

        createTemporaryAccount($allParams);

    }

    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'),

                      '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') };

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

    createTemporaryAccount($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');

        my $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.";

        fullTemplate( ['changePass'], { stage => "changepass",

                                        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')) {

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

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

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

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

        my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};;

        if ($query->param('o') =~ "LTER") {

            fullTemplate( ['registerLter'] );

        } else {

            my $errorMessage = changePassword(

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

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

            if ($errorMessage) {

                fullTemplate( ['changePass'], { stage => "changepass",

                                                allParams => $allParams,

                                                errorMessage => $errorMessage });

                exit();

            } else {

                fullTemplate( ['changePassSuccess'], { stage => "changepass",

                                                       allParams => $allParams });

                exit();

            }

        }

    } else {

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

        fullTemplate( ['changePass'], { stage => "changepass",

                                        allParams => $allParams,

                                        errorMessage => $errorMessage });

        exit();

    }

}

#

# change a user's password upon request - no input params

# only display chagepass template without any error

#

sub handleInitialChangePassword {

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

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

    my $errorMessage = "";

    fullTemplate( ['changePass'], { stage => "changepass",

                                    errorMessage => $errorMessage });

    exit();

}

#

# reset a user's password upon request

#

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');

        my $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.";

        fullTemplate( ['resetPass'],  { stage => "resetpass",

                                        allParams => $allParams,

                                        errorMessage => $errorMessage });

        exit();

    }

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

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

    my $dn = "uid=" . $query->param('uid') . "," . $ldapConfig->{$o}{'dn'};

    debug("handleResetPassword: dn: $dn");

    if ($query->param('o') =~ "LTER") {

        fullTemplate( ['registerLter'] );

        exit();

    } else {

        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 = changePassword($dn, $userPass, $ldapUsername, $ldapPassword, $query->param('o'));

        } else {

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

        }

        if ($errorMessage) {

            fullTemplate( ['resetPass'], { stage => "resetpass",

                                           allParams => $allParams,

                                           errorMessage => $errorMessage });

            exit();

        } else {

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

                    $query->param('o'), $userPass, $recipient, $cfg);

            fullTemplate( ['resetPassSuccess'], { stage => "resetpass",

                                                  allParams => $allParams,

                                                  errorMessage => $errorMessage });

            exit();

        }

    }

}

#

# reset a user's password upon request- no initial params

# only display resetpass template without any error

#

sub handleInitialResetPassword {

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

    my $errorMessage = "";

    fullTemplate( ['resetPass'], { stage => "resetpass",

                                   errorMessage => $errorMessage });

    exit();

}

#

# Construct a random string to use for a newly reset password

#

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;

    my $ldap;

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

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

    if ($ldap) {

        #$ldap->start_tls( verify => 'require',

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

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

        debug("changePassword: attempting to bind to $bindDN");

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

                                  password => $bindPass );

        if ($bindresult->code) {

            $errorMessage = "Failed to log in. Are you sure your connection credentails are " .

                            "correct? Please correct and try again...";

            return $errorMessage;

        }

    	# Find the user here and change their entry

    	my $newpass = createSeededPassHash($userPass);

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

      debug("changePass: setting password for $userDN to $newpass");

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

    	if ($result->code()) {

            debug("changePass: error changing password: " . $result->error);

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

    my $ldap;

    debug("ldap server: $ldapurl");

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

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

    if ($ldap) {

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