#!/usr/local/bin/perl

###############################################################################
# Program     : ChangePassword
# Author      : Eric Deutsch <edeutsch@systemsbiology.org>
# $Id$
#
# Description : This script allows the user to change his or her password
#
# SBEAMS is Copyright (C) 2000-2005 Institute for Systems Biology
# This program is governed by the terms of the GNU General Public License (GPL)
# version 2 as published by the Free Software Foundation.  It is provided
# WITHOUT ANY WARRANTY.  See the full description of GPL terms in the
# LICENSE file distributed with this software.
#
###############################################################################


###############################################################################
# Set up all needed modules and objects
###############################################################################
use strict;
use Getopt::Long;
use FindBin;

use lib "$FindBin::Bin/../lib/perl";
use vars qw ($sbeams $sbeamsMOD $q $current_contact_id $current_username
             $PROG_NAME $USAGE %OPTIONS $QUIET $VERBOSE $DEBUG $TESTONLY
             $TABLE_NAME $PROGRAM_FILE_NAME $CATEGORY $DB_TABLE_NAME
             @MENU_OPTIONS);

use SBEAMS::Connection qw($q);
use SBEAMS::Connection::Settings;
use SBEAMS::Connection::Tables;

$sbeams = new SBEAMS::Connection;

#use CGI;
#$q = new CGI;


###############################################################################
# Set program name and usage banner for command line use
###############################################################################
$PROG_NAME = $FindBin::Script;
$USAGE = <<EOU;
Usage: $PROG_NAME [OPTIONS] key=value key=value ...
Options:
  --verbose n         Set verbosity level.  default is 0
  --quiet             Set flag to print nothing at all except errors
  --debug n           Set debug flag to level n
  --testonly          Set testonly flag which simulates INSERTs/UPDATEs only

 e.g.:  $PROG_NAME --verbose 2 keyword=value

EOU

#### Process options
unless (GetOptions(\%OPTIONS,"verbose:s","quiet","debug:s","quiet")) {
  print "$USAGE";
  exit;
}

$VERBOSE = $OPTIONS{"verbose"} || 0;
$QUIET = $OPTIONS{"quiet"} || 0;
$DEBUG = $OPTIONS{"debug"} || 0;
$TESTONLY = $OPTIONS{"testonly"} || 0;
if ($DEBUG) {
  print "Options settings:\n";
  print "   VERBOSE = $VERBOSE\n";
  print "     QUIET = $QUIET\n";
  print "     DEBUG = $DEBUG\n";
  print "  TESTONLY = $TESTONLY\n";
}


###############################################################################
# Set Global Variables and execute main()
###############################################################################
main();
exit(0);



###############################################################################
# Main Program:
#
# Call $sbeams->Authentication and stop immediately if authentication
# fails else continue and destroy the user's cookie.
###############################################################################
sub main {

  #### Do the SBEAMS authentication and exit if a username is not returned
  exit unless ($current_username = $sbeams->Authenticate());

  #### Read in the default input parameters
  my %parameters;
  my $n_params_found = $sbeams->parse_input_parameters(
    q=>$q,parameters_ref=>\%parameters);
  #$sbeams->printDebuggingInfo($q);

  #### Call processLogut which prints a header and message, and print footer
  $sbeams->printPageHeader();
  if ($parameters{action} eq 'CHANGE') {
    changePassword();
  } else {
    printEntryForm();
  }
  $sbeams->printPageFooter();

} # end main



