lib/TWiki/Users/BaseUserMapping.pm
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     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::BaseUserMapping
       
    23 
       
    24 User mapping is the process by which TWiki maps from a username (a login name)
       
    25 to a display name and back. It is also where groups are maintained.
       
    26 
       
    27 The BaseMapper provides support for a small number of predefined users.
       
    28 No registration - this is a read only usermapper. It uses the mapper
       
    29 prefix 'BaseUserMapping_'.
       
    30 
       
    31 ---++ Users
       
    32    * TWikiAdmin - uses the password that was set in Configure (IF its not null)
       
    33    * TWikiGuest
       
    34    * UnknownUser
       
    35    * TWikiContributor - 1 Jan 2005
       
    36    * TWikiRegistrationAgent - 1 Jan 2005
       
    37 
       
    38 ---+++ Groups
       
    39    * $TWiki::cfg{SuperAdminGroup}
       
    40    * TWikiBaseGroup
       
    41 
       
    42 =cut
       
    43 
       
    44 package TWiki::Users::BaseUserMapping;
       
    45 use base 'TWiki::UserMapping';
       
    46 
       
    47 use strict;
       
    48 use Assert;
       
    49 use Error;
       
    50 
       
    51 =begin twiki
       
    52 
       
    53 ---++ ClassMethod new ($session)
       
    54 
       
    55 Construct the BaseUserMapping object
       
    56 
       
    57 =cut
       
    58 
       
    59 # Constructs a new user mapping handler of this type, referring to $session
       
    60 # for any required TWiki services.
       
    61 sub new {
       
    62     my( $class, $session ) = @_;
       
    63 
       
    64     my $this = $class->SUPER::new($session, 'BaseUserMapping_');
       
    65 
       
    66     # set up our users
       
    67     $this->{L2U} = {
       
    68 		$TWiki::cfg{AdminUserLogin}=>$this->{mapping_id}.'333', 
       
    69 		$TWiki::cfg{DefaultUserLogin}=>$this->{mapping_id}.'666', 
       
    70 		unknown=>$this->{mapping_id}.'999',
       
    71 		TWikiContributor=>$this->{mapping_id}.'111',
       
    72 		TWikiRegistrationAgent=>$this->{mapping_id}.'222'
       
    73 	};
       
    74     $this->{U2L} = {
       
    75 		$this->{mapping_id}.'333'=>$TWiki::cfg{AdminUserLogin}, 
       
    76 		$this->{mapping_id}.'666'=>$TWiki::cfg{DefaultUserLogin}, 
       
    77 		$this->{mapping_id}.'999'=>'unknown',
       
    78 		$this->{mapping_id}.'111'=>'TWikiContributor',
       
    79 		$this->{mapping_id}.'222'=>'TWikiRegistrationAgent'
       
    80 	};
       
    81     $this->{U2W} = {
       
    82 		$this->{mapping_id}.'333'=>$TWiki::cfg{AdminUserWikiName}, 
       
    83 		$this->{mapping_id}.'666'=>$TWiki::cfg{DefaultUserWikiName}, 
       
    84 		$this->{mapping_id}.'999'=>'UnknownUser',
       
    85 		$this->{mapping_id}.'111'=>'TWikiContributor',
       
    86 		$this->{mapping_id}.'222'=>'TWikiRegistrationAgent'
       
    87 	};
       
    88     $this->{W2U} = {
       
    89 		$TWiki::cfg{AdminUserWikiName}=>$this->{mapping_id}.'333', 
       
    90 		$TWiki::cfg{DefaultUserWikiName}=>$this->{mapping_id}.'666', 
       
    91 		UnknownUser=>$this->{mapping_id}.'999',
       
    92 		TWikiContributor=>$this->{mapping_id}.'111',
       
    93 		TWikiRegistrationAgent=>$this->{mapping_id}.'222'
       
    94 	};
       
    95     $this->{U2E} = {$this->{mapping_id}.'333'=>$TWiki::cfg{WebMasterEmail}};
       
    96     $this->{U2P} = {$this->{mapping_id}.'333'=>$TWiki::cfg{Password}};
       
    97 
       
    98     $this->{GROUPS} = {
       
    99 		$TWiki::cfg{SuperAdminGroup} => [$this->{mapping_id}.'333'],
       
   100 		TWikiBaseGroup => [$this->{mapping_id}.'333',
       
   101                            $this->{mapping_id}.'666',
       
   102                            $this->{mapping_id}.'999',
       
   103                            $this->{mapping_id}.'111',
       
   104                            $this->{mapping_id}.'222'],
       
   105     };
       
   106 
       
   107     return $this;
       
   108 }
       
   109 
       
   110 =begin twiki
       
   111 
       
   112 ---++ ObjectMethod finish()
       
   113 Break circular references.
       
   114 
       
   115 =cut
       
   116 
       
   117 # Note to developers; please undef *all* fields in the object explicitly,
       
   118 # whether they are references or not. That way this method is "golden
       
   119 # documentation" of the live fields in the object.
       
   120 sub finish {
       
   121     my $this = shift;
       
   122     undef $this->{U2L};
       
   123     undef $this->{U2W};
       
   124     undef $this->{U2P};
       
   125     undef $this->{U2E};
       
   126     undef $this->{L2U};
       
   127     undef $this->{W2U};
       
   128     undef $this->{GROUPS};
       
   129     $this->SUPER::finish();
       
   130 }
       
   131 
       
   132 =begin twiki
       
   133 
       
   134 ---++ ObjectMethod loginTemplateName () -> templateFile
       
   135 
       
   136 allows UserMappings to come with customised login screens - that should preffereably only over-ride the UI function
       
   137 
       
   138 =cut
       
   139 
       
   140 sub loginTemplateName {
       
   141     return 'login.sudo';
       
   142 }
       
   143 
       
   144 
       
   145 
       
   146 =begin twiki
       
   147 
       
   148 ---++ ObjectMethod handlesUser ( $cUID, $login, $wikiname) -> $boolean
       
   149 
       
   150 Called by the TWiki::User object to determine which loaded mapping to use
       
   151 for a given user (must be fast). In the BaseUserMapping case, we know all
       
   152 the details of the users we specialise in.
       
   153 
       
   154 =cut
       
   155 
       
   156 sub handlesUser {
       
   157 	my ($this, $cUID, $login, $wikiname) = @_;
       
   158 	
       
   159 	return 1 if (defined($cUID) && defined($this->{U2L}{$cUID}));
       
   160 	return 1 if (defined($login) && defined($this->{L2U}{$login}));
       
   161 	return 1 if (defined($wikiname) && defined($this->{W2U}{$wikiname}));
       
   162 
       
   163 	return 0;
       
   164 }
       
   165 
       
   166 
       
   167 =begin twiki
       
   168 
       
   169 ---++ ObjectMethod getCanonicalUserID ($login) -> cUID
       
   170 
       
   171 Convert a login name to the corresponding canonical user name. The
       
   172 canonical name can be any string of 7-bit alphanumeric and underscore
       
   173 characters, and must correspond 1:1 to the login name.
       
   174 (undef on failure)
       
   175 
       
   176 =cut
       
   177 
       
   178 sub getCanonicalUserID {
       
   179     my( $this, $login ) = @_;
       
   180 
       
   181     my $cUID;
       
   182     $this->ASSERT_IS_USER_LOGIN_ID($login) if DEBUG;
       
   183     $cUID = $this->{L2U}{$login};
       
   184 
       
   185     #alternative impl - slower, but more re-useable
       
   186     #my @list = findUserByWikiName($this, $login);
       
   187     #$cUID = shift @list;
       
   188 
       
   189     return $cUID;
       
   190 }
       
   191 
       
   192 
       
   193 =begin twiki
       
   194 
       
   195 ---++ ObjectMethod getLoginName ($cUID) -> login
       
   196 
       
   197 converts an internal cUID to that user's login
       
   198 (undef on failure)
       
   199 
       
   200 =cut
       
   201 
       
   202 sub getLoginName {
       
   203     my( $this, $user ) = @_;
       
   204     ASSERT($user) if DEBUG;
       
   205 
       
   206     #print STDERR "getCanonicalUserID($user) = $this->{U2L}->{$user}\n";
       
   207 
       
   208     return $this->{U2L}{$user};
       
   209 }
       
   210 
       
   211 =begin twiki
       
   212 
       
   213 ---++ ObjectMethod getWikiName ($cUID) -> wikiname
       
   214 
       
   215 # Map a canonical user name to a wikiname
       
   216 
       
   217 =cut
       
   218 
       
   219 sub getWikiName {
       
   220     my ($this, $cUID) = @_;
       
   221     
       
   222     return $this->{U2W}->{$cUID} || getLoginName( $this, $cUID );
       
   223 }
       
   224 
       
   225 =begin twiki
       
   226 
       
   227 ---++ ObjectMethod userExists( $user ) -> $boolean
       
   228 
       
   229 Determine if the user already exists or not.
       
   230 
       
   231 =cut
       
   232 
       
   233 sub userExists {
       
   234     my( $this, $cUID ) = @_;
       
   235 	$this->ASSERT_IS_CANONICAL_USER_ID($cUID) if DEBUG;
       
   236 
       
   237     return $this->{U2L}{$cUID};
       
   238 }
       
   239 
       
   240 =begin twiki
       
   241 
       
   242 ---++ ObjectMethod eachUser () -> listIterator of cUIDs
       
   243 
       
   244 Called from TWiki::Users. See the documentation of the corresponding
       
   245 method in that module for details.
       
   246 
       
   247 =cut
       
   248 
       
   249 sub eachUser {
       
   250     my( $this ) = @_;
       
   251 
       
   252     my @list = keys(%{$this->{U2W}});
       
   253     require TWiki::ListIterator;
       
   254     return new TWiki::ListIterator( \@list );
       
   255 }
       
   256 
       
   257 
       
   258 =begin twiki
       
   259 
       
   260 ---++ ObjectMethod eachGroupMember ($group) ->  listIterator of cUIDs
       
   261 
       
   262 Called from TWiki::Users. See the documentation of the corresponding
       
   263 method in that module for details.
       
   264 
       
   265 The basemapper implementation assumes that there are no nested groups in the
       
   266 basemapper.
       
   267 
       
   268 =cut
       
   269 
       
   270 sub eachGroupMember {
       
   271     my $this = shift;
       
   272     my $group = shift;
       
   273 
       
   274     my $members = $this->{GROUPS}{$group};
       
   275 #print STDERR "eachGroupMember($group): ".join(',', @{$members});
       
   276 
       
   277     require TWiki::ListIterator;
       
   278     return new TWiki::ListIterator( $members );
       
   279 }
       
   280 
       
   281 
       
   282 =begin twiki
       
   283 
       
   284 ---++ ObjectMethod isGroup ($user) -> boolean
       
   285 TODO: what is $user - wikiname, UID ??
       
   286 Called from TWiki::Users. See the documentation of the corresponding
       
   287 method in that module for details.
       
   288 
       
   289 =cut
       
   290 
       
   291 sub isGroup {
       
   292     my ($this, $user) = @_;
       
   293 #TODO: what happens to the code if we implement this using an iterator too?
       
   294     return grep(/$user/, $this->eachGroup());
       
   295 }
       
   296 
       
   297 
       
   298 =begin twiki
       
   299 
       
   300 ---++ ObjectMethod eachGroup () -> ListIterator of groupnames
       
   301 
       
   302 Called from TWiki::Users. See the documentation of the corresponding
       
   303 method in that module for details.
       
   304 
       
   305 =cut
       
   306 
       
   307 sub eachGroup {
       
   308     my ( $this ) = @_;
       
   309     my @groups = keys(%{$this->{GROUPS}});
       
   310 
       
   311     require TWiki::ListIterator;
       
   312     return new TWiki::ListIterator( \@groups );
       
   313 }
       
   314 
       
   315 
       
   316 =begin twiki
       
   317 
       
   318 ---++ ObjectMethod eachMembership ($cUID) -> ListIterator of groups this user is in
       
   319 
       
   320 Called from TWiki::Users. See the documentation of the corresponding
       
   321 method in that module for details.
       
   322 
       
   323 =cut
       
   324 
       
   325 sub eachMembership {
       
   326     my ($this, $cUID) = @_;
       
   327     ASSERT($cUID) if DEBUG;
       
   328 
       
   329     my $it = $this->eachGroup();
       
   330     $it->{filter} = sub {
       
   331         $this->isInGroup($cUID, $_[0]);
       
   332     };
       
   333     return $it;
       
   334 }
       
   335 
       
   336 =begin twiki
       
   337 
       
   338 ---++ ObjectMethod isAdmin( $cUID ) -> $boolean
       
   339 
       
   340 True if the user is an admin
       
   341    * is a member of the $TWiki::cfg{SuperAdminGroup}
       
   342 
       
   343 =cut
       
   344 
       
   345 sub isAdmin {
       
   346     my( $this, $cUID ) = @_;
       
   347     my $isAdmin = 0;
       
   348 	$this->ASSERT_IS_CANONICAL_USER_ID($cUID) if DEBUG;
       
   349 
       
   350     my $sag = $TWiki::cfg{SuperAdminGroup};
       
   351     $isAdmin = $this->isInGroup( $cUID, $sag );
       
   352 
       
   353     return $isAdmin;
       
   354 }
       
   355 
       
   356 
       
   357 =begin twiki
       
   358 
       
   359 ---++ ObjectMethod isInGroup ($user, $group, $scanning) -> bool
       
   360 
       
   361 Called from TWiki::Users. See the documentation of the corresponding
       
   362 method in that module for details.
       
   363 
       
   364 =cut
       
   365 
       
   366 sub isInGroup {
       
   367     my( $this, $user, $group, $scanning ) = @_;
       
   368     ASSERT($user) if DEBUG;
       
   369 
       
   370     my @users;
       
   371     my $it = $this->eachGroupMember($group);
       
   372     while ($it->hasNext()) {
       
   373         my $u = $it->next();
       
   374         next if $scanning->{$u};
       
   375         $scanning->{$u} = 1;
       
   376         return 1 if $u eq $user;
       
   377         if( $this->isGroup($u) ) {
       
   378             return 1 if $this->isInGroup( $user, $u, $scanning);
       
   379         }
       
   380     }
       
   381     return 0;
       
   382 }
       
   383 
       
   384 =begin twiki
       
   385 
       
   386 ---++ ObjectMethod getEmails($user) -> @emailAddress
       
   387 
       
   388 If this is a user, return their email addresses. If it is a group,
       
   389 return the addresses of everyone in the group.
       
   390 
       
   391 =cut
       
   392 
       
   393 sub getEmails {
       
   394     my( $this, $user ) = @_;
       
   395 
       
   396     return $this->{U2E}{$user} || ();
       
   397 }
       
   398 
       
   399 =begin twiki
       
   400 
       
   401 ---++ ObjectMethod findUserByWikiName ($wikiname) -> list of cUIDs associated with that wikiname
       
   402 
       
   403 Called from TWiki::Users. See the documentation of the corresponding
       
   404 method in that module for details.
       
   405 
       
   406 =cut
       
   407 
       
   408 sub findUserByWikiName {
       
   409     my( $this, $wn ) = @_;
       
   410     my @users = ();
       
   411 
       
   412     if( $this->isGroup( $wn )) {
       
   413         push( @users, $wn);
       
   414     } else {
       
   415         # Add additional mappings defined in TWikiUsers
       
   416         if( $this->{W2U}->{$wn} ) {
       
   417             push( @users, $this->{W2U}->{$wn} );
       
   418         } else {
       
   419             # Bloody compatibility!
       
   420             # The wikiname is always a registered user for the purposes of this
       
   421             # mapping. We have to do this because TWiki defines access controls
       
   422             # in terms of mapped users, and if a wikiname is *missing* from the
       
   423             # mapping there is "no such user".
       
   424             push( @users, getCanonicalUserID( $this, $wn ));
       
   425         }
       
   426 #    } else {
       
   427         # The wikiname is also the login name, so we can just convert
       
   428         # it to a canonical user id
       
   429 #        push( @users, getCanonicalUserID( $this, $wn ));
       
   430     }
       
   431     return \@users;
       
   432 }
       
   433 
       
   434 =begin twiki
       
   435 
       
   436 ---++ ObjectMethod checkPassword( $userName, $passwordU ) -> $boolean
       
   437 
       
   438 Finds if the password is valid for the given user.
       
   439 
       
   440 Returns 1 on success, undef on failure.
       
   441 
       
   442 =cut
       
   443 
       
   444 sub checkPassword {
       
   445     my( $this, $login, $pass ) = @_;
       
   446 
       
   447   	$this->ASSERT_IS_USER_LOGIN_ID($login) if DEBUG;
       
   448     my $cUID = getCanonicalUserID( $this, $login );
       
   449     return unless ($cUID);  #user not found
       
   450 
       
   451     my $hash = $this->{U2P}->{$cUID};
       
   452     if ($hash && (crypt($pass, $hash) eq $hash)) {
       
   453         return 1;   #yay, you've passed
       
   454     }
       
   455     #be a little more helpful to the admin
       
   456     if (($cUID eq $this->{mapping_id}.'333') && (!$hash)) {
       
   457         $this->{error} = 'To login as '.$login.', you must set {Password} in configure';
       
   458     }
       
   459     return 0;
       
   460 }
       
   461 
       
   462 =begin twiki
       
   463 
       
   464 ---++ ObjectMethod setPassword( $user, $newPassU, $oldPassU ) -> $boolean
       
   465 
       
   466 If the $oldPassU matches matches the user's password, then it will
       
   467 replace it with $newPassU.
       
   468 
       
   469 If $oldPassU is not correct and not 1, will return 0.
       
   470 
       
   471 If $oldPassU is 1, will force the change irrespective of
       
   472 the existing password, adding the user if necessary.
       
   473 
       
   474 Otherwise returns 1 on success, undef on failure.
       
   475 
       
   476 =cut
       
   477 
       
   478 sub setPassword {
       
   479     my( $this, $user, $newPassU, $oldPassU ) = @_;
       
   480 	$this->ASSERT_IS_CANONICAL_USER_ID($user) if DEBUG;
       
   481     throw Error::Simple(
       
   482           'cannot change user passwords using TWiki::BaseUserMapping');
       
   483 }
       
   484 
       
   485 =begin twiki
       
   486 
       
   487 ---++ ObjectMethod passwordError( ) -> $string
       
   488 
       
   489 returns a string indicating the error that happened in the password handlers
       
   490 TODO: these delayed error's should be replaced with Exceptions.
       
   491 
       
   492 returns undef if no error
       
   493 
       
   494 =cut
       
   495 
       
   496 sub passwordError {
       
   497     my $this = shift;
       
   498 
       
   499     return $this->{error};
       
   500 }
       
   501 
       
   502 1;