package TWiki::User::HtPasswdUser;
# Module of TWiki Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 1999-2004 Peter Thoeny, peter@thoeny.com
#
# For licensing info read license.txt file in the TWiki root.
# 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, published at 
# http://www.gnu.org/copyleft/gpl.html
#
# Notes:
# - Latest version at http://twiki.org/
# - Installation instructions in $dataDir/Main/TWikiDocumentation.txt
# - Customize variables in $config->{fileConfig}.pm when installing TWiki.
# - Optionally change TWiki.pm for custom extensions of rendering rules.
# - Upgrading TWiki is easy as long as you do not customize TWiki.pm.
# - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log
#

=begin twiki

---+ TWiki::User::HtPasswdUser Package

The HtPasswdUser module seperates out the User Authentication code that is htpasswd and htdigest
specific. 

TODO: User.pm and the impls propbably shouldn't use Store.pm - they are not TWikiTopics..

=cut



use strict;

# 'Use locale' for internationalisation of Perl sorting in getTopicNames
# and other routines - main locale settings are done in $config->{TWiki}->setupLocale 
    # Do a dynamic 'use locale' for this module

sub init_config { 
   my $self = shift;
	my $config = $self->{config} ;


if( 'md5' eq $config->{TWiki}->{htpasswdEncoding} ) {
	require Digest::MD5;
} elsif( 'sha1' eq $config->{TWiki}->{htpasswdEncoding} ) {
    require MIME::Base64;
    import MIME::Base64 qw( encode_base64 );
    require Digest::SHA1;
    import Digest::SHA1 qw( sha1 );
}
 {
    if( $config->{TWiki}->{useLocale} ) {
        require locale;
	import locale ();
    }
}

}# END of init_config

# FIXME: Move elsewhere?
# template variable hash: (built from %TMPL:DEF{"key"}% ... %TMPL:END%)
 # init in TWiki.pm so okay for modPerl

# ======================
sub new
{
 
	my $dummy = shift;
	my $config = shift;
	unshift @_,$dummy ;

   my( $proto ) = @_;
   my $class = ref($proto) || $proto;
   my $self = {};

	$self->{config}=$config;
   bless( $self, $class );

	$self->init_config();

#   $self->_init();
#   $self->{head} = 0;
   return $self;
}

# ===========================
sub writeDebug
{
    my ( $self ) = @_;
	my $config = $self->{config} ;

#   $config->{TWiki}->writeDebug ( "User: $_[0]" );
}

# =========================
=pod

---+++ $config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdGeneratePasswd ( $user, $passwd , $useOldSalt ) ==> $passwordExists
| Description: | (private) implementation method that generates an encrypted password |
| Parameter: =$user= | userName |
| Parameter: =$passwd= | unencypted password |
| Parameter: =$useOldSalt= | if $useOldSalt == 1 then we are attempting to match $passwd an existing one 
otherwise, we are just creating a new use encrypted passwd |
| Return: =$value= | returns "" on failure, an encrypted password otherwise |

