#
# This is the name of the module.
#
package HTTPPassword;

#===============================================================================
#
# Constructor: 
#	$obj = new HTTPPassword($passwordFile);
#
# Methods:
#       $obj->addUser($userID, $userPassword);
#       $obj->changeUserPassword($userID, $userNewPassword, [$userOldPassword]);
#       $obj->generateCryptedPassword($userPassword);
#       $obj->getPasswordFileUsers();
#       $obj->getUserCryptedPassword($userID);
#       $obj->isUserExist($userID);
#       $obj->isValidUserPassword($userID, $userPassword);
#       $obj->removeUser($userID, [$userPassword]);
#       $obj->version();
#       HTTPPassword::Usage($usage);
#
# *p/s: For more details, please refer to the description below.
#
#===============================================================================

#
# Fcntl module is used to lock the file when we are modifying it.
#
use Fcntl;
use Carp;
use strict;
use vars qw($VERSION $LOCK_EX $LOCK_UN);

$VERSION = "1.03";
$LOCK_EX = 2;
$LOCK_UN = 8;

#===============================================================================
#
# CONSTRUCTOR:  $obj = new HTTPPassword($passwordFile);
#
# DESCRIPTION:  This is the constructor of the HTTPPassword object.
#
#===============================================================================
sub new {
  my($pkg)		= shift;
  my($passwordFile)	= shift;
  my($self)		= {};

  bless $self, $pkg;

  #
  # The errorMessage property will store the last error.
  #
  $self->{'errorMessage'} = undef;

  #
  # The passwordFile property contains the current password file that
  # we are using. We will check to make sure the file exists.
  #
  $self->{'passwordFile'} = $passwordFile;
  if (! -f $self->{'passwordFile'}) {
    HTTPPassword::Usage("\$obj = new HTTPPassword(\$passwordFile);\nPassword file does not exist.");
  }

  return $self;

}

#===============================================================================
#
# METHOD:       $obj->addUser($userID, $userPassword);
#
# DESCRIPTION:  Add the new user with ID, $userID, and his password, 
#		$userPassword, to our password file.
#		Return 0 if success, else -1.
#
#===============================================================================
sub addUser {
  my($self)		= shift;
  my($userID)		= shift;
  my($userPassword)	= shift;

  if ($userID =~ /^\s*$/ || $userPassword =~ /^\s*$/) {
    HTTPPassword::Usage("addUser(\$userID, \$userPassword);");
  }

  if ($self->isUserExist($userID) == 0) {
    $self->{'errorMessage'} = "User $userID already exists.";
    return -1;
  }

  my($cryptedPassword) = $self->generateCryptedPassword($userPassword);

  open(PASSWD, ">>$self->{'passwordFile'}") || 
              confess "Fail to apend new user to password file: $!";
  flock(PASSWD, $LOCK_EX) || confess "Fail to lock the PASSWD filehandle: $!";
  print PASSWD "$userID:$cryptedPassword\n";
  close(PASSWD);

  $self->{'errorMessage'} = undef;

  return 0;

}

#===============================================================================
#
# METHOD:       $obj->generateCryptedPassword($userPassword);
#
# DESCRIPTION:  Crypt the password with the random seed that we got and 
#		return it.
#
#===============================================================================
sub generateCryptedPassword {
  my($self)		= shift;
  my($userPassword)	= shift;

  if ($userPassword =~ /^\s*$/) {
    HTTPPassword::Usage("generateCryptedPassword(\$userPassword);");
  }

  srand(time ^ $$);
  my($seed) = join("", ('a'..'z','A'..'Z', 0..9)[map rand $_, (62)x2]);

  return crypt($userPassword, $seed);

}

#===============================================================================
#
# METHOD :	$obj->getPasswordFileUsers();
#
# DESCRIPTION :	This will return the users available in the password file.
#		The return value is the reference of the array of the
#		users' ID.
#
#===============================================================================
sub getPasswordFileUsers {
    my($self) = shift;
    my(@userArr) = ();

    open(PASS, $self->{'passwordFile'}) ||
		return $self->error("Fail to read password file, $self->{'passwordFile'}: $!");
    while (<PASS>) {
      next if /^\s*#/;
      next if /^\s*$/;
      chop;
      my($userID, $encryptedPasswd) = split(/:/, $_, 2);
      push(@userArr, $userID);
    }
    close(PASS);
	
    return \@userArr;
}