###############################################################################
# printEntryForm
###############################################################################
sub printEntryForm {
  my %args = @_;

  #### Process the arguments list


  #### Define popular variables
  my ($i,$element,$key,$value,$line,$result,$sql);
  my ($username,$row);


  #### Start the page and form
  $sbeams->printUserContext();
  print qq~
      <P>
      <H2>Change Password</H2>
      $LINESEPARATOR
      <P>To change your $DBTITLE password, please first enter your current
      password, and then your new password twice for verification.</P>
      <P>Leave the new password fields both empty to fall back to local
      network password authentication (i.e. your local UNIX or Windows
      password) if you have a local network password.</P>
      <P> Note that you cannot change your network password via this
      interface, only your $DBTITLE password.</P>
      <P>Your new password must be at least 5 characters long
      with a mixture of upper
      and lower case and at least one non-alphabetic character.<P>
      <FORM METHOD="post" NAME="MainForm">
      <TABLE>
  ~;


  #### Write out the HTML form entries
  print qq~
    <TR><TD><B><font color=red>Current Password:</font></B></TD>
        <TD><INPUT TYPE="password" NAME="old_password"
         SIZE=25></TD></TR>
    <TR><TD><B>New Password:</font></TD>
        <TD><INPUT TYPE="password" NAME="new_password"
         SIZE=25></TD></TR>
    <TR><TD><B>New Password:</font></TD>
        <TD><INPUT TYPE="password" NAME="new_verify"
         SIZE=25></TD></TR>
    <TR><TD>&nbsp;</TD><TD>
        <INPUT TYPE="submit" NAME="action" VALUE="CHANGE">
        </TD></TR>
  ~;

  $sbeams->printPageFooter(close_tables=>'YES',display_footer=>'NO');

  return;


}



###############################################################################
# changePassword
###############################################################################
sub changePassword {
  my %args = @_;

  #### Process the arguments list


  #### Define popular variables
  my ($i,$element,$key,$value,$line,$result,$sql);
  my ($username,$row);


  #### Define the columns and input types
  my @columns = qw(old_password new_password new_verify);
  my %input_types = ( 
    old_password => 'password',
    new_password => 'password',
    new_verify => 'password',
  );


  #### Read the input parameters for each column
  my %parameters;
  my $n_params_found = $sbeams->parse_input_parameters(
    q=>$q,parameters_ref=>\%parameters,
    columns_ref=>\@columns,input_types_ref=>\%input_types);


  #### Verify the current password login information
  $current_username = $sbeams->getCurrent_username();
  $result = $sbeams->checkLogin($current_username,$parameters{old_password});


  #### If the password was not correct, stop here
  unless ($result) {
    print "<BR><BR>
      <B>ERROR: Current password is incorrect.</B><BR><BR>
      The current password you provided does not match the password in
      the system, so the change cannot be completed.  Click [BACK] and
      try again.<BR><BR>
      If you do not remember your current password, please
      see your SBEAMS administrator to have it reset.
    ";
    return;
  }


  #### Verify that both new passwords are the same
  unless ($parameters{new_password} eq $parameters{new_verify}) {
    print "<BR><BR>
      <B>ERROR: Password verification does not match.</B><BR><BR>
      The new password you entered does not match the second verification.
      You must enter the new password twice exactly the same.
      Click [BACK] and try again.<BR><BR>
    ";
    return;
  }


  #### Apply a few password rules
  if ($parameters{new_password} =~ /^[A-Za-z]+$/ ||
      (length($parameters{new_password}) < 5 &&
       length($parameters{new_password}) > 0) ) {
    print "<BR><BR>
      <B>ERROR: The new password does not pass basic requirementst</B>
      <BR><BR>
      Click [BACK] and provide a new password of at least 5 characters
      with a mixture of upper
      and lower case and at least one non-alphabetic character.<BR><BR>
    ";
    return;
  }


  #### Determine the user_login_id
  $current_contact_id = $sbeams->getCurrent_contact_id();
  $sql = qq~
    SELECT user_login_id
      FROM $TB_USER_LOGIN
     WHERE contact_id = '$current_contact_id'
       AND record_status != 'D'
  ~;
  my (@ids) = $sbeams->selectOneColumn($sql);
  if (scalar(@ids) != 1) {
    die("INTERNAL ERROR: Unable to find unique user_login_id");
  }
  my $user_login_id = $ids[0];


  #### Encrypt the password if set
  my $new_password = undef;
  if ($parameters{new_password} gt '') {
    my $salt  = int(rand() * 220);
    $new_password =  crypt($parameters{new_password},$salt);
  }


  #### Update the record
  my %rowdata = ( password => $new_password );
  $sbeams->updateOrInsertRow(
    update=>1,
    table_name => $TB_USER_LOGIN,
    rowdata_ref => \%rowdata,
    PK => 'user_login_id',
    PK_value => $user_login_id,
    verbose => $VERBOSE,
    testonly => $TESTONLY,
  );


  print qq~
    <BR><B>Your password has been changed.</B><BR><BR>
    Thank you for changing your password.  It is a Good Thing.
  ~;

  return;

}