358 lines
10 KiB
Perl
358 lines
10 KiB
Perl
|
# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
|
||
|
|
#
|
||
|
|
# Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
|
||
|
|
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
|
||
|
|
# are listed in the AUTHORS file in the root of this distribution.
|
||
|
|
# NOTE: Please extend that file, not this notice.
|
||
|
|
#
|
||
|
|
# 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. For
|
||
|
|
# more details read LICENSE in the root of this distribution.
|
||
|
|
#
|
||
|
|
# 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.
|
||
|
|
#
|
||
|
|
# As per the GPL, removal of this notice is prohibited.
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---+ package TWiki::Users
|
||
|
|
|
||
|
|
Singleton object that handles mapping of users to wikinames and
|
||
|
|
vice versa, and user authentication checking.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
package TWiki::Users;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use Assert;
|
||
|
|
use TWiki::User;
|
||
|
|
use TWiki::Time;
|
||
|
|
|
||
|
|
BEGIN {
|
||
|
|
# Do a dynamic 'use locale' for this module
|
||
|
|
if( $TWiki::cfg{UseLocale} ) {
|
||
|
|
require locale;
|
||
|
|
import locale();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ClassMethod new ($session, $impl)
|
||
|
|
|
||
|
|
Construct the user management object
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub new {
|
||
|
|
my ( $class, $session ) = @_;
|
||
|
|
ASSERT($session->isa( 'TWiki')) if DEBUG;
|
||
|
|
my $this = bless( {}, $class );
|
||
|
|
|
||
|
|
$this->{session} = $session;
|
||
|
|
|
||
|
|
my $implPasswordManager = $TWiki::cfg{PasswordManager};
|
||
|
|
$implPasswordManager = 'TWiki::Users::Password' if( $implPasswordManager eq 'none' );
|
||
|
|
eval "use $implPasswordManager";
|
||
|
|
die "Password Manager: $@" if $@;
|
||
|
|
$this->{passwords} = $implPasswordManager->new( $session );
|
||
|
|
|
||
|
|
my $implUserMappingManager = $TWiki::cfg{UserMappingManager};
|
||
|
|
$implUserMappingManager = 'TWiki::Users::TWikiUserMapping' if( $implUserMappingManager eq 'none' );
|
||
|
|
eval "use $implUserMappingManager";
|
||
|
|
die "User Mapping Manager: $@" if $@;
|
||
|
|
$this->{usermappingmanager} = $implUserMappingManager->new( $session );
|
||
|
|
|
||
|
|
$this->{login} = {};
|
||
|
|
$this->{wikiname} = {};
|
||
|
|
|
||
|
|
$this->{CACHED} = 0;
|
||
|
|
|
||
|
|
# create the guest user
|
||
|
|
$this->createUser( $TWiki::cfg{DefaultUserLogin},
|
||
|
|
$TWiki::cfg{DefaultUserWikiName} );
|
||
|
|
|
||
|
|
return $this;
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod finish
|
||
|
|
|
||
|
|
Complete processing after the client's HTTP request has been responded
|
||
|
|
to.
|
||
|
|
1 breaking circular references to allow garbage collection in persistent
|
||
|
|
environments
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub finish {
|
||
|
|
my $this = shift;
|
||
|
|
|
||
|
|
$this->{passwords}->finish();
|
||
|
|
$this->{usermappingmanager}->finish();
|
||
|
|
|
||
|
|
my $wikinames = $this->{wikiname};
|
||
|
|
while (my ($wikiname,$user) = each %$wikinames) {
|
||
|
|
$user->{groups} = ();
|
||
|
|
}
|
||
|
|
$this->{wikiname} = {};
|
||
|
|
$this->{login} = {};
|
||
|
|
}
|
||
|
|
|
||
|
|
#returns a ref to an array of all group objects found.
|
||
|
|
sub getAllGroups() {
|
||
|
|
my $this = shift;
|
||
|
|
ASSERT($this->isa( 'TWiki::Users')) if DEBUG;
|
||
|
|
|
||
|
|
unless (defined($this->{grouplist})) {
|
||
|
|
# Always add $cfg{SuperAdminGroup}
|
||
|
|
my $sawAdmin = 0;
|
||
|
|
@{$this->{grouplist}} =
|
||
|
|
map { $sawAdmin ||= ($_->wikiName() eq $TWiki::cfg{SuperAdminGroup}); $_ }
|
||
|
|
$this->{usermappingmanager}->getListOfGroups();
|
||
|
|
if (!$sawAdmin) {
|
||
|
|
push(@{$this->{grouplist}}, $this->findUser($TWiki::cfg{SuperAdminGroup}));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return \@{$this->{grouplist}};
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# Get a list of user objects from a text string containing a
|
||
|
|
# list of user names. Used by User.pm
|
||
|
|
sub expandUserList {
|
||
|
|
my( $this, $names, $expand ) = @_;
|
||
|
|
ASSERT($this->isa( 'TWiki::Users')) if DEBUG;
|
||
|
|
|
||
|
|
$names ||= '';
|
||
|
|
# comma delimited list of users or groups
|
||
|
|
# i.e.: "%MAINWEB%.UserA, UserB, Main.UserC # something else"
|
||
|
|
$names =~ s/(<[^>]*>)//go; # Remove HTML tags
|
||
|
|
|
||
|
|
$names =~ s/\s*([$TWiki::regex{mixedAlphaNum}_\.\,\s\%]*)\s*(.*)/$1/go;
|
||
|
|
|
||
|
|
my @l = map { $this->findUser( $_ ) } split( /[\,\s]+/, $names );
|
||
|
|
return \@l;
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod findUser( $name [, $wikiname] [, $nocreate ] ) -> $userObject
|
||
|
|
|
||
|
|
* =$name= - login name or wiki name
|
||
|
|
* =$wikiname= - optional, wikiname for created user
|
||
|
|
* =$nocreate= - optional, disable creation of user object for user not found
|
||
|
|
|
||
|
|
Find the user object corresponding to =$name=, which may be either a
|
||
|
|
login name or a wiki name. If =$name= is found (either in the list
|
||
|
|
of login names or the list of wiki names) the corresponding
|
||
|
|
user object is returned. In this case =$wikiname= is ignored.
|
||
|
|
|
||
|
|
If they are not found, and =$nocreate= is true, then return undef.
|
||
|
|
|
||
|
|
If =$nocreate= is false, then a user object is returned even if
|
||
|
|
the user is not known.
|
||
|
|
|
||
|
|
If =$nocreate= is false, and no =$wikiname= is given, then the
|
||
|
|
=$name= is used for both login name and wiki name.
|
||
|
|
|
||
|
|
If nocreate is off, then a default user will be created with their wikiname
|
||
|
|
set the same as their login name. This user/wiki name pair can be overridden
|
||
|
|
by a later createUser call when the correct wikiname is known, if necessary.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub findUser {
|
||
|
|
my( $this, $name, $wikiname, $dontCreate ) = @_;
|
||
|
|
ASSERT($this->isa( 'TWiki::Users')) if DEBUG;
|
||
|
|
$name ||= $TWiki::cfg{DefaultUserLogin};
|
||
|
|
my $object;
|
||
|
|
|
||
|
|
#$this->{session}->writeDebug("Looking for $name / $wikiname / $dontCreate");
|
||
|
|
|
||
|
|
# is it a cached login name?
|
||
|
|
$object = $this->{login}{$name};
|
||
|
|
return $object if $object;
|
||
|
|
|
||
|
|
# remove pointless tag; we'll be looking there anyway
|
||
|
|
$name =~ s/^%MAINWEB%.//;
|
||
|
|
|
||
|
|
if( $name =~ m/^$TWiki::regex{webNameRegex}\.$TWiki::regex{wikiWordRegex}$/o ) {
|
||
|
|
# may be web.wikiname; try the cache
|
||
|
|
$object = $this->{wikiname}{$name};
|
||
|
|
return $object if $object;
|
||
|
|
}
|
||
|
|
|
||
|
|
# prepend the mainweb and try again in the cache
|
||
|
|
if( $name =~ /^$TWiki::regex{wikiWordRegex}$/ ) {
|
||
|
|
$object = $this->{wikiname}{"$TWiki::cfg{UsersWebName}.$name"};
|
||
|
|
return $object if $object;
|
||
|
|
}
|
||
|
|
|
||
|
|
# not cached
|
||
|
|
|
||
|
|
# if no wikiname is given, try and recover it from
|
||
|
|
# TWikiUsers
|
||
|
|
unless( $wikiname ) {
|
||
|
|
$wikiname = $this->lookupLoginName( $name );
|
||
|
|
}
|
||
|
|
|
||
|
|
if( !$wikiname &&
|
||
|
|
$name =~ m/^($TWiki::regex{webNameRegex}\.)?$TWiki::regex{wikiWordRegex}$/o ) {
|
||
|
|
my $t = $name;
|
||
|
|
$t = "$TWiki::cfg{UsersWebName}.$t" unless $1;
|
||
|
|
# not in TWiki users as a login name; see if it is
|
||
|
|
# a WikiName
|
||
|
|
my $lUser = $this->lookupWikiName( $t );
|
||
|
|
if( $lUser ) {
|
||
|
|
# it's a wikiname
|
||
|
|
$name = $lUser;
|
||
|
|
$wikiname = $t;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# if we haven't matched a wikiname yet and we've been told
|
||
|
|
# not to create, then abandon ship
|
||
|
|
return undef if ( !$wikiname && $dontCreate );
|
||
|
|
|
||
|
|
unless( $wikiname ) {
|
||
|
|
# default to wikiname being the same as name.
|
||
|
|
# Commented out because this warning is too common, and tends to
|
||
|
|
# flood the logs.
|
||
|
|
# $this->{session}->writeWarning("$name does not exist in TWikiUsers - is this a bogus user?") unless( $name =~ /Group$/ );
|
||
|
|
$wikiname = $name;
|
||
|
|
}
|
||
|
|
|
||
|
|
return $this->createUser( $name, $wikiname );
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod findUserByEmail( $email ) -> \@users
|
||
|
|
* =$email= - email address to look up
|
||
|
|
Return a list of user objects for the users that have this email registered
|
||
|
|
with the password manager.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub findUserByEmail {
|
||
|
|
my $this = shift;
|
||
|
|
ASSERT($this->isa( 'TWiki::Users')) if DEBUG;
|
||
|
|
|
||
|
|
my $user = $this->{passwords}->findUserByEmail(@_);
|
||
|
|
return $user;
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod createUser( $login, $wikiname ) -> $userobject
|
||
|
|
|
||
|
|
Create a user, and insert them in the maps (overwriting any current entry).
|
||
|
|
Use this instead of findUser when you want to be sure you are not going to
|
||
|
|
pick up any default user created by findUser. All parameters are required.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub createUser {
|
||
|
|
my( $this, $name, $wikiname ) = @_;
|
||
|
|
|
||
|
|
my $object = new TWiki::User( $this->{session}, $name, $wikiname );
|
||
|
|
if ( defined ($object) ) {
|
||
|
|
$this->{login}{$object->login()} = $object;
|
||
|
|
$this->{wikiname}{$object->webDotWikiName()} = $object;
|
||
|
|
}
|
||
|
|
|
||
|
|
return $object;
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod addUserToMapping( $user ) -> $topicName
|
||
|
|
|
||
|
|
Add a user to the persistant mapping that maps from usernames to wikinames
|
||
|
|
and vice-versa.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub addUserToMapping {
|
||
|
|
my ( $this, $user, $me ) = @_;
|
||
|
|
|
||
|
|
return $this->{usermappingmanager}->addUserToMapping($user, $me);
|
||
|
|
}
|
||
|
|
|
||
|
|
# Translates username (e.g. jsmith) to Web.WikiName
|
||
|
|
# (e.g. Main.JaneSmith)
|
||
|
|
sub lookupLoginName {
|
||
|
|
my( $this, $loginUser ) = @_;
|
||
|
|
|
||
|
|
return undef unless $loginUser;
|
||
|
|
|
||
|
|
$loginUser =~ s/$TWiki::cfg{NameFilter}//go;
|
||
|
|
return $this->{usermappingmanager}->lookupLoginName($loginUser);
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# Translates Web.WikiName (e.g. Main.JaneSmith) to
|
||
|
|
# username (e.g. jsmith)
|
||
|
|
sub lookupWikiName {
|
||
|
|
my( $this, $wikiName ) = @_;
|
||
|
|
|
||
|
|
return undef unless $wikiName;
|
||
|
|
|
||
|
|
$wikiName =~ s/$TWiki::cfg{NameFilter}//go;
|
||
|
|
$wikiName = "$TWiki::cfg{UsersWebName}.$wikiName"
|
||
|
|
unless $wikiName =~ /\./;
|
||
|
|
|
||
|
|
return $this->{usermappingmanager}->lookupWikiName($wikiName);
|
||
|
|
}
|
||
|
|
|
||
|
|
#TODO: I was under the impression that this list would not contain every user,
|
||
|
|
#but i can't prove it..
|
||
|
|
#using TWikiUserMapping, this hash will contain users listed in a group, that don't exist
|
||
|
|
#Also, this list will contain a user that is in the current session file, even after it was removed from the system ( we don't check the validity of the user specified in the session - and thus a person can log in, then have their account removed, and until the session expires, they can still edit.)
|
||
|
|
sub getAllLoadedUsers {
|
||
|
|
my $this = shift;
|
||
|
|
my $includeGroups = shift || 0;
|
||
|
|
|
||
|
|
my @list = ();
|
||
|
|
foreach my $key (sort keys(%{$this->{wikiname}})) {
|
||
|
|
my $u = $this->{wikiname}{$key};
|
||
|
|
if ($u->isa( 'TWiki::User')) {
|
||
|
|
push(@list, $u) unless (($includeGroups == 0) && ($u->isGroup()));
|
||
|
|
} else {
|
||
|
|
die $u;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return \@list;
|
||
|
|
}
|
||
|
|
|
||
|
|
#TODO: we need to re-write and bring together the different UserCaches
|
||
|
|
#this seems to be a safer list than getAllLoadedUsers()
|
||
|
|
#however, if there is a non-existant user in the TWikiUsers topic, it will be here.
|
||
|
|
sub getAllUsers {
|
||
|
|
my( $this ) = @_;
|
||
|
|
|
||
|
|
my @list = $this->{usermappingmanager}->getListOfAllWikiNames();
|
||
|
|
@list = sort(@list);
|
||
|
|
# die join(', ', @list);
|
||
|
|
|
||
|
|
my @userlist= ();
|
||
|
|
|
||
|
|
foreach my $u (@list) {
|
||
|
|
my $user = $this->findUser($u);
|
||
|
|
push(@userlist, $user) if ($user->isa( 'TWiki::User'));
|
||
|
|
}
|
||
|
|
|
||
|
|
return \@userlist;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
1;
|