#===============================================================================
#
# METHOD:       $obj->isUserExist($userID);
#
# DESCRIPTION:  Check if the user exists in our password file, return 0 when
#		he exists, else return -1.
#
#===============================================================================
sub isUserExist {
  my($self)		= shift;
  my($userID)		= shift;
  my($cryptedPassword)	= undef;

  if ($userID =~ /^\s*$/) {
    HTTPPassword::Usage("isUserExist(\$userID);");
  }

  if (($cryptedPassword = $self->getUserCryptedPassword($userID)) == -1) {
    return -1;
  }
  $self->{'errorMessage'} = undef;

  return 0;

}

#===============================================================================
#
# METHOD:       $obj->removeUser($userID, [$userPassword]);
#
# DESCRIPTION:  Remove the user from our password file if he exists.
#		Return 0 if success, else -1.
#
#===============================================================================
sub removeUser {
  my($self) 		= shift;
  my($userID)		= shift;
  my($userPassword)	= shift;

  if ($userID =~ /^\s*$/) {
    HTTPPassword::Usage("removeUser(\$userID, [\$userPassword]);");
  }

  if ($userPassword !~ /^\s*$/) {
    if ($self->isValidUserPassword($userID, $userPassword) != 0) {
      $self->{'errorMessage'} = "Invalid user password.";
      return -1;
    }
  }

  open(PASSWD, "+<$self->{'passwordFile'}") || 
		confess "Fail to read/write password file: $!";
  flock(PASSWD, $LOCK_EX) || 
		confess "Fail to lock the PASSWD filehandle: $!";
  my($data) = undef;
  while (<PASSWD>) {
    next unless /^${userID}\:/;
    my($currPos) = tell(PASSWD) - length($_);
    while (<PASSWD>) {
      $data .= $_;
    }
    truncate(PASSWD, length($data) + $currPos);
    seek(PASSWD, $currPos, 0);
    print PASSWD $data;
    close(PASSWD);
    $self->{'errorMessage'} = undef;
    return 0;
  }
  close(PASSWD);
  $self->{'errorMessage'} = "User $userID does not exist.";

  return -1;

}

#===============================================================================
#
# METHOD:       HTTPPassword::Usage($usage);
#
# DESCRIPTION:  Will print the usage to the standard error, STDERR, and exit.
#
#===============================================================================
sub Usage {
  my($usage) = shift;

  if ($usage =~ /^\s*$/) {
    HTTPPassword::Usage("Usage(\$message);");
  }

  print STDERR "Usage: $usage\n";

  exit(-1);

}

#===============================================================================
#
# METHOD:       $obj->changeUserPassword($userID, $userNewPassword, 
#		[$userOldPassword]);
#
# DESCRIPTION:  Update the user's password in our password file, will
#		check the old password if it has been passed in.
#		Return 0 if success, else -1.
#
#===============================================================================
sub changeUserPassword {
  my($self)		= shift;
  my($userID)		= shift;
  my($userNewPassword)	= shift;
  my($userOldPassword)	= shift;

  if ($userID =~ /^\s*$/ || $userNewPassword =~ /^\s*$/) {
    HTTPPassword::Usage("changeUserPassword(\$userID, \$userNewPassword, [\$userOldPassword]);");
  }

  if ($userOldPassword !~ /^\s*$/) {
    if ($self->isValidUserPassword($userID, $userOldPassword) != 0) {
      $self->{'errorMessage'} = "Invalid user password.";
      return -1;
    }
  }

  my($newCryptedPassword) = $self->generateCryptedPassword($userNewPassword);
  open(PASSWD, "+<$self->{'passwordFile'}") || 
	confess "Fail to update password file: $!";
  flock(PASSWD, $LOCK_EX) || die "$!";
  while (<PASSWD>) {
    next unless /^${userID}\:/;
    my($currPos) = tell(PASSWD) - length($_);
    s/^($userID):.+$/$1:$newCryptedPassword/g;
    seek(PASSWD, $currPos, 0);
    print PASSWD $_;
    last;
  }
  close(PASSWD);
  $self->{'errorMessage'} = undef;

  return 0;

}

