lib/TWiki/Users/TWikiUserMapping.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
permissions -rw-r--r--
RELEASE 4.2.0 freetown
     1 # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
     2 #
     3 # Copyright (C) 2007 Sven Dowideit, SvenDowideit@distributedINFORMATION.com
     4 # and TWiki Contributors. All Rights Reserved. TWiki Contributors
     5 # are listed in the AUTHORS file in the root of this distribution.
     6 # NOTE: Please extend that file, not this notice.
     7 #
     8 # This program is free software; you can redistribute it and/or
     9 # modify it under the terms of the GNU General Public License
    10 # as published by the Free Software Foundation; either version 2
    11 # of the License, or (at your option) any later version. For
    12 # more details read LICENSE in the root of this distribution.
    13 #
    14 # This program is distributed in the hope that it will be useful,
    15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
    16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    17 #
    18 # As per the GPL, removal of this notice is prohibited.
    19 
    20 =begin twiki
    21 
    22 ---+ package TWiki::Users::TWikiUserMapping
    23 
    24 The User mapping is the process by which TWiki maps from a username (a login name)
    25 to a wikiname and back. It is also where groups are defined.
    26 
    27 By default TWiki maintains user topics and group topics in the %MAINWEB% that
    28 define users and group. These topics are
    29    * !TWikiUsers - stores a mapping from usernames to TWiki names
    30    * !WikiName - for each user, stores info about the user
    31    * !GroupNameGroup - for each group, a topic ending with "Group" stores a list of users who are part of that group.
    32 
    33 Many sites will want to override this behaviour, for example to get users and groups from a corporate database.
    34 
    35 This class implements the basic TWiki behaviour using topics to store users,
    36 but is also designed to be subclassed so that other services can be used.
    37 
    38 Subclasses should be named 'XxxxUserMapping' so that configure can find them.
    39  
    40 =cut
    41 
    42 package TWiki::Users::TWikiUserMapping;
    43 use base 'TWiki::UserMapping';
    44 
    45 use strict;
    46 use Assert;
    47 use Error qw( :try );
    48 
    49 #use Monitor;
    50 #Monitor::MonitorMethod('TWiki::Users::TWikiUserMapping');
    51 
    52 =begin twiki
    53 
    54 ---++ ClassMethod new ($session, $impl)
    55 
    56 Constructs a new user mapping handler of this type, referring to $session
    57 for any required TWiki services.
    58 
    59 =cut
    60 
    61 sub new {
    62     my( $class, $session ) = @_;
    63 
    64     # The null mapping name is reserved for TWiki for backward-compatibility
    65     my $this = $class->SUPER::new( $session, '' );
    66 
    67     my $implPasswordManager = $TWiki::cfg{PasswordManager};
    68     $implPasswordManager = 'TWiki::Users::Password'
    69       if( $implPasswordManager eq 'none' );
    70     eval "require $implPasswordManager";
    71     die $@ if $@;
    72     $this->{passwords} = $implPasswordManager->new( $session );
    73     
    74     #if password manager says sorry, we're read only today
    75     #'none' is a special case, as it means we're not actually using the password manager for
    76     # registration.
    77     if ($this->{passwords}->readOnly() && ($TWiki::cfg{PasswordManager} ne 'none')) {
    78         $session->writeWarning( 'TWikiUserMapping has TURNED OFF EnableNewUserRegistration, because the password file is read only.' );
    79         $TWiki::cfg{Register}{EnableNewUserRegistration} = 0;
    80     }
    81 
    82 	#SMELL: and this is a second user object
    83 	#TODO: combine with the one in TWiki::Users
    84     #$this->{U2L} = {};
    85     $this->{L2U} = {};
    86     $this->{U2W} = {};
    87     $this->{W2U} = {};
    88     $this->{eachGroupMember} = {};
    89 
    90     return $this;
    91 }
    92 
    93 =begin twiki
    94 
    95 ---++ ObjectMethod finish()
    96 Break circular references.
    97 
    98 =cut
    99 
   100 # Note to developers; please undef *all* fields in the object explicitly,
   101 # whether they are references or not. That way this method is "golden
   102 # documentation" of the live fields in the object.
   103 sub finish {
   104     my $this = shift;
   105 
   106     $this->{passwords}->finish() if $this->{passwords};
   107     undef $this->{L2U};
   108     undef $this->{U2W};
   109     undef $this->{W2U};
   110     undef $this->{passwords};
   111     undef $this->{eachGroupMember};
   112     $this->SUPER::finish();
   113 }
   114 
   115 =begin twiki
   116 
   117 ---++ ObjectMethod supportsRegistration () -> false
   118 return 1 if the UserMapper supports registration (ie can create new users)
   119 
   120 =cut
   121 
   122 sub supportsRegistration {
   123     return 1;
   124 }
   125 
   126 =begin twiki
   127 
   128 ---++ ObjectMethod handlesUser ( $cUID, $login, $wikiname) -> $boolean
   129 
   130 Called by the TWiki::Users object to determine which loaded mapping
   131 to use for a given user (must be fast).
   132 
   133 =cut
   134 
   135 sub handlesUser {
   136 	my ($this, $cUID, $login, $wikiname) = @_;
   137 	
   138     if (defined $cUID && !length($this->{mapping_id})) {
   139         # TWikiUserMapping is special - for backwards compatibility, it assumes
   140         # responsibility for _all_ non BaseMapping users
   141         # if you're needing to mix the TWikiuserMapping with others, 
   142         # define $this->{mapping_id} = 'TWikiUserMapping_';
   143         return 1;
   144     } else {
   145         # Used when (if) TWikiUserMapping is subclassed
   146         return 1 if ( defined $cUID && $cUID =~ /^($this->{mapping_id})/ );
   147     }
   148 	return 1 if ($login && $this->getLoginName( $login ));
   149 #	return 1 if ($wikiname && $this->findUserByWikiName( $wikiname ));
   150 	return 0;
   151 }
   152 
   153 
   154 =begin twiki
   155 
   156 ---++ ObjectMethod getCanonicalUserID ($login, $dontcheck) -> cUID
   157 
   158 Convert a login name to the corresponding canonical user name. The
   159 canonical name can be any string of 7-bit alphanumeric and underscore
   160 characters, and must correspond 1:1 to the login name.
   161 (undef on failure)
   162 
   163 (if dontcheck is true, return a cUID for a nonexistant user too - used for registration)
   164 
   165 =cut
   166 
   167 sub getCanonicalUserID {
   168     my( $this, $login, $dontcheck ) = @_;
   169 #    print STDERR "\nTWikiUserMapping::getCanonicalUserID($login, ".($dontcheck||'undef').")";
   170 
   171     unless ($dontcheck) {
   172         return unless (_userReallyExists($this, $login));
   173     }
   174 
   175     $login = TWiki::Users::forceCUID($login);
   176     $login = $this->{mapping_id}.$login;
   177 #print STDERR " OK ($login)";
   178     return $login;
   179 }
   180 
   181 =begin twiki
   182 
   183 ---++ ObjectMethod getLoginName ($cUID) -> login
   184 
   185 converts an internal cUID to that user's login
   186 (undef on failure)
   187 
   188 =cut
   189 
   190 sub getLoginName {
   191     my( $this, $user ) = @_;
   192     ASSERT($user) if DEBUG;
   193 	
   194 	#can't call userExists - its recursive
   195 	#return unless (userExists($this, $user));
   196 	
   197     # Remove the mapping id in case this is a subclass
   198     $user =~ s/$this->{mapping_id}// if $this->{mapping_id};
   199 
   200     use bytes;
   201     # use bytes to ignore character encoding
   202     $user =~ s/_(\d\d)/chr($1)/ge;
   203     no bytes;
   204 
   205     return unless (_userReallyExists($this, $user));
   206     
   207     return $user;
   208 }
   209 
   210 =begin twiki
   211 
   212 ---++ ObjectMethod _userReallyExists ($login) -> boolean
   213 
   214 test if the login is in the TWikiUsers topic, or in the password file
   215 depending on the AllowLoginNames setting
   216 
   217 =cut
   218 
   219 sub _userReallyExists {
   220     my( $this, $login ) = @_;
   221     
   222     if ($TWiki::cfg{Register}{AllowLoginName}) {
   223         #need to use the TWikiUsers file
   224         _loadMapping($this);
   225         return 1 if (defined($this->{L2U}->{$login}));
   226     }
   227     
   228     if ($this->{passwords}->canFetchUsers()) {
   229         #AllowLoginName mapping failed, maybe the user is however present in the TWiki managed pwd file
   230         #can use the password file if available 
   231         my $pass = $this->{passwords}->fetchPass( $login );
   232         return unless (defined($pass));
   233         return if ("$pass" eq "0"); #login invalid... (TODO: what does that really mean)
   234         return 1;
   235      } else {
   236         #passwd==none case generally assumes any login given exists... (not positive if that makes sense for rego..)
   237         return 1;
   238      }
   239 
   240     return 0;
   241 }
   242 
   243 =begin twiki
   244 
   245 ---++ ObjectMethod addUser ($login, $wikiname, $password, $emails) -> cUID
   246 
   247 throws an Error::Simple 
   248 
   249 Add a user to the persistant mapping that maps from usernames to wikinames
   250 and vice-versa. The default implementation uses a special topic called
   251 "TWikiUsers" in the users web. Subclasses will provide other implementations
   252 (usually stubs if they have other ways of mapping usernames to wikinames).
   253 Names must be acceptable to $TWiki::cfg{NameFilter}
   254 $login must *always* be specified. $wikiname may be undef, in which case
   255 the user mapper should make one up.
   256 This function must return a *canonical user id* that it uses to uniquely
   257 identify the user. This can be the login name, or the wikiname if they
   258 are all guaranteed unigue, or some other string consisting only of 7-bit
   259 alphanumerics and underscores.
   260 if you fail to create a new user (for eg your Mapper has read only access), 
   261             throw Error::Simple(
   262                'Failed to add user: '.$ph->error());
   263 
   264 =cut
   265 
   266 sub addUser {
   267     my ( $this, $login, $wikiname, $password, $emails ) = @_;
   268 
   269     ASSERT($login) if DEBUG;
   270 
   271     # SMELL: really ought to be smarter about this e.g. make a wikiword
   272     $wikiname ||= $login;
   273 
   274     if( $this->{passwords}->fetchPass( $login )) {
   275         # They exist; their password must match
   276         unless( $this->{passwords}->checkPassword( $login, $password )) {
   277             throw Error::Simple(
   278                 'New password did not match existing password for this user');
   279         }
   280         # User exists, and the password was good.
   281     } else {
   282         # add a new user
   283 
   284         unless( defined( $password )) {
   285             require TWiki::Users;
   286             $password = TWiki::Users::randomPassword();
   287         }
   288 
   289         unless( $this->{passwords}->setPassword( $login, $password )) {
   290         	#print STDERR "\n Failed to add user:  ".$this->{passwords}->error();
   291             throw Error::Simple(
   292                 'Failed to add user: '.$this->{passwords}->error());
   293         }
   294     }
   295 
   296     my $store = $this->{session}->{store};
   297     my( $meta, $text );
   298 
   299     if( $store->topicExists( $TWiki::cfg{UsersWebName},
   300                              $TWiki::cfg{UsersTopicName} )) {
   301         ( $meta, $text ) = $store->readTopic(
   302             undef, $TWiki::cfg{UsersWebName}, $TWiki::cfg{UsersTopicName} );
   303     } else {
   304         ( $meta, $text ) = $store->readTopic(
   305             undef, $TWiki::cfg{SystemWebName}, 'TWikiUsersTemplate' );
   306     }
   307 
   308     my $result = '';
   309     my $entry = "   * $wikiname - ";
   310     $entry .= $login . " - " if $login;
   311 
   312     require TWiki::Time;
   313     my $today = TWiki::Time::formatTime(time(), $TWiki::cfg{DefaultDateFormat}, 'gmtime');
   314 
   315     # add to the mapping caches
   316     my $user = _cacheUser( $this, $wikiname, $login );
   317     ASSERT($user) if DEBUG;
   318 
   319     # add name alphabetically to list
   320     foreach my $line ( split( /\r?\n/, $text) ) {
   321         # TODO: I18N fix here once basic auth problem with 8-bit user names is
   322         # solved
   323         if ( $entry ) {
   324             my ( $web, $name, $odate ) = ( '', '', '' );
   325             if ( $line =~ /^\s+\*\s($TWiki::regex{webNameRegex}\.)?($TWiki::regex{wikiWordRegex})\s*(?:-\s*\w+\s*)?-\s*(.*)/ ) {
   326                 $web = $1 || $TWiki::cfg{UsersWebName};
   327                 $name = $2;
   328                 $odate = $3;
   329             } elsif ( $line =~ /^\s+\*\s([A-Z]) - / ) {
   330                 #	* A - <a name="A">- - - -</a>^M
   331                 $name = $1;
   332             }
   333             if( $name && ( $wikiname le $name ) ) {
   334                 # found alphabetical position
   335                 if( $wikiname eq $name ) {
   336                     # adjusting existing user - keep original registration date
   337                     $entry .= $odate;
   338                 } else {
   339                     $entry .= $today."\n".$line;
   340                 }
   341                 # don't adjust if unchanged
   342                 return $user if( $entry eq $line );
   343                 $line = $entry;
   344                 $entry = '';
   345             }
   346         }
   347 
   348         $result .= $line."\n";
   349     }
   350     if( $entry ) {
   351         # brand new file - add to end
   352         $result .= "$entry$today\n";
   353     }
   354     $store->saveTopic( 
   355     			#TODO: why is this Admin and not the RegoAgent??
   356     			$this->{session}->{users}->getCanonicalUserID($TWiki::cfg{AdminUserLogin}),
   357                        $TWiki::cfg{UsersWebName},
   358                        $TWiki::cfg{UsersTopicName},
   359                        $result, $meta );
   360 
   361     #can't call setEmails here - user may be in the process of being registered
   362     #TODO; when registration is moved into the mapping, setEmails will happend after the createUserTOpic
   363     #$this->setEmails( $user, $emails );
   364 
   365     return $user;
   366 }
   367 
   368 
   369 =begin twiki
   370 
   371 ---++ ObjectMethod removeUser( $user ) -> $boolean
   372 
   373 Delete the users entry. Removes the user from the password
   374 manager and user mapping manager. Does *not* remove their personal
   375 topics, which may still be linked.
   376 
   377 =cut
   378 
   379 sub removeUser {
   380     my( $this, $user ) = @_;
   381 	$this->ASSERT_IS_CANONICAL_USER_ID($user) if DEBUG;
   382     my $ln = $this->getLoginName( $user );
   383     $this->{passwords}->removeUser($ln);
   384     # SMELL: currently a nop, needs someone to implement it
   385 }
   386 
   387 
   388 =begin twiki
   389 
   390 ---++ ObjectMethod getWikiName ($cUID) -> wikiname
   391 
   392 Map a canonical user name to a wikiname. If it fails to find a WikiName, it will
   393 attempt to find a matching loginname, and use an escaped version of that.
   394 If there is no matching WikiName or LoginName, it returns undef.
   395 
   396 =cut
   397 
   398 sub getWikiName {
   399     my ($this, $cUID) = @_;
   400 	ASSERT($cUID) if DEBUG;
   401 	ASSERT($cUID =~ /^$this->{mapping_id}/) if DEBUG;
   402 	
   403 	my $wikiname;
   404 #    $cUID =~ s/^$this->{mapping_id}//;
   405     if( $TWiki::cfg{Register}{AllowLoginName} ) {
   406         _loadMapping( $this );
   407         $wikiname = $this->{U2W}->{$cUID}
   408     } else {
   409         # If the mapping isn't enabled there's no point in loading it
   410     }
   411     
   412     unless ($wikiname) {
   413         #sanitise the generated WikiName - fix up email addresses and stuff
   414         $wikiname = getLoginName( $this, $cUID );
   415         if ($wikiname) {
   416             $wikiname =~ s/$TWiki::cfg{NameFilter}//go;
   417             $wikiname =~ s/\.//go;
   418         }
   419     }
   420 
   421 #print STDERR "--------------------------------------cUID : $cUID => $wikiname\n";	
   422     return $wikiname;
   423  
   424 }
   425 
   426 =begin twiki
   427 
   428 ---++ ObjectMethod userExists($cUID) -> $boolean
   429 
   430 Determine if the user already exists or not. Whether a user exists
   431 or not is determined by the password manager.
   432 
   433 =cut
   434 
   435 sub userExists {
   436     my( $this, $cUID ) = @_;
   437     ASSERT($cUID) if DEBUG;
   438 	$this->ASSERT_IS_CANONICAL_USER_ID($cUID) if DEBUG;
   439 
   440     # Do this to avoid a password manager lookup
   441     return 1 if $cUID eq $this->{session}->{user};
   442 
   443     my $loginName = $this->getLoginName( $cUID );
   444     return unless (defined($loginName) && ($loginName ne ''));
   445 
   446     if( $loginName eq $TWiki::cfg{DefaultUserLogin} ) {
   447         return $loginName;
   448     }
   449 
   450     # TWiki allows *groups* to log in
   451     if( $this->isGroup( $loginName )) {
   452         return $loginName;
   453     }
   454 
   455     # Look them up in the password manager (can be slow).
   456     if( $this->{passwords}->canFetchUsers() &&
   457        $this->{passwords}->fetchPass( $loginName )) {
   458         return $loginName;
   459     }
   460     
   461     unless ( $TWiki::cfg{Register}{AllowLoginName} ||
   462             $this->{passwords}->canFetchUsers() ) {
   463         #if there is no pwd file, then its external auth
   464         #and if AllowLoginName is also off, then the only way to know if
   465         #the user has registered is to test for user topic?
   466         if (TWiki::Func::topicExists($TWiki::cfg{UsersWebName}, $loginName)) {
   467             return $loginName
   468         }
   469     }
   470 
   471     return undef;
   472 }
   473 
   474 =begin twiki
   475 
   476 ---++ ObjectMethod eachUser () -> listIterator of cUIDs
   477 
   478 Called from TWiki::Users. See the documentation of the corresponding
   479 method in that module for details.
   480 
   481 =cut
   482 
   483 sub eachUser {
   484     my( $this ) = @_;
   485 
   486     _loadMapping( $this );
   487     my @list = keys(%{$this->{U2W}});
   488     require TWiki::ListIterator;
   489     my $iter = new TWiki::ListIterator( \@list );
   490     $iter->{filter} = sub {
   491         #don't claim users that are handled by the basemapping
   492         my $cUID = $_[0] || '';
   493         my $login = $this->{session}->{users}->getLoginName($cUID);
   494         my $wikiname =  $this->{session}->{users}->getWikiName($cUID);
   495         #print STDERR "**** $cUID  $login  $wikiname \n";
   496         require TWiki::Plugins;
   497         return !($TWiki::Plugins::SESSION->{users}->{basemapping}->handlesUser ( undef, $login, $wikiname) );
   498     };
   499     return $iter;
   500 }
   501 
   502 my %expanding;
   503 
   504 =begin twiki
   505 
   506 ---++ ObjectMethod eachGroupMember ($group) ->  listIterator of cUIDs
   507 
   508 Called from TWiki::Users. See the documentation of the corresponding
   509 method in that module for details.
   510 
   511 =cut
   512 
   513 sub eachGroupMember {
   514     my $this = shift;
   515     my $group = shift;
   516     
   517     return new TWiki::ListIterator( $this->{eachGroupMember}->{$group} )
   518             if (defined($this->{eachGroupMember}->{$group}));
   519     
   520     my $store = $this->{session}->{store};
   521     my $users = $this->{session}->{users};
   522 
   523     my $members = [];
   524 
   525     if( !$expanding{$group} &&
   526           $store->topicExists( $TWiki::cfg{UsersWebName}, $group )) {
   527 
   528         $expanding{$group} = 1;
   529         my $text =
   530           $store->readTopicRaw( undef,
   531                                 $TWiki::cfg{UsersWebName}, $group,
   532                                 undef );
   533 
   534         foreach( split( /\r?\n/, $text ) ) {
   535             if( /$TWiki::regex{setRegex}GROUP\s*=\s*(.+)$/ ) {
   536                 next unless( $1 eq 'Set' );
   537                 # Note: if there are multiple GROUP assignments in the
   538                 # topic, only the last will be taken.
   539                 my $f = $2;
   540                 $members = _expandUserList( $this, $f );
   541             }
   542         }
   543         delete $expanding{$group};
   544     }
   545 
   546     require TWiki::ListIterator;
   547     $this->{eachGroupMember}->{$group} = $members;
   548     return new TWiki::ListIterator( $this->{eachGroupMember}->{$group} );
   549 }
   550 
   551 
   552 =begin twiki
   553 
   554 ---++ ObjectMethod isGroup ($user) -> boolean
   555 TODO: what is $user - wikiname, UID ??
   556 Called from TWiki::Users. See the documentation of the corresponding
   557 method in that module for details.
   558 
   559 =cut
   560 
   561 sub isGroup {
   562     my ($this, $user) = @_;
   563 
   564     # Groups have the same username as wikiname as canonical name
   565     return 1 if $user eq $TWiki::cfg{SuperAdminGroup};
   566 
   567     return $user =~ /Group$/;
   568 }
   569 
   570 =begin twiki
   571 
   572 ---++ ObjectMethod eachGroup () -> ListIterator of groupnames
   573 
   574 Called from TWiki::Users. See the documentation of the corresponding
   575 method in that module for details.
   576 
   577 =cut
   578 
   579 sub eachGroup {
   580     my ( $this ) = @_;
   581     _getListOfGroups( $this );
   582     require TWiki::ListIterator;
   583     return new TWiki::ListIterator( \@{$this->{groupsList}} );
   584 }
   585 
   586 
   587 =begin twiki
   588 
   589 ---++ ObjectMethod eachMembership ($cUID) -> ListIterator of groups this user is in
   590 
   591 Called from TWiki::Users. See the documentation of the corresponding
   592 method in that module for details.
   593 
   594 =cut
   595 
   596 sub eachMembership {
   597     my ($this, $user) = @_;
   598     my @groups = ();
   599 
   600     _getListOfGroups( $this );
   601     require TWiki::ListIterator;
   602     my $it = new TWiki::ListIterator( \@{$this->{groupsList}} );
   603     $it->{filter} = sub {
   604         $this->isInGroup($user, $_[0]);
   605     };
   606     return $it;
   607 }
   608 
   609 =begin twiki
   610 
   611 ---++ ObjectMethod isAdmin( $user ) -> $boolean
   612 
   613 True if the user is an admin
   614    * is $TWiki::cfg{SuperAdminGroup}
   615    * is a member of the $TWiki::cfg{SuperAdminGroup}
   616 
   617 =cut
   618 
   619 sub isAdmin {
   620     my( $this, $user ) = @_;
   621     my $isAdmin = 0;
   622 	$this->ASSERT_IS_CANONICAL_USER_ID($user) if DEBUG;
   623 #TODO: this might not apply now that we have BaseUserMapping - test
   624     if ($user eq $TWiki::cfg{SuperAdminGroup}) {
   625         $isAdmin = 1;
   626     } else {
   627         my $sag = $TWiki::cfg{SuperAdminGroup};
   628         $isAdmin = $this->isInGroup( $user, $sag );
   629     }
   630 
   631     return $isAdmin;
   632 }
   633 
   634 
   635 =begin twiki
   636 
   637 ---++ ObjectMethod isInGroup ($user, $group, $scanning) -> bool
   638 
   639 Called from TWiki::Users. See the documentation of the corresponding
   640 method in that module for details.
   641 
   642 =cut
   643 
   644 sub isInGroup {
   645     my( $this, $user, $group, $scanning ) = @_;
   646     ASSERT($user) if DEBUG;
   647 
   648     my @users;
   649     my $it = $this->eachGroupMember($group);
   650     while ($it->hasNext()) {
   651         my $u = $it->next();
   652         next if $scanning->{$u};
   653         $scanning->{$u} = 1;
   654         return 1 if $u eq $user;
   655         if( $this->isGroup($u) ) {
   656             return 1 if $this->isInGroup( $user, $u, $scanning);
   657         }
   658     }
   659     return 0;
   660 }
   661 
   662 =begin twiki
   663 
   664 ---++ ObjectMethod findUserByEmail( $email ) -> \@users
   665    * =$email= - email address to look up
   666 Return a list of canonical user names for the users that have this email
   667 registered with the password manager or the user mapping manager.
   668 
   669 The password manager is asked first for whether it maps emails.
   670 If it doesn't, then the user mapping manager is asked instead.
   671 
   672 =cut
   673 
   674 sub findUserByEmail {
   675     my( $this, $email ) = @_;
   676     ASSERT($email) if DEBUG;
   677     my @users;
   678     if( $this->{passwords}->isManagingEmails()) {
   679         my $logins = $this->{passwords}->findLoginByEmail( $email );
   680         if (defined $logins) {
   681             foreach my $l ( @$logins ) {
   682                 $l = $this->getLoginName( $l );
   683                 push( @users, $l ) if $l;
   684             }
   685         }
   686     } else {
   687         # if the password manager didn't want to provide the service, ask
   688         # the user mapping manager
   689         unless( $this->{_MAP_OF_EMAILS} ) {
   690             $this->{_MAP_OF_EMAILS} = {};
   691             my $it = $this->eachUser();
   692             while( $it->hasNext() ) {
   693                 my $uo = $it->next();
   694                 map { push( @{$this->{_MAP_OF_EMAILS}->{$_}}, $uo); }
   695                   $this->getEmails( $uo );
   696             }
   697         }
   698         push( @users, $this->{_MAP_OF_EMAILS}->{$email});
   699     }
   700     return \@users;
   701 }
   702 
   703 =begin twiki
   704 
   705 ---++ ObjectMethod getEmails($user) -> @emailAddress
   706 
   707 If this is a user, return their email addresses. If it is a group,
   708 return the addresses of everyone in the group.
   709 
   710 The password manager and user mapping manager are both consulted for emails
   711 for each user (where they are actually found is implementation defined).
   712 
   713 Duplicates are removed from the list.
   714 
   715 =cut
   716 
   717 sub getEmails {
   718     my( $this, $user ) = @_;
   719 	$this->ASSERT_IS_CANONICAL_USER_ID($user) if DEBUG;
   720 
   721     my %emails;
   722     if ( $this->isGroup($user) ) {
   723         my $it = $this->eachGroupMember( $user );
   724         while( $it->hasNext() ) {
   725             foreach ($this->getEmails( $it->next())) {
   726                 $emails{$_} = 1;
   727             }
   728         }
   729     } else {
   730         if ($this->{passwords}->isManagingEmails()) {
   731             # get emails from the password manager
   732             foreach ($this->{passwords}->getEmails( $this->getLoginName( $user ))) {
   733                 $emails{$_} = 1;
   734             }
   735         } else {
   736             # And any on offer from the user mapping manager
   737             foreach (mapper_getEmails( $this->{session}, $user )) {
   738                 $emails{$_} = 1;
   739             }
   740         }
   741     }
   742 
   743     return keys %emails;
   744 }
   745 
   746 =begin twiki
   747 
   748 ---++ ObjectMethod setEmails($user, @emails) -> boolean
   749 
   750 Set the email address(es) for the given user.
   751 The password manager is tried first, and if it doesn't want to know the
   752 user mapping manager is tried.
   753 
   754 =cut
   755 
   756 sub setEmails {
   757     my $this = shift;
   758     my $user = shift;
   759 	$this->ASSERT_IS_CANONICAL_USER_ID($user) if DEBUG;
   760 
   761     if( $this->{passwords}->isManagingEmails()) {
   762         $this->{passwords}->setEmails( $this->getLoginName( $user ), @_ );
   763     } else {
   764         mapper_setEmails( $this->{session}, $user, @_ );
   765     }
   766 }
   767 
   768 
   769 =begin twiki
   770 
   771 ---++ StaticMethod mapper_getEmails($session, $user)
   772 
   773 Only used if passwordManager->isManagingEmails= = =false
   774 (The emails are stored in the user topics.
   775 
   776 Note: This method is PUBLIC because it is used by the tools/upgrade_emails.pl
   777 script, which needs to kick down to the mapper to retrieve email addresses
   778 from TWiki topics.
   779 
   780 =cut
   781 
   782 sub mapper_getEmails {
   783     my( $session, $user ) = @_;
   784 
   785     my ($meta, $text) =
   786       $session->{store}->readTopic(
   787           undef, $TWiki::cfg{UsersWebName},
   788           $session->{users}->getWikiName($user) );
   789 
   790     my @addresses;
   791 
   792     # Try the form first
   793     my $entry = $meta->get('FIELD', 'Email');
   794     if ($entry) {
   795         push( @addresses, split( /;/, $entry->{value} ) );
   796     } else {
   797         # Now try the topic text
   798         foreach my $l (split ( /\r?\n/, $text  )) {
   799             if ($l =~ /^\s+\*\s+E-?mail:\s*(.*)$/mi) {
   800                 push @addresses, split( /;/, $1 );
   801             }
   802         }
   803     }
   804 
   805     return @addresses;
   806 }
   807 
   808 =begin twiki
   809 
   810 ---++ StaticMethod mapper_setEmails ($session, $user, @emails)
   811 
   812 Only used if =passwordManager->isManagingEmails= = =false=.
   813 (emails are stored in user topics
   814 
   815 =cut
   816 
   817 sub mapper_setEmails {
   818     my $session = shift;
   819     my $cUID = shift;
   820 
   821     my $mails = join( ';', @_ );
   822 
   823     my $user = $session->{users}->getWikiName( $cUID );
   824 
   825     my ($meta, $text) =
   826       $session->{store}->readTopic(
   827           undef, $TWiki::cfg{UsersWebName},
   828           $user);
   829 
   830     if ($meta->get('FORM')) {
   831         # use the form if there is one
   832         $meta->putKeyed( 'FIELD',
   833                          { name => 'Email',
   834                            value => $mails,
   835                            title => 'Email',
   836                            attributes=> 'h' } );
   837     } else {
   838         # otherwise use the topic text
   839         unless( $text =~ s/^(\s+\*\s+E-?mail:\s*).*$/$1$mails/mi ) {
   840             $text .= "\n   * Email: $mails\n";
   841         }
   842     }
   843 
   844     $session->{store}->saveTopic(
   845         $cUID, $TWiki::cfg{UsersWebName}, $user, $text, $meta );
   846 }
   847 
   848 
   849 =begin twiki
   850 
   851 ---++ ObjectMethod findUserByWikiName ($wikiname) -> list of cUIDs associated with that wikiname
   852 
   853 Called from TWiki::Users. See the documentation of the corresponding
   854 method in that module for details. The $skipExistanceCheck parameter
   855 is private to this module, and blocks the standard existence check
   856 to avoid reading .htpasswd when checking group memberships).
   857 
   858 =cut
   859 
   860 sub findUserByWikiName {
   861     my( $this, $wn, $skipExistanceCheck ) = @_;
   862     my @users = ();
   863 
   864     if( $this->isGroup( $wn )) {
   865         push( @users, $wn);
   866     } elsif( $TWiki::cfg{Register}{AllowLoginName} ) {
   867         # Add additional mappings defined in TWikiUsers
   868         _loadMapping( $this );
   869         if( $this->{W2U}->{$wn} ) {
   870             push( @users, $this->{W2U}->{$wn} );
   871         } else {
   872             # Bloody compatibility!
   873             # The wikiname is always a registered user for the purposes of this
   874             # mapping. We have to do this because TWiki defines access controls
   875             # in terms of mapped users, and if a wikiname is *missing* from the
   876             # mapping there is "no such user".
   877             push( @users, getCanonicalUserID( $this, $wn ));
   878         }
   879     } else {
   880         # The wikiname is also the login name, so we can just convert
   881         # it directly to a cUID
   882         my $cUID = getCanonicalUserID( $this, $wn );
   883         if( $skipExistanceCheck || ($cUID && $this->userExists( $cUID )) ) {
   884             push( @users, getCanonicalUserID( $this, $wn ));
   885         }
   886     }
   887     return \@users;
   888 }
   889 
   890 =begin twiki
   891 
   892 ---++ ObjectMethod checkPassword( $userName, $passwordU ) -> $boolean
   893 
   894 Finds if the password is valid for the given user.
   895 
   896 Returns 1 on success, undef on failure.
   897 
   898 =cut
   899 
   900 sub checkPassword {
   901     my( $this, $userName, $pw ) = @_;
   902 	$this->ASSERT_IS_USER_LOGIN_ID($userName) if DEBUG;
   903     return $this->{passwords}->checkPassword(
   904         $userName, $pw);
   905 }
   906 
   907 =begin twiki
   908 
   909 ---++ ObjectMethod setPassword( $user, $newPassU, $oldPassU ) -> $boolean
   910 
   911 If the $oldPassU matches matches the user's password, then it will
   912 replace it with $newPassU.
   913 
   914 If $oldPassU is not correct and not 1, will return 0.
   915 
   916 If $oldPassU is 1, will force the change irrespective of
   917 the existing password, adding the user if necessary.
   918 
   919 Otherwise returns 1 on success, undef on failure.
   920 
   921 =cut
   922 
   923 sub setPassword {
   924     my( $this, $user, $newPassU, $oldPassU ) = @_;
   925 	$this->ASSERT_IS_CANONICAL_USER_ID($user) if DEBUG;
   926     return $this->{passwords}->setPassword(
   927         $this->getLoginName( $user ), $newPassU, $oldPassU);
   928 }
   929 
   930 =begin twiki
   931 
   932 ---++ ObjectMethod passwordError( ) -> $string
   933 
   934 returns a string indicating the error that happened in the password handlers
   935 TODO: these delayed error's should be replaced with Exceptions.
   936 
   937 returns undef if no error
   938 
   939 =cut
   940 
   941 sub passwordError {
   942     my( $this ) = @_;
   943     return $this->{passwords}->error();
   944 }
   945 
   946 =begin twiki
   947 
   948 ---++ ObjectMethod ASSERT_IS_CANONICAL_USER_ID( $user_id ) -> $boolean
   949 
   950 used for debugging to ensure we are actually passing a canonical_id
   951 
   952 =cut
   953 
   954 sub ASSERT_IS_CANONICAL_USER_ID {
   955     # NOP because there is no mapping_id
   956 }
   957 
   958 =begin twiki
   959 
   960 ---++ ObjectMethod _cacheUser ($wikiname, $login) => cUID
   961 
   962 # PRIVATE
   963 
   964 TODO: and probably flawed in light of multiple cUIDs mapping to one wikiname
   965 
   966 =cut
   967 
   968 
   969 sub _cacheUser {
   970     my($this, $wikiname, $login) = @_;
   971     ASSERT($wikiname) if DEBUG;
   972 
   973     $login ||= $wikiname;
   974 
   975     my $cUID = getCanonicalUserID( $this, $login, 1 );
   976     return unless ($cUID);
   977     ASSERT($cUID) if DEBUG;
   978 
   979     #$this->{U2L}->{$cUID}     = $login;
   980     $this->{U2W}->{$cUID}     = $wikiname;
   981     $this->{L2U}->{$login}    = $cUID;
   982     $this->{W2U}->{$wikiname} = $cUID;
   983 
   984     return $cUID;
   985 }
   986 
   987 
   988 =begin twiki
   989 
   990 ---++ ClassMethod _collateGroups ($ref, $group)
   991 
   992 PRIVATE callback for search function to collate results
   993 
   994 =cut
   995 
   996 sub _collateGroups {
   997     my $ref = shift;
   998     my $group = shift;
   999     return unless $group;
  1000     push (@{$ref->{list}}, $group);
  1001 }
  1002 
  1003 
  1004 =begin twiki
  1005 
  1006 ---++ ObjectMethod _getListOfGroups ()
  1007 
  1008 PRIVATE get a list of groups defined in this TWiki
  1009 
  1010 =cut
  1011 
  1012 sub _getListOfGroups {
  1013     my $this = shift;
  1014     ASSERT(ref($this) eq 'TWiki::Users::TWikiUserMapping') if DEBUG;
  1015 
  1016     unless( $this->{groupsList} ) {
  1017         my $users = $this->{session}->{users};
  1018         $this->{groupsList} = [];
  1019 
  1020         $this->{session}->search->searchWeb
  1021           (
  1022               _callback     => \&_collateGroups,
  1023               _cbdata       =>  { list => $this->{groupsList},
  1024                                   users => $users },
  1025               inline        => 1,
  1026               search        => "Set GROUP =",
  1027               web           => $TWiki::cfg{UsersWebName},
  1028               topic         => "*Group",
  1029               type          => 'regex',
  1030               nosummary     => 'on',
  1031               nosearch      => 'on',
  1032               noheader      => 'on',
  1033               nototal       => 'on',
  1034               noempty       => 'on',
  1035               format	     => '$topic',
  1036               separator     => '',
  1037              );
  1038     }
  1039     return $this->{groupsList};
  1040 }
  1041 
  1042 =begin twiki
  1043 
  1044 ---++ ClassMethod _loadMapping ($session, $impl)
  1045 Build hash to translate between username (e.g. jsmith)
  1046 and WikiName (e.g. Main.JaneSmith).
  1047 PRIVATE subclasses should *not* implement this.
  1048 
  1049 
  1050 =cut
  1051 
  1052 sub _loadMapping {
  1053     my $this = shift;
  1054     return if $this->{CACHED};
  1055     $this->{CACHED} = 1;
  1056 
  1057     #TODO: should only really do this mapping IF the user is in the password file.
  1058     #       except if we can't 'fetchUsers' like in the Passord='none' case - 
  1059     #       in which case the only time we
  1060     #       know a login is real, is when they are logged in :(
  1061     if (($TWiki::cfg{Register}{AllowLoginName}) ||
  1062         (!$this->{passwords}->canFetchUsers())
  1063         ) {
  1064         my $store = $this->{session}->{store};
  1065         if( $store->topicExists($TWiki::cfg{UsersWebName},
  1066                                 $TWiki::cfg{UsersTopicName} )) {
  1067             my $text = $store->readTopicRaw( undef,
  1068                                           $TWiki::cfg{UsersWebName},
  1069                                           $TWiki::cfg{UsersTopicName},
  1070                                           undef );
  1071             # Get the WikiNames and userids, and build hashes in both directions
  1072             # This matches:
  1073             #   * TWikiGuest - guest - 10 Mar 2005
  1074             #   * TWikiGuest - 10 Mar 2005
  1075             $text =~ s/^\s*\* (?:$TWiki::regex{webNameRegex}\.)?($TWiki::regex{wikiWordRegex})\s*(?:-\s*(\S+)\s*)?-.*$/(_cacheUser( $this, $1, $2)||'')/gome;
  1076         }
  1077     } else {
  1078         #loginnames _are_ WikiNames so ask the Password handler for list of users
  1079         my $iter = $this->{passwords}->fetchUsers();
  1080         while ($iter->hasNext()) {
  1081             my $login = $iter->next();
  1082             _cacheUser($this, $login, $login);
  1083         }
  1084     }
  1085 }
  1086 
  1087 
  1088 =begin twiki
  1089 
  1090 ---++ ObjectMethod _expandUserList ($names )
  1091 
  1092 Get a list of *canonical user ids* from a text string containing a
  1093 list of user *wiki* names and *group ids*.
  1094 
  1095 =cut
  1096 
  1097 sub _expandUserList {
  1098     my( $this, $names ) = @_;
  1099 
  1100     $names ||= '';
  1101     # comma delimited list of users or groups
  1102     # i.e.: "%MAINWEB%.UserA, UserB, Main.UserC # something else"
  1103     $names =~ s/(<[^>]*>)//go;     # Remove HTML tags
  1104 
  1105     my @l;
  1106     foreach my $ident ( split( /[\,\s]+/, $names )) {
  1107         $ident =~ s/^.*\.//;       # Dump the web specifier
  1108         next unless $ident;
  1109         if( $this->isGroup( $ident )) {
  1110             my $it = $this->eachGroupMember( $ident );
  1111             while( $it->hasNext() ) {
  1112                 push( @l, $it->next() );
  1113             }
  1114         } else {
  1115 	        my @list = @{$this->{session}->{users}->findUserByWikiName( $ident, 1 )};
  1116             push( @l, @list );
  1117         }
  1118     }
  1119     return \@l;
  1120 }
  1121 
  1122 1;