459 lines
10 KiB
Perl
459 lines
10 KiB
Perl
# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
|
|
#
|
|
# Copyright (C) 1999-2007 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.
|
|
|
|
package TWiki::User;
|
|
|
|
use strict;
|
|
use Assert;
|
|
use TWiki;
|
|
|
|
=pod
|
|
|
|
---+ package TWiki::User
|
|
|
|
A User object is an internal representation of a user in the real world.
|
|
The object knows about users having login names, wiki names, personal
|
|
topics, and email addresses.
|
|
|
|
=cut
|
|
|
|
=pod
|
|
|
|
Groups are also handled here. A group is really a subclass of a user,
|
|
in that it is a user with a set of users within it.
|
|
|
|
The User package also provides methods for managing the passwords of the
|
|
user.
|
|
|
|
=cut
|
|
|
|
# global used by test harness to give predictable results
|
|
use vars qw( $password );
|
|
|
|
# STATIC function that returns a random password
|
|
sub randomPassword {
|
|
return $password || int( rand(9999999999) );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ClassMethod new( $session, $loginname, $wikiname )
|
|
|
|
Construct a new user object for the given login name, wiki name.
|
|
|
|
The wiki name can either be a wiki word or it can be a web-
|
|
qualified wiki word. If the wiki name is not web qualified, the
|
|
user is assumed to have their home topic in the
|
|
$TWiki::cfg{UsersWebName} web.
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my( $class, $session, $name, $wikiname ) = @_;
|
|
ASSERT($session->isa( 'TWiki')) if DEBUG;
|
|
ASSERT($name) if DEBUG;
|
|
ASSERT($wikiname) if DEBUG;
|
|
|
|
my $this = bless( {}, $class );
|
|
$this->{session} = $session;
|
|
|
|
$this->{login} = $name;
|
|
my( $web, $topic ) =
|
|
$session->normalizeWebTopicName( $TWiki::cfg{UsersWebName}, $wikiname );
|
|
$this->{web} = $web;
|
|
$this->{wikiname} = $topic;
|
|
$this->{groups} = [];
|
|
return $this;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod wikiName() -> $wikiName
|
|
|
|
Return the wikiname of the user (without the web!)
|
|
|
|
=cut
|
|
|
|
sub wikiName {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
return $this->{wikiname};
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod webDotWikiName() -> $webDotWiki
|
|
|
|
Return the fully qualified wikiname of the user
|
|
|
|
=cut
|
|
|
|
sub webDotWikiName {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
return $this->web().'.'.$this->wikiName();
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod login() -> $loginName
|
|
|
|
Return the login name of the user
|
|
|
|
=cut
|
|
|
|
sub login {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
return $this->{login};
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod web() -> $webName
|
|
|
|
Return the registration web of the user
|
|
|
|
=cut
|
|
|
|
sub web {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
return $this->{web};
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod equals() -> $boolean
|
|
|
|
Test is this is the same user as another user object
|
|
|
|
=cut
|
|
|
|
sub equals {
|
|
my( $this, $other ) = @_;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
ASSERT($other->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
return ( $this->{login} eq $other->{login} );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod stringify() -> $string
|
|
|
|
Generate a string representation of this object, suitable for debugging
|
|
|
|
=cut
|
|
|
|
sub stringify {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
return "$this->{login}/$this->{web}.$this->{wikiname}";
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod passwordExists( ) -> $boolean
|
|
|
|
Checks to see if there is an entry in the password system
|
|
Return '1' if true, '' if not
|
|
|
|
=cut
|
|
|
|
sub passwordExists {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
my $passwordHandler = $this->{session}->{users}->{passwords};
|
|
return $passwordHandler->fetchPass($this->{login});
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod checkPassword( $password ) -> $boolean
|
|
|
|
used to check the user's password
|
|
|
|
=$password= unencrypted password
|
|
|
|
=$success= '1' if success
|
|
|
|
TODO: need to improve the error mechanism so TWikiAdmins know what failed
|
|
|
|
=cut
|
|
|
|
sub checkPassword {
|
|
my ( $this, $password ) = @_;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
my $passwordHandler = $this->{session}->{users}->{passwords};
|
|
return $passwordHandler->checkPassword($this->{login}, $password);
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod removePassword() -> $boolean
|
|
|
|
Used to remove the user and password from the password system.
|
|
Returns true if success
|
|
|
|
=cut
|
|
|
|
# TODO: need to improve the error mechanism so TWikiAdmins know what failed
|
|
# SMELL - should this not also delete the user topic?
|
|
sub removePassword {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
my $passwordHandler = $this->{session}->{users}->{passwords};
|
|
return $passwordHandler->deleteUser( $this->{login} );
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod changePassword( $user, $oldUserPassword, $newUserPassword ) -> $boolean
|
|
|
|
used to change the user's password
|
|
=$oldUserPassword= unencrypted password
|
|
=$newUserPassword= unencrypted password
|
|
undef if success, error message otherwise
|
|
|
|
=cut
|
|
|
|
sub changePassword {
|
|
my ( $this, $oldUserPassword, $newUserPassword ) = @_;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
my $passwordHandler = $this->{session}->{users}->{passwords};
|
|
if( $passwordHandler->passwd($this->{login},
|
|
$newUserPassword, $oldUserPassword)) {
|
|
return undef;
|
|
} else {
|
|
return $passwordHandler->{error};
|
|
}
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod addPassword( $newPassword ) -> $boolean
|
|
|
|
creates a password entry
|
|
=$newUserPassword= unencrypted password
|
|
'1' if success
|
|
TODO: need to improve the error mechanism so TWikiAdmins know what failed
|
|
|
|
=cut
|
|
|
|
sub addPassword {
|
|
my ( $this, $newUserPassword ) = @_;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
my $passwordHandler = $this->{session}->{users}->{passwords};
|
|
return $passwordHandler->passwd($this->{login}, $newUserPassword);
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod resetPassword() -> $newPassword
|
|
|
|
Reset the users password, returning the new generated password.
|
|
|
|
=cut
|
|
|
|
sub resetPassword {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
my $password = randomPassword();
|
|
|
|
# removePassword will probably remove current e-mail addresses, cache a copy
|
|
my @tempEmails = $this->emails();
|
|
|
|
if( $this->passwordExists() ) {
|
|
$this->removePassword();
|
|
}
|
|
|
|
$this->addPassword( $password );
|
|
|
|
# push cached e-mail addresses back on account
|
|
$this->setEmails( @tempEmails );
|
|
|
|
return $password;
|
|
}
|
|
|
|
sub isDefaultUser {
|
|
# email must be empty string
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod emails() -> @emailAddress
|
|
|
|
If this is a user, return their email addresses. If it is a group,
|
|
return the addresses of everyone in the group.
|
|
|
|
=cut
|
|
|
|
sub emails {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
|
|
unless( defined $this->{emails} ) {
|
|
@{$this->{emails}} = ();
|
|
if ( $this->isGroup() ) {
|
|
foreach my $member ( @{$this->groupMembers()} ) {
|
|
push( @{$this->{emails}}, $member->emails() );
|
|
}
|
|
} else {
|
|
my $passwordHandler = $this->{session}->{users}->{passwords};
|
|
push(@{$this->{emails}}, $passwordHandler->getEmails($this->{login}));
|
|
}
|
|
}
|
|
|
|
return @{$this->{emails}};
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod setEmails($user, @emails)
|
|
|
|
Fetch the email address(es) for the given username
|
|
|
|
=cut
|
|
|
|
sub setEmails {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
return if $this->isGroup();
|
|
my $passwordHandler = $this->{session}->{users}->{passwords};
|
|
return $passwordHandler->setEmails($this->{login}, @_);
|
|
}
|
|
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod isAdmin() -> $boolean
|
|
|
|
True if the user is an admin (is a member of the $TWiki::cfg{SuperAdminGroup})
|
|
|
|
=cut
|
|
|
|
sub isAdmin {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
unless( defined($this->{isKnownAdmin}) ) {
|
|
if ($this->{wikiname} eq $TWiki::cfg{SuperAdminGroup}) {
|
|
$this->{isKnownAdmin} = 1;
|
|
} else {
|
|
my $sag = $this->{session}->{users}->findUser(
|
|
$TWiki::cfg{SuperAdminGroup} );
|
|
$this->{isKnownAdmin} = $this->isInList( $sag->groupMembers() );
|
|
}
|
|
}
|
|
return $this->{isKnownAdmin};
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod getGroups( ) -> @groups
|
|
|
|
Get a list of user objects for the groups a user is in
|
|
|
|
=cut
|
|
|
|
sub getGroups {
|
|
my $this = shift;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
my @groupList = @{$this->{session}->{users}->getAllGroups()};
|
|
foreach my $groupObject (@groupList) {
|
|
$groupObject->groupMembers();
|
|
}
|
|
|
|
return @{$this->{groups}};
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod isInList( $list ) -> $boolean
|
|
|
|
Return true we are in the list of user objects passed.
|
|
|
|
$list is a string representation of a user list.
|
|
|
|
=cut
|
|
|
|
sub isInList {
|
|
my( $this, $userlist, $scanning ) = @_;
|
|
ASSERT($this->isa( 'TWiki::User')) if DEBUG;
|
|
$scanning = {} unless $scanning;
|
|
|
|
unless( ref( $userlist )) {
|
|
# string parameter
|
|
$userlist = $this->{session}->{users}->expandUserList( $userlist );
|
|
}
|
|
my $user;
|
|
foreach $user ( @$userlist ) {
|
|
#don't check the same user twice
|
|
next if $scanning->{$user};
|
|
$scanning->{$user} = 1;
|
|
|
|
return 1 if $this->equals( $user );
|
|
if( $user->isGroup() ) {
|
|
return 1 if $this->isInList( $user->groupMembers(), $scanning );
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod isGroup() -> $boolean
|
|
|
|
Test if this is a group user or not
|
|
|
|
=cut
|
|
|
|
sub isGroup {
|
|
my $this = shift;
|
|
|
|
return 1 if $this->{wikiname} eq $TWiki::cfg{SuperAdminGroup};
|
|
|
|
return $this->{session}->{users}->{usermappingmanager}->isGroup($this);
|
|
}
|
|
|
|
=pod
|
|
|
|
---++ ObjectMethod groupMembers() -> @members
|
|
|
|
Return a list of user objects that are members of this group. Should only be
|
|
called on groups.
|
|
|
|
=cut
|
|
|
|
sub groupMembers {
|
|
my $this = shift;
|
|
ASSERT($this->isGroup());
|
|
|
|
return $this->{session}->{users}->{usermappingmanager}->groupMembers($this);
|
|
}
|
|
|
|
1;
|