#===============================================================================
#
# METHOD:       $obj->isValidUserPassword($userID, $userPassword);
#
# DESCRIPTION:  Check if password, $userPassword, is a correct password for
#		user, $userID.
#		Return 0 if success, else -1.
#
#===============================================================================
sub isValidUserPassword {
  my($self)		= shift;
  my($userID)		= shift;
  my($userPassword)	= shift;
  my($cryptedPassword)	= undef;

  if ($userID =~ /^\s*$/) {
    HTTPPassword::Usage("isValidUserPassword(\$userID, \$userPassword);");
  }

  if ($userPassword =~ /^\s*$/) {
    $self->{'errorMessage'} = "Invalid Password";
    return -1;
  }

  if (($cryptedPassword = $self->getUserCryptedPassword($userID)) == -1) {
    return -1;
  }

  if ($cryptedPassword eq crypt($userPassword, $cryptedPassword)) {
    $self->{'errorMessage'} = undef;
    return 0;
  }
  else {
    $self->{'errorMessage'} = "Password for $userID is invalid.";
    return -1;
  }

}

#===============================================================================
#
# METHOD:       $obj->getUserCryptedPassword($userID);
#
# DESCRIPTION:  Get the crypted password of the user, $userID.
#
#===============================================================================
sub getUserCryptedPassword {
  my($self)	= shift;
  my($userID)	= shift;

  if ($userID =~ /^\s*$/) {
    HTTPPassword::Usage("getUserCryptedPassword(\$userID);");
  }

  open(PASSWD, $self->{'passwordFile'}) || 
	confess "Fail to read password file: $!";
  while (<PASSWD>) {
    next unless /^${userID}\:(.*)$/;
    close(PASSWD);
    $self->{'errorMessage'} = undef;
    return $1;
  }
  close(PASSWD);
  $self->{'errorMessage'} = "User $userID does not exist.";

  return -1;

}

#===============================================================================
#
# METHOD:       $obj->version();
#
# DESCRIPTION:  Get the version of the module.
#
#===============================================================================
sub version {
    my($self) = shift;

    return $VERSION;
}

1;
#===============================================================================
#
# END of the module.
#
#===============================================================================
__END__

=head1 NAME

HTTPPassword -- A perl module which can be used to maintain the password file for Apache HTTP authentication.

=head1 SYNOPSIS

  use HTTPPassword;

  $passwordFile		= "/absolute/path/of/password/file";
  $userID		= "loginid";
  $userPassword		= "loginpassword";
  $userNewPassword	= "newloginpassword";

  $obj = new HTTPPassword($passwordFile);

  $obj->addUser($userID, $userPassword);

  $obj->changeUserPassword($userID, $userNewPassword);
  $obj->changeUserPassword($userID, $userNewPassword, $userPassword);

  $obj->generateCryptedPassword($userPassword);

  $userArrRef = $obj->getPasswordFileUsers();

  $cryptedPassword = $obj->getUserCryptedPassword($userID);

  $obj->isUserExist($userID);

  $obj->isValidUserPassword($userID, $userPassword);

  $obj->removeUser($userID, [$userPassword]);


=head1 EXAMPLE


http://www.tneoh.zoneit.com/perl/HTTPPassword/


=head1 DESCRIPTION


HTTPPassword module is created so that you can easily maintain
your password file used in Apache's HTTP authentication, like
adding new user, update user's password and remove user.


=head1 CHANGES


1.00->1.01 "removeUser" method now will verify the old password
if it has been passed. "getPasswordFileUsers" method will return
all the users' ID in password file.

1.01->1.02 "srand time ^ $$;" should be "srand(time ^ $$);" and
in regular expression, it is better to use "$1" rather than "\1".
getPasswordFileUsers() should skip the empty line. And the 
comparison for the crypted password and the string returned by 
getUserCryptedPassword() should use "eq" instead of "=" sign.

1.02->1.03 In isValidUserPassword(), $cryptedPassword should be
assigned, instead of doing comparision with the string returned
by getUserCryptedPassword().

=head1 CREDITS

Tony Crooks http://www.leedsnet.com

Bill Moseley

Qing (Cool Cat)

=head1 SOURCE


http://www.tneoh.zoneit.com/perl/HTTPPassword/HTTPPassword.pm


=head1 AUTHOR


Simon Tneoh Chee-Boon   tneohcb@pc.jaring.my

Copyright (c) 1998,1999 Simon Tneoh Chee-Boon. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 VERSION

Version 1.03    07 August 1999

=cut