diff -Nur TWiki.orig/lib/TWiki/User/DBMManageUser.pm TWiki.dbm/lib/TWiki/User/DBMManageUser.pm --- TWiki.orig/lib/TWiki/User/DBMManageUser.pm Wed Dec 31 19:00:00 1969 +++ TWiki.dbm/lib/TWiki/User/DBMManageUser.pm Sun Jan 2 14:49:13 2005 @@ -0,0 +1,352 @@ +# Module for TWiki Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2004-2005 Cloyce D. Spradling, +# Based on HtPasswdUser.pm Copyright (C) 1999-2004 Peter Thoeny +# +# 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: +# - Customize variables in TWiki.cfg 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 +# - Check warningFile for DB-related errors +# - Horribly inefficient; tie()s at _least_ once per action +# + +=begin twiki + +---+ TWiki::User::DBMManageUser Package + +The DBMManageUser module separates out the User Authentication code that is dbmmanage specific. + +=cut + +package TWiki::User::DBMManageUser; + +BEGIN { @AnyDBM_File::ISA = @TWiki::dbmmanageModules; } + +use strict; +use Fcntl; +use AnyDBM_File (); + +# 'Use locale' for internationalisation of Perl sorting in getTopicNames +# and other routines - main locale settings are done in TWiki::setupLocale +BEGIN { + # Do a dynamic 'use locale' for this module + if( $TWiki::useLocale ) { + require locale; + import locale (); + } +} + +# FIXME: Move elsewhere? +# template variable hash: (built from %TMPL:DEF{"key"}% ... %TMPL:END%) +use vars qw( %templateVars ); # init in TWiki.pm so okay for modPerl + +# variables used in the salt generator +my @range = (qw(. /), '0'..'9','a'..'z','A'..'Z'); +my $rangeLength = @range+0; + +# ====================== +sub new +{ + my( $proto ) = @_; + my $class = ref($proto) || $proto; + my $self = {}; + bless( $self, $class ); + return $self; +} + +# ========================= +=pod + +---+++ _dbmmanageGeneratePasswd( $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 _dbmmanageGeneratePasswd +{ + my ( $user, $passwd , $useOldSalt ) = @_; + + # Only give the _option_ of using a new-style salt on systems that might + # support it + my $newstyle_salt_platforms = join '|', qw{bsdos}; #others? + my $newstyle_salt = $^O =~ /(?:$newstyle_salt_platforms)/; + + my $encodedPassword = ''; + + if( 'sha1' eq $TWiki::htpasswdEncoding ) { + + $encodedPassword = '{SHA}' . Digest::SHA1::sha1_base64($passwd) . '='; + + } elsif ( $TWiki::htpasswdEncoding =~ /^crypt/ ) { + my $salt; + my $newStyleSalt = ( 'cryptnew' eq $TWiki::htpasswdEncoding ); + my $saltLength = $newStyleSalt ? 4 : 2; + + if ( $useOldSalt == 1 ) { + + # I don't know if this is compatible with newStyleSalt + my $currentEncryptedPasswordEntry = _dbmmanageReadPasswd( $user ); + $salt = substr( $currentEncryptedPasswordEntry, 0, $saltLength ); + $salt = '_'._randChar().'a..'.$salt if $newStyleSalt; + + } else { + # Taken from various versions of dbmmanage + srand( $$|time ); # Random enough for WikiWork + $salt = $newStyleSalt ? '_'._randChar().'a..'._randChar(4) : + _randChar(2); + + } + + $encodedPassword = crypt( $passwd, $salt ); + + } elsif ( 'md5' eq $TWiki::htpasswdEncoding ) { + + my $toEncode= "$user:$TWiki::authRealm:$passwd"; + $encodedPassword = Digest::MD5::md5_hex( $toEncode ); + + } elsif ( 'plain' eq $TWiki::htpasswdEncoding ) { + + $encodedPassword = $passwd; + + } + + return $encodedPassword; +} + +#========================= +=pod + +---+++ _randChar( $count ) ==> $string +| Description: | (private) implementation method that returns a string of random characters +| Parameter: =$count= | (optional) length of string to generate (1 is default) | +| Return: =$string= | returns random string of length =$count= | + +=cut +sub _randChar +{ + return join('', map $range[rand $rangeLength], 1..shift||1); +} + +#========================= +=pod + +---+++ _dbmmanageReadPasswd( $user ) ==> $encryptedPassword +| Description: | gets the encrypted password from the DBM htpasswd file | +| Parameter: =$user= | UserName | +| Return: =$encryptedPassword= | "" if there is none, the encrypted password otherwise | + +=cut +sub _dbmmanageReadPasswd +{ + my ( $user ) = @_; + my %users = (); + my $pass = ''; + + if( ! $user ) { + return ''; + } + + if (tie %users, 'AnyDBM_File', $TWiki::htpasswdFilename, 0644, O_RDONLY) { + + $pass = $users{$user} || ''; + untie %users; + + } else { + + TWiki::writeWarning("_dbmmanageReadPasswd: failed to tie $TWiki::htpasswdFilename, 0644, O_RDONLY: $!\n"); + + } + + return $pass; +} + +#========================= +=pod + +---+++ 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 %users = (); + my $exists = 0; + + if( ! $user ) { + return ''; + } + + if (tie %users, 'AnyDBM_File', $TWiki::htpasswdFilename, 0644, O_RDONLY) { + + $exists = exists($users{$user}); + untie %users; + + } else { + + TWiki::writeWarning("UserPasswordExists: failed to tie $TWiki::htpasswdFilename, 0644, O_RDONLY: $!\n"); + + } + + return $exists; +} + +#========================= +=pod + +---+++ 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 +sub UpdateUserPassword +{ + my ( $self, $user, $oldUserPassword, $newUserPassword ) = @_; + my %users = (); + + return '' unless UserPasswordExists( $user ); + + my $oldUserEntry = _dbmmanageGeneratePasswd( $user, $oldUserPassword , 1); + my $newUserEntry = _dbmmanageGeneratePasswd( $user, $newUserPassword , 0); + + if (tie %users, 'AnyDBM_File', $TWiki::htpasswdFilename, 0644, O_RDWR) { + + # escape + sign; SHA-passwords can have + signs + $oldUserEntry =~ s/\+/\\\+/g; + my $oldPass = $users{$user}; + + if ($oldPass =~ s/$oldUserEntry/$newUserEntry/) { + + $users{$user} = $oldPass; + untie %users; + return '1'; + + } else { + + untie %users; + return ''; + + } + + } else { + + TWiki::writeWarning("UpdateUserPassword: failed to tie $TWiki::htpasswdFilename, 0644, O_RDWR: $!\n"); + + } + + return ''; +} + +#=========================== +=pod + +---+++ 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 | + +=cut +sub AddUserPassword +{ + my ( $self, $user, $newUserPassword ) = @_; + my %users = (); + my $newPass = _dbmmanageGeneratePasswd( $user, $newUserPassword , 0); + + if (tie %users, 'AnyDBM_File', $TWiki::htpasswdFilename, 0644, O_RDWR|O_CREAT) { + + $users{$user} = $newPass; + untie %users; + + return '1'; + + } else { + + TWiki::writeWarning("AddUserPassword: failed to tie $TWiki::htpasswdFilename, 0644, O_RDWR|O_CREAT: $!\n"); + + } + + return ''; +} + +#=========================== +=pod + +---+++ 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 | + +=cut +sub RemoveUser +{ + my ( $self, $user ) = @_; + my %users = (); + + if (tie %users, 'AnyDBM_File', $TWiki::htpasswdFilename, 0644, O_RDWR) { + + delete $users{$user}; + untie %users; + return '1'; + + } else { + + TWiki::writeWarning("RemoveUser: failed to tie $TWiki::htpasswdFilename, 0644, O_RDWR: $!\n"); + + } + + return ''; +} + +# ========================= +=pod + +---+++ 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 $currentEncryptedPasswordEntry = _dbmmanageReadPasswd( $user ); + + my $encryptedPassword = _dbmmanageGeneratePasswd($user, $password , 1); + + # OK + if( $encryptedPassword eq $currentEncryptedPasswordEntry ) { + return '1'; + } + # NO + return ''; +} + +1; + +# EOF diff -Nur TWiki.orig/lib/TWiki/User.pm TWiki.dbm/lib/TWiki/User.pm --- TWiki.orig/lib/TWiki/User.pm Sat May 29 02:51:35 2004 +++ TWiki.dbm/lib/TWiki/User.pm Thu Dec 23 11:26:14 2004 @@ -75,6 +75,8 @@ if ( # (-e $TWiki::htpasswdFilename ) && #<<< maybe ( $TWiki::htpasswdFormatFamily eq "htpasswd" ) ) { $UserImpl = "TWiki::User::HtPasswdUser"; + } elsif ($TWiki::htpasswdFormatFamily eq "dbmmanage") { + $UserImpl = "TWiki::User::DBMManageUser"; # } elseif ($TWiki::htpasswdFormatFamily eq "something?") { # $UserImpl = "TWiki::User::SomethingUser"; } else { diff -Nur TWiki.orig/lib/TWiki.cfg TWiki.dbm/lib/TWiki.cfg --- TWiki.orig/lib/TWiki.cfg Tue Aug 31 12:35:19 2004 +++ TWiki.dbm/lib/TWiki.cfg Sun Jan 2 15:35:12 2005 @@ -340,9 +309,9 @@ $warningFilename = "$logDir/warning.txt"; # Password file format/encoding method : # htpasswd:plain, htpasswd:crypt, htpasswd:md5 (currently unsupported), -# htpasswd:sha1, htdigest:md5, none: +# htpasswd:sha1, htdigest:md5, dbmmanage, none: #default htpasswd:crypt; -$htpasswdFormatFamily = "htpasswd"; +$htpasswdFormatFamily = "dbmmanage"; if( $OS eq "WINDOWS" ) { $htpasswdEncoding = "sha1"; #windows apache } else { @@ -351,9 +320,21 @@ # Pathname of user name/password file for authentication : if ( $htpasswdFormatFamily eq "htpasswd" ) { $htpasswdFilename = "$dataDir/.htpasswd"; -} elsif ( $htpasswdFormatFamily eq "hdigest" ) { +} elsif ( $htpasswdFormatFamily eq "htdigest" ) { $htpasswdFilename = "$dataDir/.htdigest"; +} elsif ( $htpasswdFormatFamily eq "dbmmanage" ) { + # If you get "file not found" errors when trying to tie() the file, + # try adding or omitting the filename extensions. + + # The file that you'd specify as AuthDBUserFile in .htaccess + $htpasswdFilename = "$dataDir/user.db"; } + +# For htpasswd files managed by dbmmanage, prefer Perl DBM modules in the +# following order: +# -ldb -lndbm -lgdbm -lsdbm +@dbmmanageModules = qw(DB_File NDBM_File GDBM_File SDBM_File); + # Authentication "realm" (must be the same as in # password file, MUST NOT contain colons): $authRealm = "Enter your WikiName. (First name and last name, no space, no dots, capitalized, e.g. JohnSmith). Cancel to register if you do not have one.";