# Module of TWiki Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2003 Pavel Goran, pvgoran@newmail.ru
#
# 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

package TWiki::Htpasswd;

require TWiki::Store;

use strict;

#=======================================
# "Entry" manipulations.

#=======================================
sub encodePassword
{
	my( $user, $passwd, $salt ) = @_;

	my( $htpasswdFormatFamily, $htpasswdEncoding );
	if( $TWiki::htpasswdFormat =~ /^([^:]+):(.+)$/ ) {
		$htpasswdFormatFamily = $1;
		$htpasswdEncoding = $2;
	} else {
		return '';
	}

	my $encodedPasswd = '';
		# Empty result indicates unknown format.

	if ( 'plain' eq $htpasswdEncoding ) {
		$encodedPasswd = $passwd;
	} elsif( 'crypt' eq $htpasswdEncoding ) {
		if ( ( ! defined $salt ) || (2 != length $salt) ) {
			# No predefined salt - generate it.

			# Original code by David Levy, Internet Channel, 1997,
			# found at http://world.inch.com/Scripts/htpasswd.pl.html

			srand( $$|time );
			my @saltchars = ( 'a'..'z', 'A'..'Z', '0'..'9', '.', '/' );
			$salt = $saltchars[ int( rand( $#saltchars+1 ) ) ];
			$salt .= $saltchars[ int( rand( $#saltchars+1 ) ) ];
		}
		$encodedPasswd = crypt( $passwd, $salt );
	} elsif( 'md5' eq $htpasswdEncoding ) {
		require Digest::MD5;

		if( 'htpasswd' eq $htpasswdFormatFamily ) {
			# Don't know how to handle it!
			return '';
		} elsif( 'htdigest' eq $htpasswdFormatFamily ) {
			my $toEncode= "$user:$TWiki::authRealm:$passwd";
			$encodedPasswd = Digest::MD5::md5_hex( $toEncode );
		}
	} elsif( 'sha1' eq $htpasswdEncoding ) {
		require Digest::SHA1;

		if( 'htpasswd' eq $htpasswdFormatFamily ) {
			# from ../bin/passwd
			$encodedPasswd = '{SHA}' . Digest::SHA1::sha1_base64( $passwd ); 
		}
	}

	return $encodedPasswd;
}

#=======================================
sub extractSalt
{
	my( $encodedPasswd ) = @_;

	my $salt = '';
		# Empty result indicates unknown format or absence
		# of salt in the format.

	if( $TWiki::htpasswdFormat =~ /:crypt$/ ) {
		$salt = substr( $encodedPasswd, 0, 2 );
	} elsif( 'htpasswd:md5' eq $TWiki::htpasswdFormat ) {
		# Don't know how to handle it!
		return '';
	}

	return $salt;
}

#=======================================
sub makeEntry
{
	my( $user, $encodedPasswd ) = @_;

	if( $TWiki::htpasswdFormat =~ /^htpasswd:/ ) {
		# .htpasswd family - two fields in the line.
		return "$user:$encodedPasswd";
	} elsif( $TWiki::htpasswdFormat =~ /^htdigest:/ ) {
		# .htdigest family - three fields in the line, the second is
		# the "realm".
		return "$user:$TWiki::authRealm:$encodedPasswd";
	}

	return '';
}

#=======================================
sub parseEntry
{
	my( $htpasswdEntry ) = @_;

	if( ! $htpasswdEntry) {
		return '';
	}

	if( $TWiki::htpasswdFormat =~ /^htpasswd:/ ) {
		# .htpasswd family - two fields in the line.
		if( $htpasswdEntry =~ /^([^:]+):(.*)$/ ) {
			return ($1 , $2);
		}
	} elsif( $TWiki::htpasswdFormat =~ /^htdigest:/ ) {
		# .htdigest family - three fields in the line, the second is
		# the "realm".
		my $authRealmPattern = quotemeta( $TWiki::authRealm );
		if( $htpasswdEntry =~ /^([^:]+):$authRealmPattern:(.*)$/ ) {
			return ($1 , $2);
		}
	}

	return '';
}

#=======================================
sub verifyPassword
{
	my( $htpasswdEntry, $passwdToVerify ) = @_;

	my( $user, $encodedPasswd ) = parseEntry( $htpasswdEntry );

	if( ! $user ) {
		return 0;
	}

	my $salt = extractSalt( $encodedPasswd );

	return ( encodePassword( $user, $passwdToVerify, $salt ) eq $encodedPasswd );
}

#=======================================
# Password file manipulations.

#=======================================
sub findEntry
{
	my( $user ) = @_;
	    # $user is assumed to contain only "word" characters
	    # - alphanumerics and underscores.

	my $htpasswdText = TWiki::Store::readFile( $TWiki::htpasswdFilename );
	if( $htpasswdText =~ /^($user:.*)$/m ) {
		return $1;
	}

	return '';
}

#=======================================
sub addEntry
{
	my( $htpasswdEntry ) = @_;

	my $htpasswdText = TWiki::Store::readFile( $TWiki::htpasswdFilename );
	
	$htpasswdText .= "$htpasswdEntry\n";
	TWiki::Store::saveFile( $TWiki::htpasswdFilename, $htpasswdText );
}

#=======================================
sub replaceEntry
{
	my( $oldEntry, $newEntry ) = @_;
	    # $oldEntry is assumed to be the string interpreted 
	    # by RE compiler as "plain text".
    
	my $htpasswdText .= TWiki::Store::readFile( $TWiki::htpasswdFilename );

	my $oldEntryPattern = quotemeta( $oldEntry );
	$htpasswdText =~ s/^$oldEntryPattern$/$newEntry/m;
	TWiki::Store::saveFile( $TWiki::htpasswdFilename, $htpasswdText );
}