=cut
sub _htpasswdGeneratePasswd
{
    my ( $self, $user, $passwd , $useOldSalt ) = @_;
	my $config = $self->{config} ;


	my $encodedPassword = '';

    if( 'sha1' eq $config->{TWiki}->{htpasswdEncoding} ) {

        $encodedPassword = '{SHA}' . MIME::Base64::encode_base64( Digest::SHA1::sha1( $passwd ) ); 
        chomp $encodedPassword;

    } elsif ( 'crypt' eq $config->{TWiki}->{htpasswdEncoding} ) {
	    # by David Levy, Internet Channel, 1997
	    # found at http://world.inch.com/Scripts/htpasswd.pl.html

		my $salt;
		if ( $useOldSalt eq 1) {
		    my $currentEncryptedPasswordEntry = $config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdReadPasswd ( $user );
	        $salt = substr( $currentEncryptedPasswordEntry, 0, 2 );
		} else {
		    srand( $$|time );
		    my @saltchars = ( 'a'..'z', 'A'..'Z', '0'..'9', '.', '/' );
		    $salt = $saltchars[ int( rand( $#saltchars+1 ) ) ];
		    $salt .= $saltchars[ int( rand( $#saltchars+1 ) ) ];
		}

		if ( ( $salt ) && (2 == length $salt) ) {
			$encodedPassword = crypt( $passwd, $salt );
		}

    } elsif ( 'md5' eq $config->{TWiki}->{htpasswdEncoding} ) {
#what does this do if we are using a htpasswd file?
		my $toEncode= "$user:$TWiki::authRealm:$passwd";
		$encodedPassword = Digest::MD5::md5_hex( $toEncode );

    } elsif ( 'plain' eq $config->{TWiki}->{htpasswdEncoding} ) {

		$encodedPassword = $passwd;

	}

    return $encodedPassword;
}

#========================= 
=pod

---+++ $config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdReadPasswd ( $user ) ==> $encryptedPassword
| Description: | gets the encrypted password from the htpasswd / htdigest file |
| Parameter: =$user= | UserName |
| Return: =$encryptedPassword= | "" if there is none, the encrypted password otherwise |

=cut
sub _htpasswdReadPasswd
{
    my ( $self, $user ) = @_;
	my $config = $self->{config} ;

 
    if( ! $user ) {
        return "";
    }
 
    my $text = $config->{TWiki}->{Store}->readFile ( $config->{TWiki}->{htpasswdFilename} );
    if( $text =~ /$user\:(\S+)/ ) {
        return $1;
    }
    return "";
}
 
#========================= 
=pod

---+++ $config->{TWiki}->{User}->{HtPasswdUser}->UserPasswordExists ( $user ) ==> $passwordExists
| Description: | checks to see if there is a $user in the password system |
| Parameter: =$user= | the username we are looking for  |
| Return: =$passwordExists= | "1" if true, "" if not |

=cut
sub UserPasswordExists
{
    my ( $self, $user ) = @_;
	my $config = $self->{config} ;


    if( ! $user ) {
        return "";
    }

    my $text = $config->{TWiki}->{Store}->readFile ( $config->{TWiki}->{htpasswdFilename} );
    if( $text =~ /^${user}:/gm ) {	# mod_perl: don't use /o
        return "1";
    }
    return "";
}
 
#========================= 
=pod

---+++ $config->{TWiki}->{User}->{HtPasswdUser}->UpdateUserPassword ( $user, $oldUserPassword, $newUserPassword ) ==> $success
| Description: | used to change the user's password |
| Parameter: =$user= | the username we are replacing  |
| Parameter: =$oldUserPassword= | unencrypted password |
| Parameter: =$newUserPassword= | unencrypted password |
| Return: =$success= | "1" if success |

=cut
# TODO: needs to fail if it doesw not succed due to file permissions
sub UpdateUserPassword
{
    my ( $self, $user, $oldUserPassword, $newUserPassword ) = @_;
	my $config = $self->{config} ;


    my $oldUserEntry = $config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdGeneratePasswd ( $user, $oldUserPassword , 1);
    my $newUserEntry = $config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdGeneratePasswd ( $user, $newUserPassword , 0);
 
    # can't use `htpasswd $wikiName` because htpasswd doesn't understand stdin
    # simply add name to file, but this is a security issue
    my $text = $config->{TWiki}->{Store}->readFile ( $config->{TWiki}->{htpasswdFilename} );
    # escape + sign; SHA-passwords can have + signs
    $oldUserEntry =~ s/\+/\\\+/g;
    $text =~ s/$user:$oldUserEntry/$user:$newUserEntry/;
    $config->{TWiki}->{Store}->saveFile ( $config->{TWiki}->{htpasswdFilename}, $text );

    return "1";
}

#===========================
=pod

---+++ $config->{TWiki}->{User}->{HtPasswdUser}->htpasswdUpdateUser ( $self, $oldEncryptedUserPassword, $newEncryptedUserPassword ) ==> $success
| Description: |  |
| Parameter: =$oldEncryptedUserPassword= | formated as in the htpasswd file user:encryptedPasswd |
| Parameter: =$newEncryptedUserPassword= | formated as in the htpasswd file user:encryptedPasswd |
| Return: =$success= |  |
| TODO: | __Needs to go away!__ |
| TODO: | we be better off generating a new password that we email to the user, and then let them change it? |
| Note: | used by the htpasswd specific installpasswd & script  |

=cut
sub htpasswdUpdateUser
{
    my ( $self, $oldEncryptedUserPassword, $newEncryptedUserPassword ) = @_;
	my $config = $self->{config} ;


    # can't use `htpasswd $wikiName` because htpasswd doesn't understand stdin
    # simply add name to file, but this is a security issue
    my $text = $config->{TWiki}->{Store}->readFile ( $config->{TWiki}->{htpasswdFilename} );
    # escape + sign; SHA-passwords can have + signs
    $oldEncryptedUserPassword =~ s/\+/\\\+/g;
    $text =~ s/$oldEncryptedUserPassword/$newEncryptedUserPassword/;
    $config->{TWiki}->{Store}->saveFile ( $config->{TWiki}->{htpasswdFilename}, $text );

    return "1";
}

#===========================
=pod

---+++ $config->{TWiki}->{User}->{HtPasswdUser}->AddUserPassword ( $user, $newUserPassword ) ==> $success
| Description: | creates a new user & password entry |
| Parameter: =$user= | the username we are replacing  |
| Parameter: =$newUserPassword= | unencrypted password |
| Return: =$success= | "1" if success |
| TODO: | need to improve the error mechanism so TWikiAdmins know what failed |

=cut
sub AddUserPassword
{
    my ( $self, $user, $newUserPassword ) = @_;
	my $config = $self->{config} ;

    my $userEntry = $user.":". $config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdGeneratePasswd ( $user, $newUserPassword , 0);

    # can't use `htpasswd $wikiName` because htpasswd doesn't understand stdin
    # simply add name to file, but this is a security issue
    my $text = $config->{TWiki}->{Store}->readFile ( $config->{TWiki}->{htpasswdFilename} );
    ##$config->{TWiki}->writeDebug  "User entry is :$userEntry: before newline";
    $text .= "$userEntry\n";
    $config->{TWiki}->{Store}->saveFile ( $config->{TWiki}->{htpasswdFilename}, $text );

	return "1";
}

#===========================
=pod

---+++ $config->{TWiki}->{User}->{HtPasswdUser}->RemoveUser ( $user ) ==> $success
| Description: | used to remove the user from the password system |
| Parameter: =$user= | the username we are replacing  |
| Return: =$success= | "1" if success |
| TODO: | need to improve the error mechanism so TWikiAdmins know what failed |

=cut
#i'm a wimp - comment out the password entry
sub RemoveUser
{
    my ( $self, $user ) = @_;
	my $config = $self->{config} ;

    my $userEntry = $user.":".$config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdReadPasswd ( $user );

    return $self->htpasswdUpdateUser( $userEntry, "#".$userEntry);
}

# =========================
=pod

---+++ $config->{TWiki}->{User}->{HtPasswdUser}->CheckUserPasswd ( $user, $password ) ==> $success
| Description: | used to check the user's password |
| Parameter: =$user= | the username we are replacing  |
| Parameter: =$password= | unencrypted password |
| Return: =$success= | "1" if success |
| TODO: | need to improve the error mechanism so TWikiAdmins know what failed |

=cut
sub CheckUserPasswd
{
    my ( $self, $user, $password ) = @_;
	my $config = $self->{config} ;

    my $currentEncryptedPasswordEntry = $config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdReadPasswd ( $user );

    my $encryptedPassword = $config->{TWiki}->{User}->{HtPasswdUser}->_htpasswdGeneratePasswd ($user, $password , 1);

    # OK
    if( $encryptedPassword eq $currentEncryptedPasswordEntry ) {
        return "1";
    }
    # NO
    return "";
}
 
1;

# EOF

1;
