1# See bottom of file for license and copyright information 2 3=begin TML 4 5---+ package Foswiki::Users::HtPasswdUser 6 7Support for htpasswd and htdigest format password files. 8 9Subclass of =[[%SCRIPTURL{view}%/%SYSTEMWEB%/PerlDoc?module=Foswiki::Users::Password][Foswiki::Users::Password]]=. 10See documentation of that class for descriptions of the methods of this class. 11 12=cut 13 14package Foswiki::Users::HtPasswdUser; 15use strict; 16use warnings; 17 18use Foswiki::Users::Password (); 19our @ISA = ('Foswiki::Users::Password'); 20 21use Assert; 22use Error qw( :try ); 23use Fcntl qw( :DEFAULT :flock ); 24 25BEGIN { 26 if ( $Foswiki::cfg{UseLocale} ) { 27 require locale; 28 import locale(); 29 } 30} 31 32our ( $GlobalCache, $GlobalTimestamp ); 33 34sub PasswordData { 35 my $this = shift; 36 37 if ( $Foswiki::cfg{Htpasswd}{GlobalCache} ) { 38 $HtPasswdUser::GlobalCache = shift if @_; 39 return $HtPasswdUser::GlobalCache; 40 } 41 else { 42 $this->{LocalCache} = shift if @_; 43 return $this->{LocalCache}; 44 } 45} 46 47sub PasswordTimestamp { 48 my $this = shift; 49 if ( $Foswiki::cfg{Htpasswd}{GlobalCache} ) { 50 $HtPasswdUser::GlobalTimestamp = shift if @_; 51 return $HtPasswdUser::GlobalTimestamp; 52 } 53 else { 54 $this->{LocalTimestamp} = shift if @_; 55 return $this->{LocalTimestamp}; 56 } 57} 58 59# Used in unit tests to reset the cache. Also used to clear the cache if the 60# Password file has been modified externally. 61sub ClearCache { 62 my $this = shift; 63 if ( $Foswiki::cfg{Htpasswd}{GlobalCache} ) { 64 $HtPasswdUser::GlobalCache = (); 65 $HtPasswdUser::GlobalTimestamp = 0; 66 } 67 else { 68 undef $this->{LocalCache}; 69 undef $this->{LocalTimestamp}; 70 } 71} 72 73# Set TRACE to 1 to enable trace of password activity 74# Set TRACE to 2 for verbose auto-encoding report 75use constant TRACE => 0; 76 77sub new { 78 my ( $class, $session ) = @_; 79 my $this = bless( $class->SUPER::new($session), $class ); 80 $this->{error} = undef; 81 82 if ( $Foswiki::cfg{Htpasswd}{AutoDetect} ) { 83 84 # For autodetect, soft errors are allowed. If the .htpasswd file contains 85 # a password for an unsupported encoding, it will not match. 86 eval 'use Digest::SHA'; 87 $this->{SHA} = 1 unless ($@); 88 eval 'use Crypt::PasswdMD5'; 89 $this->{APR} = 1 unless ($@); 90 eval 'use Crypt::Eksblowfish::Bcrypt;'; 91 $this->{BCRYPT} = 1 unless ($@); 92 } 93 94 if ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'md5' 95 || $Foswiki::cfg{Htpasswd}{Encoding} eq 'htdigest-md5' ) 96 { 97 require Digest::MD5; 98 if ( $Foswiki::cfg{AuthRealm} =~ m/\:/ ) { 99 print STDERR 100"ERROR: the AuthRealm cannot contain a ':' (colon) as it corrupts the password file\n"; 101 throw Error::Simple( 102"ERROR: the AuthRealm cannot contain a ':' (colon) as it corrupts the password file" 103 ); 104 } 105 } 106 elsif ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'crypt' ) { 107 } 108 elsif ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'plain' ) { 109 } 110 elsif ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'sha1' ) { 111 require Digest::SHA; 112 $this->{SHA} = 1; 113 } 114 elsif ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'apache-md5' ) { 115 require Crypt::PasswdMD5; 116 $this->{APR} = 1; 117 } 118 elsif ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'crypt-md5' ) { 119 eval 'use Crypt::PasswdMD5'; 120 $this->{APR} = 1 unless ($@); 121 } 122 elsif ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'bcrypt' ) { 123 eval 'use Crypt::Eksblowfish::Bcrypt;'; 124 $this->{BCRYPT} = 1 unless ($@); 125 } 126 else { 127 print STDERR "ERROR: unknown {Htpasswd}{Encoding} setting : " 128 . $Foswiki::cfg{Htpasswd}{Encoding} . "\n"; 129 throw Error::Simple( "ERROR: unknown {Htpasswd}{Encoding} setting : " 130 . $Foswiki::cfg{Htpasswd}{Encoding} 131 . "\n" ); 132 } 133 134 return $this; 135} 136 137=begin TML 138 139---++ ObjectMethod finish() 140Break circular references. 141 142=cut 143 144# Note to developers; please undef *all* fields in the object explicitly, 145# whether they are references or not. That way this method is "golden 146# documentation" of the live fields in the object. 147sub finish { 148 my $this = shift; 149 $this->SUPER::finish(); 150 undef $this->{LocalCache}; 151 undef $this->{LocalTimestamp}; 152} 153 154=begin TML 155 156---++ ObjectMethod readOnly( ) -> boolean 157 158returns true if the password file is not currently modifyable 159 160=cut 161 162sub readOnly { 163 my $this = shift; 164 my $path = $Foswiki::cfg{Htpasswd}{FileName}; 165 166 # We expect the path to exist and be writable. 167 if ( -e $path && -f _ && -w _ ) { 168 $this->{session}->enterContext('passwords_modifyable'); 169 return 0; 170 } 171 172 # Otherwise, log a problem. 173 $this->{session}->logger->log( 'warning', 174 'The password file does not exist or cannot be written.' 175 . 'Run =configure= and check the setting of {Htpasswd}{FileName}.' 176 . ' New user registration has been disabled until this is corrected.' 177 ); 178 179 # And disable registration (which will also disable password changes) 180 $Foswiki::cfg{Register}{EnableNewUserRegistration} = 0; 181 182 return 1; 183} 184 185sub canFetchUsers { 186 return 1; 187} 188 189sub fetchUsers { 190 my $this = shift; 191 192 # Read passwords with shared lock 193 my $db = $this->_readPasswd(1); 194 my @users = sort keys %$db; 195 require Foswiki::ListIterator; 196 return Foswiki::ListIterator->new( \@users ); 197} 198 199# Lock the htpasswd semaphore file (create if it does not exist) 200# Returns a file handle that you can later simply close with _unlockPasswdFile 201sub _lockPasswdFile { 202 my $operator = @_; 203 my $lockFileName = $Foswiki::cfg{Htpasswd}{LockFileName} 204 || "$Foswiki::cfg{WorkingDir}/htpasswd.lock"; 205 206 sysopen( my $fh, $lockFileName, O_RDWR | O_CREAT, 0666 ) 207 || throw Error::Simple( $lockFileName 208 . ' open or create password lock file failed -' 209 . 'check access rights: ' 210 . $! ); 211 flock $fh, $operator; 212 213 return $fh; 214} 215 216# Unlock the semaphore file. You must pass the filehandle for the lock file 217# which was returned by _lockPasswdFile 218sub _unlockPasswdFile { 219 my $fh = shift; 220 close($fh); 221} 222 223=begin TML 224 225---++ _readPasswd ( $lock, $cache ); 226 227Read the password file. The content of the file is cached in 228the password object. 229 230We put a shared lock while reading if requested to prevent 231other processes from writing while we read but still allows 232parallel reading. The caller must never request a shared lock 233if there is already an exclusive lock. 234 235 * if $lockShared is true, a shared lock is requested./ 236 * if $cache is true, the in-memory cache will be returned if available. 237 238This routine implements the auto-detection code for password entries: 239 240%TABLE{sort="off"}% 241| *Type* | *Length* | *Matches* | 242| htdigest-md5 | n/a | $Foswiki::cfg{AuthRealm} | (Realm has to be an exact match) | 243| sha1 | 33 | =^\{SHA\}= | 244| crypt-md5 | 34 | =^\$1\$= | 245| apache-md5 | 37 | =^\$apr1\$= | 246| bcrypt | 60 | =^\$2a\$= | 247| crypt | 13 | | next field contains an email address | 248| plain | any | | next field contains an email address | 249| sha | | | (I don't recall what this encoding is, maybe an older implementation?) | 250| htdigest-md5 | any | | If next field contains a md5 hash, Fallthru match in case realm changed | 251 252=cut 253 254sub _readPasswd { 255 my ( $this, $lockShared, $noCache ) = @_; 256 257 unless ($noCache) { 258 259 if ( $Foswiki::cfg{Htpasswd}{DetectModification} 260 && $this->PasswordData() 261 && -e $Foswiki::cfg{Htpasswd}{FileName} ) 262 { 263 my $fileTime = ( stat(_) )[9]; 264 if ( $fileTime > $this->PasswordTimestamp() ) { 265 $this->ClearCache(); 266 } 267 } 268 269 return $this->PasswordData() if ( $this->PasswordData() ); 270 } 271 272 my $data = {}; 273 if ( !-e $Foswiki::cfg{Htpasswd}{FileName} ) { 274 print STDERR 275 "WARNING - $Foswiki::cfg{Htpasswd}{FileName} DOES NOT EXIST\n"; 276 return $data; 277 } 278 279 $lockShared |= 0; 280 my $lockHandle; 281 $lockHandle = _lockPasswdFile(LOCK_SH) if $lockShared; 282 $this->PasswordTimestamp( 283 ( stat( $Foswiki::cfg{Htpasswd}{FileName} ) )[9] ); 284 print STDERR "Loading Passwords, timestamp " 285 . $this->PasswordTimestamp() . " \n" 286 if (TRACE); 287 my $IN_FILE; 288 289 local $/ = "\n"; 290 291 my $enc = $Foswiki::cfg{Htpasswd}{CharacterEncoding} || 'utf-8'; 292 open( $IN_FILE, "<:encoding($enc)", $Foswiki::cfg{Htpasswd}{FileName} ) 293 || throw Error::Simple( 294 $Foswiki::cfg{Htpasswd}{FileName} . ' open failed: ' . $! ); 295 my $line = ''; 296 my $tID; 297 my $pwcount = 0; 298 while ( defined( $line = <$IN_FILE> ) ) { 299 next if ( substr( $line, 0, 1 ) eq '#' ); 300 chomp $line; 301 $pwcount++; 302 my @fields = split( /:/, $line, 5 ); 303 304 if ( TRACE > 1 ) { 305 print STDERR "\nSplit LINE $line\n"; 306 foreach my $f (@fields) { print STDERR "split: $f\n"; } 307 } 308 309 my $hID = shift @fields; 310 311 if ( $Foswiki::cfg{Htpasswd}{AutoDetect} ) { 312 my $tPass = shift @fields; 313 314 # tPass is either a password or a realm 315 if ( 316 $tPass eq $Foswiki::cfg{AuthRealm} 317 || ( defined $fields[0] 318 && length( $fields[0] ) eq 32 319 && defined $fields[1] 320 && $fields[1] =~ m/@/ ) 321 ) 322 { 323 $data->{$hID}->{enc} = 'htdigest-md5'; 324 $data->{$hID}->{realm} = $tPass; 325 $data->{$hID}->{pass} = shift @fields; 326 $data->{$hID}->{emails} = shift @fields || ''; 327 print STDERR "Auto ENCODING-1 $data->{$hID}->{enc} \n" 328 if ( TRACE > 1 ); 329 next; 330 } 331 332 if ( length($tPass) eq 33 && $tPass =~ m/^\{SHA\}/ ) { 333 $data->{$hID}->{enc} = 'sha1'; 334 } 335 elsif ( length($tPass) eq 34 && $tPass =~ m/^\$1\$/ ) { 336 $data->{$hID}->{enc} = 'crypt-md5'; 337 } 338 elsif ( length($tPass) eq 37 && $tPass =~ m/^\$apr1\$/ ) { 339 $data->{$hID}->{enc} = 'apache-md5'; 340 } 341 elsif ( length($tPass) eq 60 && $tPass =~ m/^\$2a\$/ ) { 342 $data->{$hID}->{enc} = 'bcrypt'; 343 } 344 elsif ( length($tPass) eq 13 345 && ( !$fields[0] || $fields[0] =~ m/@/ ) ) 346 { 347 $data->{$hID}->{enc} = 'crypt'; 348 } 349 elsif ( length($tPass) gt 0 && !$fields[0] 350 || $fields[0] =~ m/@/ ) 351 { 352 $data->{$hID}->{enc} = 'plain'; 353 } 354 elsif ( length($tPass) eq 0 && !$fields[0] 355 || $fields[0] =~ m/@/ ) 356 { 357 # Password is zero length, no way to determine encoding. 358 $data->{$hID}->{enc} = 'unknown'; 359 } 360 361 if ( $data->{$hID}->{enc} ) { 362 $data->{$hID}->{pass} = $tPass; 363 $data->{$hID}->{emails} = shift @fields || ''; 364 print STDERR "Auto ENCODING-2 $data->{$hID}->{enc} \n" 365 if ( TRACE > 1 ); 366 next; 367 } 368 369 print STDERR "Fell through - must be htdigest-md5 " 370 . length($tPass) 371 . "--$tPass \n" 372 if ( TRACE > 1 ); 373 374 # Fell through - only thing left is digest encoding 375 $data->{$hID}->{enc} = 'htdigest-md5'; 376 $data->{$hID}->{realm} = $tPass; 377 $data->{$hID}->{pass} = shift @fields; 378 $data->{$hID}->{emails} = shift @fields || ''; 379 print STDERR "Auto ENCODING-3 $data->{$hID}->{enc} \n" 380 if ( TRACE > 1 ); 381 } 382 383 # Static configuration 384 else { 385 $data->{$hID}->{enc} = $Foswiki::cfg{Htpasswd}{Encoding}; 386 $data->{$hID}->{realm} = shift @fields 387 if ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'md5' 388 || $Foswiki::cfg{Htpasswd}{Encoding} eq 'htdigest-md5' ); 389 $data->{$hID}->{pass} = shift @fields; 390 $data->{$hID}->{emails} = shift @fields || ''; 391 print STDERR 392"Static Encoding - $hID: $data->{$hID}->{enc} pass $data->{$hID}->{pass} emails $data->{$hID}->{emails} \n" 393 if ( TRACE > 1 ); 394 } 395 } 396 close($IN_FILE); 397 print STDERR "Loaded $pwcount passwords\n" if (TRACE); 398 $this->PasswordData($data); 399 $this->PasswordTimestamp( 400 ( stat( $Foswiki::cfg{Htpasswd}{FileName} ) )[9] ); 401 402 _unlockPasswdFile($lockHandle) if $lockShared; 403 404 return $data; 405} 406 407=begin TML 408 409---++ _dumpPasswd( $db ) -> $boolean 410 411Dumps the memory password database to a newline separated string 412 413 414=cut 415 416sub _dumpPasswd { 417 my $db = shift; 418 my @entries; 419 my $pwcount = 0; 420 foreach my $login ( sort( keys(%$db) ) ) { 421 422 $pwcount++; 423 my $entry = "$login:"; 424 if ( 425 $db->{$login}->{pass} 426 && $db->{$login}->{enc} 427 && ( $db->{$login}->{enc} eq 'md5' 428 || $db->{$login}->{enc} eq 'htdigest-md5' ) 429 ) 430 { 431 print STDERR 432"Writing realm - $db->{$login}->{enc} for $login pass ($db->{$login}->{pass})\n" 433 if ( TRACE > 1 ); 434 435 # htdigest format 436 $entry .= "$db->{$login}->{realm}:"; 437 } 438 $db->{$login}->{pass} ||= ''; 439 $db->{$login}->{emails} ||= ''; 440 $entry .= $db->{$login}->{pass} . ':' . $db->{$login}->{emails}; 441 push( @entries, $entry ); 442 } 443 print STDERR "Saving $pwcount entries\n" if (TRACE); 444 445 # if ( $pwcount < 50 ) { 446 # print STDERR Data::Dumper::Dumper( \@entries ); 447 # die "REFUSE To Save: Less than 50 passwords\n"; 448 # } 449 return join( "\n", @entries ) . "\n"; 450} 451 452=begin TML 453 454---++ _savePasswd( $db ) -> $passwordE 455 456Creates a new password file, and saves the content of the 457internal password database to the file. 458 459After writing the file, the cache timestamp is reset. 460 461The umask is overridden during save, so that the password file is not world or group readable. 462=cut 463 464sub _savePasswd { 465 my $this = shift; 466 my $db = shift; 467 468 unless ( -e "$Foswiki::cfg{Htpasswd}{FileName}" ) { 469 470 # Item4544: Document special format used in .htpasswd for email addresses 471 open( my $readme, '>', "$Foswiki::cfg{Htpasswd}{FileName}.README" ) 472 or throw Error::Simple( 473 $Foswiki::cfg{Htpasswd}{FileName} . '.README open failed: ' . $! ); 474 475 print $readme <<'EoT'; 476Foswiki uses a specially crafted .htpasswd file format that should not be 477manipulated using a standard htpasswd utility or loss of registered emails might occur. 478(3rd-party utilities do not support the email address format used by Foswiki). 479 480More information available at: http://foswiki.org/System/UserAuthentication. 481EoT 482 close($readme); 483 } 484 485 my $content = _dumpPasswd($db); 486 print STDERR "CONTENT $content\n" if ( TRACE > 1 ); 487 488 my $oldMask = umask(077); # Access only by owner 489 my $fh; 490 491 my $enc = $Foswiki::cfg{Htpasswd}{CharacterEncoding} || 'utf-8'; 492 open( $fh, ">:encoding($enc)", $Foswiki::cfg{Htpasswd}{FileName} ) 493 || throw Error::Simple( 494 "$Foswiki::cfg{Htpasswd}{FileName} open failed: $!"); 495 print $fh $content; 496 497 close($fh); 498 499 # Reset the cache timestamp 500 $this->PasswordData($db); 501 $this->PasswordTimestamp( 502 ( stat( $Foswiki::cfg{Htpasswd}{FileName} ) )[9] ); 503 umask($oldMask); # Restore original umask 504} 505 506=begin TML 507 508---++ encrypt( $login, $passwordU, $fresh ) -> $passwordE 509 510Will return an encrypted password. Repeated calls 511to encrypt with the same login/passU will return the same passE. 512 513However if the passU is changed, and subsequently changed _back_ 514to the old login/passU pair, then the old passE is no longer valid. 515 516If $fresh is true, then a new password not based on any pre-existing 517salt will be used. Set this if you are generating a completely 518new password. 519 520=cut 521 522sub encrypt { 523 my ( $this, $login, $passwd, $fresh, $entry ) = @_; 524 525 $passwd ||= ''; 526 527 my $enc = $entry->{enc}; 528 $enc ||= $Foswiki::cfg{Htpasswd}{Encoding}; 529 530 if ( $enc eq 'sha1' ) { 531 532 unless ( $this->{SHA} ) { 533 $this->{error} = "Unsupported Encoding"; 534 return 0; 535 } 536 537 my $encodedPassword = '{SHA}' 538 . Digest::SHA::sha1_base64( Foswiki::encode_utf8($passwd) ) . '='; 539 540 # don't use chomp, it relies on $/ 541 $encodedPassword =~ s/\s+$//; 542 return $encodedPassword; 543 544 } 545 elsif ( $enc eq 'crypt' ) { 546 547 # by David Levy, Internet Channel, 1997 548 # found at http://world.inch.com/Scripts/htpasswd.pl.html 549 550 my $salt; 551 $salt = $this->fetchPass($login) unless $fresh; 552 if ( $fresh || !$salt ) { 553 my @saltchars = ( 'a' .. 'z', 'A' .. 'Z', '0' .. '9', '.', '/' ); 554 $salt = 555 $saltchars[ int( rand( $#saltchars + 1 ) ) ] 556 . $saltchars[ int( rand( $#saltchars + 1 ) ) ]; 557 } 558 return crypt( Foswiki::encode_utf8($passwd), 559 Foswiki::encode_utf8( substr( $salt, 0, 2 ) ) ); 560 561 } 562 elsif ( $enc eq 'md5' || $enc eq 'htdigest-md5' ) { 563 564 # SMELL: what does this do if we are using a htpasswd file? 565 my $realm = $entry->{realm} || $Foswiki::cfg{AuthRealm}; 566 my $toEncode = "$login:$realm:$passwd"; 567 return Digest::MD5::md5_hex( Foswiki::encode_utf8($toEncode) ); 568 569 } 570 elsif ( $enc eq 'apache-md5' ) { 571 572 unless ( $this->{APR} ) { 573 $this->{error} = "Unsupported Encoding"; 574 return 0; 575 } 576 577 my $salt; 578 $salt = $this->fetchPass($login) unless $fresh; 579 if ( $fresh || !$salt ) { 580 $salt = '$apr1$'; 581 my @saltchars = ( '.', '/', 0 .. 9, 'A' .. 'Z', 'a' .. 'z' ); 582 foreach my $i ( 0 .. 7 ) { 583 584 # generate a salt not only from rand() but also mixing 585 # in the users login name: unecessary 586 $salt .= $saltchars[ 587 ( 588 int( rand( $#saltchars + 1 ) ) + 589 $i + 590 ord( substr( $login, $i % length($login), 1 ) ) ) 591 % ( $#saltchars + 1 ) 592 ]; 593 } 594 } 595 return Crypt::PasswdMD5::apache_md5_crypt( 596 Foswiki::encode_utf8($passwd), 597 Foswiki::encode_utf8( substr( $salt, 0, 14 ) ) ); 598 } 599 elsif ( $enc eq 'crypt-md5' ) { 600 my $salt; 601 $salt = $this->fetchPass($login) unless $fresh; 602 if ( $fresh || !$salt ) { 603 $salt = '$1$'; 604 my @saltchars = ( '.', '/', 0 .. 9, 'A' .. 'Z', 'a' .. 'z' ); 605 foreach my $i ( 0 .. 7 ) { 606 607 # generate a salt not only from rand() but also mixing 608 # in the users login name: unecessary 609 $salt .= $saltchars[ 610 ( 611 int( rand( $#saltchars + 1 ) ) + 612 $i + 613 ord( substr( $login, $i % length($login), 1 ) ) ) 614 % ( $#saltchars + 1 ) 615 ]; 616 } 617 } 618 619 # crypt is not cross-plaform, so use Crypt::PasswdMD5 if it's available 620 if ( $this->{APR} ) { 621 return Crypt::PasswdMD5::unix_md5_crypt( 622 Foswiki::encode_utf8($passwd), 623 Foswiki::encode_utf8( substr( $salt, 0, 11 ) ) ); 624 } 625 else { 626 return crypt( Foswiki::encode_utf8($passwd), 627 Foswiki::encode_utf8( substr( $salt, 0, 11 ) ) ); 628 } 629 630 } 631 elsif ( $enc eq 'plain' ) { 632 return $passwd; 633 634 } 635 elsif ( $enc eq 'bcrypt' ) { 636 unless ( $this->{BCRYPT} ) { 637 $this->{error} = "Unsupported Encoding"; 638 return 0; 639 } 640 641 my $cost = $Foswiki::cfg{Htpasswd}{BCryptCost}; 642 $cost = 8 unless defined $cost; 643 $cost = sprintf( "%02d", $cost ); 644 645 my $salt; 646 $salt = $this->fetchPass($login) unless $fresh; 647 if ( $fresh || !$salt ) { 648 my @saltchars = ( '.', '/', 0 .. 9, 'A' .. 'Z', 'a' .. 'z' ); 649 foreach my $i ( 0 .. 15 ) { 650 651 # generate a salt not only from rand() but also mixing 652 # in the users login name: unecessary 653 $salt .= $saltchars[ 654 ( 655 int( rand( $#saltchars + 1 ) ) + 656 $i + 657 ord( substr( $login, $i % length($login), 1 ) ) ) 658 % ( $#saltchars + 1 ) 659 ]; 660 } 661 $salt = 662 Crypt::Eksblowfish::Bcrypt::en_base64( 663 Foswiki::encode_utf8($salt) ); 664 $salt = '$2a$' . $cost . '$' . $salt; 665 } 666 $salt = substr( $salt, 0, 29 ); 667 return Crypt::Eksblowfish::Bcrypt::bcrypt( 668 Foswiki::encode_utf8($passwd), 669 Foswiki::encode_utf8($salt) ); 670 } 671 die 'Unsupported password encoding ' . $enc; 672} 673 674=begin TML 675 676---++ ObjectMethod fetchPass( $login ) -> $passwordE 677 678Implements Foswiki::Password 679 680Returns encrypted password if succeeds. 681Returns 0 if login is invalid. 682Returns undef otherwise. 683 684=cut 685 686sub fetchPass { 687 my ( $this, $login ) = @_; 688 my $ret = 0; 689 my $enc = ''; 690 my $db; 691 692 if ($login) { 693 try { 694 695 # Read passwords with shared lock 696 $db = $this->_readPasswd(1); 697 if ( exists $db->{$login} ) { 698 $ret = $db->{$login}->{pass}; 699 $enc = $db->{$login}->{enc}; 700 } 701 else { 702 $this->{error} = "Login $login invalid"; 703 $ret = undef; 704 } 705 } 706 catch Error with { 707 my $e = shift; 708 $this->{error} = $!; 709 print STDERR "ERROR: failed to fetchPass - $! ($e)"; 710 $this->{error} = 'unknown error in fetchPass' 711 unless ( $this->{error} && length( $this->{error} ) ); 712 return undef; 713 }; 714 } 715 else { 716 $this->{error} = 'No user'; 717 } 718 return (wantarray) ? ( $ret, $db->{$login} ) : $ret; 719} 720 721=begin TML 722 723---++ setPassword( $login, $newPassU, $oldPassU ) -> $boolean 724 725If the $oldPassU matches matches the user's password, then it will 726replace it with $newPassU. 727 728If $oldPassU is not correct and not 1, will return 0. 729 730If $oldPassU is 1, will force the change irrespective of 731the existing password, adding the user if necessary. 732 733Otherwise returns 1 on success, undef on failure. 734 735The password file is locked for exclusive access before being updated. 736 737=cut 738 739sub setPassword { 740 my ( $this, $login, $newUserPassword, $oldUserPassword ) = @_; 741 ASSERT($login) if DEBUG; 742 743 if ( defined($oldUserPassword) ) { 744 unless ( $oldUserPassword eq '1' ) { 745 return 0 unless $this->checkPassword( $login, $oldUserPassword ); 746 } 747 } 748 elsif ( $this->fetchPass($login) ) { 749 $this->{error} = $login . ' already exists'; 750 return 0; 751 } 752 753 my $lockHandle; 754 try { 755 $lockHandle = _lockPasswdFile(LOCK_EX); 756 757 # Read password without shared lock as we have already exclusive lock 758 # - Don't trust cache 759 my $db = $this->_readPasswd( 0, 1 ); 760 761 $db->{$login}->{pass} = $this->encrypt( $login, $newUserPassword, 1 ); 762 $db->{$login}->{enc} = $Foswiki::cfg{Htpasswd}{Encoding}; 763 $db->{$login}->{realm} = 764 ( $Foswiki::cfg{Htpasswd}{Encoding} eq 'md5' 765 || $Foswiki::cfg{Htpasswd}{Encoding} eq 'htdigest-md5' ) 766 ? $Foswiki::cfg{AuthRealm} 767 : ''; 768 $db->{$login}->{emails} ||= ''; 769 print STDERR 770"setPassword login $login pass $db->{$login}->{pass} enc $db->{$login}->{enc} realm $db->{$login}->{realm} emails $db->{$login}->{emails}\n" 771 if (TRACE); 772 $this->_savePasswd($db); 773 774 } 775 catch Error with { 776 my $e = shift; 777 $this->{error} = $!; 778 print STDERR "ERROR: failed to setPassword - $! ($e)"; 779 $this->{error} = 'unknown error in setPassword' 780 unless ( $this->{error} && length( $this->{error} ) ); 781 return undef; 782 } 783 finally { 784 _unlockPasswdFile($lockHandle) if $lockHandle; 785 }; 786 787 $this->{error} = undef; 788 return 1; 789} 790 791=begin TML 792 793---++ ObjectMethod removeUser( $login ) -> $boolean 794 795Removes the user identified by $login from the database 796and saves the password file. 797 798Returns 1 on success, undef on failure. 799 800=cut 801 802sub removeUser { 803 my ( $this, $login ) = @_; 804 my $result = undef; 805 $this->{error} = undef; 806 807 my $lockHandle; 808 try { 809 $lockHandle = _lockPasswdFile(LOCK_EX); 810 811 # Read password without shared lock as we have already exclusive lock 812 # - Don't trust cache 813 my $db = $this->_readPasswd( 0, 1 ); 814 unless ( $db->{$login} ) { 815 $this->{error} = 'No such user ' . $login; 816 } 817 else { 818 delete $db->{$login}; 819 $this->_savePasswd($db); 820 $result = 1; 821 } 822 } 823 catch Error with { 824 my $e = shift; 825 $this->{error} = $!; 826 print STDERR "ERROR: failed to removeUser - $! ($e)"; 827 $this->{error} = 'unknown error in removeUser' 828 unless ( $this->{error} && length( $this->{error} ) ); 829 return undef; 830 } 831 finally { 832 _unlockPasswdFile($lockHandle) if $lockHandle; 833 }; 834 835 return $result; 836} 837 838=begin TML 839 840---++ ObjectMethod checkPassword( $login, $password ) -> $boolean 841 842Checks the validity of $password by looking up the user in the 843password file, and comparing the stored hash to the computed 844hash of the supplied password. 845 846Returns 1 on success, 0 on failure. 847 848=cut 849 850sub checkPassword { 851 my ( $this, $login, $password ) = @_; 852 my ( $pw, $entry ) = $this->fetchPass($login); 853 854 # $pw will be 0 if there is no pw 855 return 0 unless defined $pw && length($pw); 856 857 my $encryptedPassword = $this->encrypt( $login, $password, 0, $entry ); 858 return 0 unless ($encryptedPassword); 859 860 $this->{error} = undef; 861 862 #print STDERR "Checking $pw against $encryptedPassword\n" if (TRACE); 863 864 if ( length($pw) != length($encryptedPassword) ) { 865 866 #print STDERR "Fail on length mismatch ($pw) vs enc ($encryptedPassword)\n"; 867 $this->{error} = 'Invalid user/password'; 868 return 0; 869 } 870 return 1 if ( $pw && ( $encryptedPassword eq $pw ) ); 871 872 # pw may validly be '', and must match an unencrypted ''. This is 873 # to allow for sysadmins removing the password field in .htpasswd in 874 # order to reset the password. 875 return 1 if ( defined $password && $pw eq '' && $password eq '' ); 876 877 $this->{error} = 'Invalid user/password'; 878 return 0; 879} 880 881=begin TML 882 883---++ ObjectMethod isManagingEmails() -> $boolean 884 885Returns true if the password manager is managing emails. This 886implementaiton always returns true. 887 888=cut 889 890sub isManagingEmails { 891 return 1; 892} 893 894=begin TML 895 896---++ ObjectMethod getEmails($login) -> @array 897 898Looks up the user in the database, Returns a list of email addresses 899for the user. or returns an empty list. 900=cut 901 902sub getEmails { 903 my ( $this, $login ) = @_; 904 905 # first try the mapping cache 906 # read passwords with shared lock 907 my $db = $this->_readPasswd(1); 908 if ( $db->{$login}->{emails} ) { 909 return split( /;/, $db->{$login}->{emails} ); 910 } 911 912 return; 913} 914 915=begin TML 916 917---++ ObjectMethod setEmails($login, @emails ) -> $boolean 918 919Sets the identified user $login to the list of @emails. 920 921=cut 922 923sub setEmails { 924 my $this = shift; 925 my $login = shift; 926 my $emails = join( ';', @_ ); 927 ASSERT($login) if DEBUG; 928 my $lockHandle; 929 930 try { 931 $lockHandle = _lockPasswdFile(LOCK_EX); 932 933 # Read password without shared lock as we have already exclusive lock 934 # - Don't trust cache 935 my $db = $this->_readPasswd( 0, 1 ); 936 unless ( $db->{$login} ) { 937 938 # Make sure the user is in the auth system, by adding them with 939 # a null password if not. 940 $db->{$login}->{pass} = ''; 941 } 942 943 $db->{$login}->{emails} = $emails; 944 945 $this->_savePasswd($db); 946 } 947 finally { 948 _unlockPasswdFile($lockHandle) if $lockHandle; 949 }; 950 return 1; 951} 952 953=begin TML 954 955---++ ObjectMethod findUseByEmail($email ) -> @array 956 957Searches the password DB for users who have set this email. 958and returns and array of $login identifiers. 959 960=cut 961 962sub findUserByEmail { 963 my ( $this, $email ) = @_; 964 my $logins = []; 965 966 $email = lc($email); 967 968 # read passwords with shared lock 969 my $db = $this->_readPasswd(1); 970 while ( my ( $k, $v ) = each %$db ) { 971 my %ems = map { lc($_) => 1 } split( ';', $v->{emails} ); 972 if ( $ems{$email} ) { 973 push( @$logins, $k ); 974 } 975 } 976 return $logins; 977} 978 9791; 980__END__ 981Foswiki - The Free and Open Source Wiki, http://foswiki.org/ 982 983Copyright (C) 2008-2017 Foswiki Contributors. Foswiki Contributors 984are listed in the AUTHORS file in the root of this distribution. 985NOTE: Please extend that file, not this notice. 986 987Additional copyrights apply to some or all of the code in this 988file as follows: 989 990Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org 991and TWiki Contributors. All Rights Reserved. TWiki Contributors 992are listed in the AUTHORS file in the root of this distribution. 993 994This program is free software; you can redistribute it and/or 995modify it under the terms of the GNU General Public License 996as published by the Free Software Foundation; either version 2 997of the License, or (at your option) any later version. For 998more details read LICENSE in the root of this distribution. 999 1000This program is distributed in the hope that it will be useful, 1001but WITHOUT ANY WARRANTY; without even the implied warranty of 1002MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 1003 1004As per the GPL, removal of this notice is prohibited. 1005