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