lib/TWiki/Users/BaseUserMapping.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::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;