1 rizwank 1.1 # Module of TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Copyright (C) 1999-2004 Peter Thoeny, peter@thoeny.com
4 #
5 # For licensing info read license.txt file in the TWiki root.
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details, published at
15 # http://www.gnu.org/copyleft/gpl.html
16 #
17 # Notes:
18 # - Latest version at http://twiki.org/
19 # - Installation instructions in $dataDir/Main/TWikiDocumentation.txt
20 # - Customize variables in TWiki.cfg when installing TWiki.
21 # - Optionally change TWiki.pm for custom extensions of rendering rules.
22 rizwank 1.1 # - Upgrading TWiki is easy as long as you do not customize TWiki.pm.
23 # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log
24 #
25
26 =begin twiki
27
28 ---+ TWiki::User::HtPasswdUser Package
29
30 The HtPasswdUser module seperates out the User Authentication code that is htpasswd and htdigest
31 specific.
32
33 TODO: User.pm and the impls propbably shouldn't use Store.pm - they are not TWikiTopics..
34
35 =cut
36
37 package TWiki::User::HtPasswdUser;
38
39 if( 'md5' eq $TWiki::htpasswdEncoding ) {
40 require Digest::MD5;
41 } elsif( 'sha1' eq $TWiki::htpasswdEncoding ) {
42 require MIME::Base64;
43 rizwank 1.1 import MIME::Base64 qw( encode_base64 );
44 require Digest::SHA1;
45 import Digest::SHA1 qw( sha1 );
46 }
47
48 use strict;
49
50 # 'Use locale' for internationalisation of Perl sorting in getTopicNames
51 # and other routines - main locale settings are done in TWiki::setupLocale
52 BEGIN {
53 # Do a dynamic 'use locale' for this module
54 if( $TWiki::useLocale ) {
55 require locale;
56 import locale ();
57 }
58 }
59
60 # FIXME: Move elsewhere?
61 # template variable hash: (built from %TMPL:DEF{"key"}% ... %TMPL:END%)
62 use vars qw( %templateVars ); # init in TWiki.pm so okay for modPerl
63
64 rizwank 1.1 # ======================
65 sub new
66 {
67 my( $proto ) = @_;
68 my $class = ref($proto) || $proto;
69 my $self = {};
70 bless( $self, $class );
71 # $self->_init();
72 # $self->{head} = 0;
73 return $self;
74 }
75
76 # ===========================
77 sub writeDebug
78 {
79 # TWiki::writeDebug( "User: $_[0]" );
80 }
81
82 # =========================
83 =pod
84
85 rizwank 1.1 ---+++ _htpasswdGeneratePasswd( $user, $passwd , $useOldSalt ) ==> $passwordExists
86 | Description: | (private) implementation method that generates an encrypted password |
87 | Parameter: =$user= | userName |
88 | Parameter: =$passwd= | unencypted password |
89 | Parameter: =$useOldSalt= | if $useOldSalt == 1 then we are attempting to match $passwd an existing one
90 otherwise, we are just creating a new use encrypted passwd |
91 | Return: =$value= | returns "" on failure, an encrypted password otherwise |
92
93 =cut
94 sub _htpasswdGeneratePasswd
95 {
96 my ( $user, $passwd , $useOldSalt ) = @_;
97
98 my $encodedPassword = '';
99
100 if( 'sha1' eq $TWiki::htpasswdEncoding ) {
101
102 $encodedPassword = '{SHA}' . MIME::Base64::encode_base64( Digest::SHA1::sha1( $passwd ) );
103 chomp $encodedPassword;
104
105 } elsif ( 'crypt' eq $TWiki::htpasswdEncoding ) {
106 rizwank 1.1 # by David Levy, Internet Channel, 1997
107 # found at http://world.inch.com/Scripts/htpasswd.pl.html
108
109 my $salt;
110 if ( $useOldSalt eq 1) {
111 my $currentEncryptedPasswordEntry = _htpasswdReadPasswd( $user );
112 $salt = substr( $currentEncryptedPasswordEntry, 0, 2 );
113 } else {
114 srand( $$|time );
115 my @saltchars = ( 'a'..'z', 'A'..'Z', '0'..'9', '.', '/' );
116 $salt = $saltchars[ int( rand( $#saltchars+1 ) ) ];
117 $salt .= $saltchars[ int( rand( $#saltchars+1 ) ) ];
118 }
119
120 if ( ( $salt ) && (2 == length $salt) ) {
121 $encodedPassword = crypt( $passwd, $salt );
122 }
123
124 } elsif ( 'md5' eq $TWiki::htpasswdEncoding ) {
125 #what does this do if we are using a htpasswd file?
126 my $toEncode= "$user:$TWiki::authRealm:$passwd";
127 rizwank 1.1 $encodedPassword = Digest::MD5::md5_hex( $toEncode );
128
129 } elsif ( 'plain' eq $TWiki::htpasswdEncoding ) {
130
131 $encodedPassword = $passwd;
132
133 }
134
135 return $encodedPassword;
136 }
137
138 #=========================
139 =pod
140
141 ---+++ _htpasswdReadPasswd( $user ) ==> $encryptedPassword
142 | Description: | gets the encrypted password from the htpasswd / htdigest file |
143 | Parameter: =$user= | UserName |
144 | Return: =$encryptedPassword= | "" if there is none, the encrypted password otherwise |
145
146 =cut
147 sub _htpasswdReadPasswd
148 rizwank 1.1 {
149 my ( $user ) = @_;
150
151 if( ! $user ) {
152 return "";
153 }
154
155 my $text = &TWiki::Store::readFile( $TWiki::htpasswdFilename );
156 if( $text =~ /$user\:(\S+)/ ) {
157 return $1;
158 }
159 return "";
160 }
161
162 #=========================
163 =pod
164
165 ---+++ UserPasswordExists( $user ) ==> $passwordExists
166 | Description: | checks to see if there is a $user in the password system |
167 | Parameter: =$user= | the username we are looking for |
168 | Return: =$passwordExists= | "1" if true, "" if not |
169 rizwank 1.1
170 =cut
171 sub UserPasswordExists
172 {
173 my ( $self, $user ) = @_;
174
175 if( ! $user ) {
176 return "";
177 }
178
179 my $text = &TWiki::Store::readFile( $TWiki::htpasswdFilename );
180 if( $text =~ /^${user}:/gm ) { # mod_perl: don't use /o
181 return "1";
182 }
183 return "";
184 }
185
186 #=========================
187 =pod
188
189 ---+++ UpdateUserPassword( $user, $oldUserPassword, $newUserPassword ) ==> $success
190 rizwank 1.1 | Description: | used to change the user's password |
191 | Parameter: =$user= | the username we are replacing |
192 | Parameter: =$oldUserPassword= | unencrypted password |
193 | Parameter: =$newUserPassword= | unencrypted password |
194 | Return: =$success= | "1" if success |
195
196 =cut
197 # TODO: needs to fail if it doesw not succed due to file permissions
198 sub UpdateUserPassword
199 {
200 my ( $self, $user, $oldUserPassword, $newUserPassword ) = @_;
201
202 my $oldUserEntry = _htpasswdGeneratePasswd( $user, $oldUserPassword , 1);
203 my $newUserEntry = _htpasswdGeneratePasswd( $user, $newUserPassword , 0);
204
205 # can't use `htpasswd $wikiName` because htpasswd doesn't understand stdin
206 # simply add name to file, but this is a security issue
207 my $text = &TWiki::Store::readFile( $TWiki::htpasswdFilename );
208 # escape + sign; SHA-passwords can have + signs
209 $oldUserEntry =~ s/\+/\\\+/g;
210 $text =~ s/$user:$oldUserEntry/$user:$newUserEntry/;
211 rizwank 1.1 &TWiki::Store::saveFile( $TWiki::htpasswdFilename, $text );
212
213 return "1";
214 }
215
216 #===========================
217 =pod
218
219 ---+++ htpasswdUpdateUser( $self, $oldEncryptedUserPassword, $newEncryptedUserPassword ) ==> $success
220 | Description: | |
221 | Parameter: =$oldEncryptedUserPassword= | formated as in the htpasswd file user:encryptedPasswd |
222 | Parameter: =$newEncryptedUserPassword= | formated as in the htpasswd file user:encryptedPasswd |
223 | Return: =$success= | |
224 | TODO: | __Needs to go away!__ |
225 | TODO: | we be better off generating a new password that we email to the user, and then let them change it? |
226 | Note: | used by the htpasswd specific installpasswd & script |
227
228 =cut
229 sub htpasswdUpdateUser
230 {
231 my ( $self, $oldEncryptedUserPassword, $newEncryptedUserPassword ) = @_;
232 rizwank 1.1
233 # can't use `htpasswd $wikiName` because htpasswd doesn't understand stdin
234 # simply add name to file, but this is a security issue
235 my $text = &TWiki::Store::readFile( $TWiki::htpasswdFilename );
236 # escape + sign; SHA-passwords can have + signs
237 $oldEncryptedUserPassword =~ s/\+/\\\+/g;
238 $text =~ s/$oldEncryptedUserPassword/$newEncryptedUserPassword/;
239 &TWiki::Store::saveFile( $TWiki::htpasswdFilename, $text );
240
241 return "1";
242 }
243
244 #===========================
245 =pod
246
247 ---+++ AddUserPassword( $user, $newUserPassword ) ==> $success
248 | Description: | creates a new user & password entry |
249 | Parameter: =$user= | the username we are replacing |
250 | Parameter: =$newUserPassword= | unencrypted password |
251 | Return: =$success= | "1" if success |
252 | TODO: | need to improve the error mechanism so TWikiAdmins know what failed |
253 rizwank 1.1
254 =cut
255 sub AddUserPassword
256 {
257 my ( $self, $user, $newUserPassword ) = @_;
258 my $userEntry = $user.":". _htpasswdGeneratePasswd( $user, $newUserPassword , 0);
259
260 # can't use `htpasswd $wikiName` because htpasswd doesn't understand stdin
261 # simply add name to file, but this is a security issue
262 my $text = &TWiki::Store::readFile( $TWiki::htpasswdFilename );
263 ##TWiki::writeDebug "User entry is :$userEntry: before newline";
264 $text .= "$userEntry\n";
265 &TWiki::Store::saveFile( $TWiki::htpasswdFilename, $text );
266
267 return "1";
268 }
269
270 #===========================
271 =pod
272
273 ---+++ RemoveUser( $user ) ==> $success
274 rizwank 1.1 | Description: | used to remove the user from the password system |
275 | Parameter: =$user= | the username we are replacing |
276 | Return: =$success= | "1" if success |
277 | TODO: | need to improve the error mechanism so TWikiAdmins know what failed |
278
279 =cut
280 #i'm a wimp - comment out the password entry
281 sub RemoveUser
282 {
283 my ( $self, $user ) = @_;
284 my $userEntry = $user.":"._htpasswdReadPasswd( $user );
285
286 return $self->htpasswdUpdateUser( $userEntry, "#".$userEntry);
287 }
288
289 # =========================
290 =pod
291
292 ---+++ CheckUserPasswd( $user, $password ) ==> $success
293 | Description: | used to check the user's password |
294 | Parameter: =$user= | the username we are replacing |
295 rizwank 1.1 | Parameter: =$password= | unencrypted password |
296 | Return: =$success= | "1" if success |
297 | TODO: | need to improve the error mechanism so TWikiAdmins know what failed |
298
299 =cut
300 sub CheckUserPasswd
301 {
302 my ( $self, $user, $password ) = @_;
303 my $currentEncryptedPasswordEntry = _htpasswdReadPasswd( $user );
304
305 my $encryptedPassword = _htpasswdGeneratePasswd($user, $password , 1);
306
307 # OK
308 if( $encryptedPassword eq $currentEncryptedPasswordEntry ) {
309 return "1";
310 }
311 # NO
312 return "";
313 }
314
315 1;
316 rizwank 1.1
317 # EOF
|