Index: lib/TWiki.cfg
===================================================================
--- lib/TWiki.cfg (revision 9051)
+++ lib/TWiki.cfg (working copy)
@@ -283,6 +283,11 @@
$cfg{AuthRealm} =
'Enter your TWiki.LoginName. (Typically First name and last name, no space, no dots, capitalized, e.g. !JohnSmith, unless you chose otherwise). Visit TWiki.TWikiRegistration if you do not have one.';
+#---++ Access Control
+
+# **TWIKI Access**
+$cfg{AccessControl} = 'TraditionalAccess';
+
#---++ Passwords
# **SELECT none,TWiki::Users::HtPasswdUser,TWiki::Users::ApacheHtpasswdUser**
# Name of the password handler implementation. The password handler manages
Index: lib/TWiki/Access.pm
===================================================================
--- lib/TWiki/Access.pm (revision 9051)
+++ lib/TWiki/Access.pm (working copy)
@@ -41,12 +41,17 @@
sub new {
my ( $class, $session ) = @_;
- my $this = bless( {}, $class );
ASSERT($session->isa( 'TWiki')) if DEBUG;
- $this->{session} = $session;
+ my $imp= 'TWiki::Access::'.$TWiki::cfg{AccessControl};
+ eval ("use $imp");
+ #use TWiki::Access::TraditionalAccess;
+ #my $this = new TWiki::Access::TraditionalAccess($session);
+ my $this = new $imp($session);
+
+# $this->{session} = $session;
+#
+# %{$this->{GROUPS}} = ();
- %{$this->{GROUPS}} = ();
-
return $this;
}
@@ -60,29 +65,9 @@
=cut
sub permissionsSet {
- my( $this, $web ) = @_;
- ASSERT($this->isa( 'TWiki::Access')) if DEBUG;
+ ASSERT(0);
+ }
- my $permSet = 0;
-
- my @types = qw/ALLOW DENY/;
- my @actions = qw/CHANGE VIEW RENAME/;
- my $prefs = $this->{session}->{prefs};
-
- OUT: foreach my $type ( @types ) {
- foreach my $action ( @actions ) {
- my $pref = $type . 'WEB' . $action;
- my $prefValue = $prefs->getWebPreferencesValue( $pref, $web ) || '';
- if( $prefValue =~ /\S/ ) {
- $permSet = 1;
- last OUT;
- }
- }
- }
-
- return $permSet;
-}
-
=pod
---++ ObjectMethod getReason() -> $string
@@ -93,9 +78,7 @@
=cut
sub getReason {
- my $this = shift;
-
- return $this->{failure};
+ ASSERT(0);
}
=pod
@@ -112,98 +95,57 @@
=cut
sub checkAccessPermission {
- my( $this, $mode, $user, $text, $topic, $web ) = @_;
- ASSERT($this->isa( 'TWiki::Access')) if DEBUG;
- ASSERT($user->isa( 'TWiki::User')) if DEBUG;
+ ASSERT(0);
+}
- undef $this->{failure};
+=pod
- #print STDERR "Check $mode access ", $user->stringify()," to $web.",$topic?$topic:'',"\n";
+---++ getACLs( \@modes, $web, $topic ) -> \%acls
+Get the Access Control Lists controlling which registered users *and groups* are allowed to access the topic (web).
+ * =\@modes= - list of access modes you are interested in; e.g. [ "VIEW","CHANGE" ]
+ * =$web= - the web
+ * =$topic= - if =undef= then the setting is taken as a web setting e.g. WEBVIEW. Otherwise it is taken as a topic setting e.g. TOPICCHANGE
- # super admin is always allowed
- if( $user->isAdmin() ) {
- #print STDERR $user->stringify() . " - ADMIN\n";
- return 1;
+=\%acls= is a hash indexed by *user name* (web.wikiname). This maps to a hash indexed by *access mode* e.g. =VIEW=, =CHANGE= etc. This in turn maps to a boolean; 0 for access denied, non-zero for access permitted.
+
+my $acls = $session->{security}->getACLs( [ 'VIEW', 'CHANGE', 'RENAME' ], $web, $topic );
+foreach my $user ( keys %$acls ) {
+ if( $acls->{$user}->{VIEW} ) {
+ print STDERR "$user can view $web.$topic\n";
}
+}
+
+The =\%acls= object may safely be written to e.g. for subsequent use with =setACLs=.
- $mode = uc( $mode ); # upper case
- $web ||= $this->{session}->{webName};
+__Note__ topic ACLs are *not* the final permissions used to control access to a topic. Web level restrictions may apply that prevent certain access modes for individual topics.
- my $prefs = $this->{session}->{prefs};
+=cut
- my $allowText;
- my $denyText;
+sub getACLs {
+ ASSERT(0);
+}
- # extract the * Set (ALLOWTOPIC|DENYTOPIC)$mode
- if( $text ) {
- # override topic permissions. Note: ignores embedded metadata
- # SMELL: this is horrible! But it's inevitable given the dreadful
- # business of storing access controls embedded in topic text.
- $allowText = $prefs->getTextPreferencesValue( 'ALLOWTOPIC'.$mode,
- $text, $web, $topic );
- $denyText = $prefs->getTextPreferencesValue( 'DENYTOPIC'.$mode,
- $text, $web, $topic );
- } elsif( $topic ) {
- $allowText = $prefs->getTopicPreferencesValue( 'ALLOWTOPIC'.$mode,
- $web, $topic );
- $denyText = $prefs->getTopicPreferencesValue( 'DENYTOPIC'.$mode,
- $web, $topic );
- }
+=pod
- # Check DENYTOPIC
- if( defined( $denyText )) {
- if( $denyText =~ /\S$/ ) {
- if( $user->isInList( $denyText )) {
- $this->{failure} = $this->{session}->{i18n}->maketext('access denied on topic');
- #print STDERR $this->{failure},"\n";
- return 0;
- }
- } else {
- # If DENYTOPIC is empty, don't deny _anyone_
- #print STDERR "DENYTOPIC is empty\n";
- return 1;
- }
- }
+---++ setACLs( \@modes, $web, $topic, \%acls, $nosearchall )
+Set the access controls on the named topic.
+ * =\@modes= - list of access modes you want to set; e.g. [ "VIEW","CHANGE" ]
+ * =$web= - the web
+ * =$topic= - if =undef=, then this is the ACL for the web. otherwise it's for the topic.
+ * =\%acls= - must be a hash indexed by *user object*. This maps to a hash indexed by *access mode* e.g. =VIEW=, =CHANGE= etc. This in turn maps to a boolean value; 1 for allowed, and 0 for denied. See =getACLs= for an example of this kind of object.
- # Check ALLOWTOPIC. If this is defined the user _must_ be in it
- if( defined( $allowText ) && $allowText =~ /\S/ ) {
- if( $user->isInList( $allowText )) {
- #print STDERR "in ALLOWTOPIC\n";
- return 1;
- }
- $this->{failure} = $this->{session}->{i18n}->maketext('access not allowed on topic');
- #print STDERR $this->{failure},"\n";
- return 0;
- }
+Access modes used in \%acls that do not appear in \@modes are simply ignored.
- # Check DENYWEB, but only if DENYTOPIC is not set (even if it
- # is empty - empty means "don't deny anybody")
- unless( defined( $denyText )) {
- $denyText =
- $prefs->getWebPreferencesValue( 'DENYWEB'.$mode, $web );
- if( defined( $denyText ) && $user->isInList( $denyText )) {
- $this->{failure} = $this->{session}->{i18n}->maketext('access denied on web');
- #print STDERR $this->{failure},"\n";
- return 0;
- }
- }
+If you are setting the ACL for a web, and at least one user is denied VIEW access to that
+web, then NOSEARCHALL in the web will automatically be set to =on=.
- # Check ALLOWWEB. If this is defined and not overridden by
- # ALLOWTOPIC, the user _must_ be in it.
- $allowText = $prefs->getWebPreferencesValue( 'ALLOWWEB'.$mode, $web );
+If there are any errors, then an =Error::Simple= will be thrown.
- if( defined( $allowText ) && $allowText =~ /\S/ ) {
- unless( $user->isInList( $allowText )) {
- $this->{failure} = $this->{session}->{i18n}->maketext('access not allowed on web');
- #print STDERR $this->{failure},"\n";
- return 0;
- }
- }
+=cut
- #print STDERR "OK, permitted\n";
- #print STDERR "ALLOW: $allowText\n" if defined $allowText;
- #print STDERR "DENY: $denyText\n" if defined $denyText;
- return 1;
+sub setACLs {
+ ASSERT(0);
}
+
1;
Index: lib/TWiki/Users.pm
===================================================================
--- lib/TWiki/Users.pm (revision 9051)
+++ lib/TWiki/Users.pm (working copy)
@@ -96,7 +96,19 @@
return @{$this->{grouplist}};
}
+=pod
+---++ getListOfGroups() -> \@list
+Get a list of groups. The returned list is a list of TWiki::User objects.
+
+=cut
+sub getListOfGroups {
+ my $this = shift;
+ my @result=$this->getAllGroups();
+ return \@result;
+}
+
+
# Get a list of user objects from a text string containing a
# list of user names. Used by User.pm
sub expandUserList {
@@ -303,4 +315,77 @@
return sort(@list);
}
+=pod
+
+---++ getListOfUsers() -> \@list
+Get a list of the registered users *not* including groups. The returned
+list is a list of TWiki::User objects.
+
+=cut
+sub getListOfUsers {
+ my( $this ) = @_;
+ $this->lookupLoginName('guest'); # load the cache
+
+ unless( $this->{_LIST_OF_REGISTERED_USERS} ) {
+ my @list =
+ grep { $_ }
+ map {
+ my( $w, $t ) = $this->{session}->normalizeWebTopicName(
+ $TWiki::cfg{UsersWebName}, $_);
+ $this->findUser( $t, "$w.$t");
+ } values %{$this->{U2W}};
+ $this->{_LIST_OF_REGISTERED_USERS} = \@list;
+ }
+ return $this->{_LIST_OF_REGISTERED_USERS};
+}
+
+=pod
+
+---++ lookupUser( %spec ) -> \$user
+Find the TWiki::User object for a named user.
+ * =%spec= - the identifying marks of the user. The following options are supported:
+ * =wikiname= - the wikiname of the user (web name optional, also supports %MAINWEB%)
+ * =login= - login name of the user
+ * =email= - email address of the user
+For example,
+
+my $pa = $session->{users}->lookupUser( email => "pa@addams.org" );
+my $ma = $session->{users}->lookupUser( wikiname => "%MAINWEB%.MorticiaAddams" );
+
+
+=cut
+
+sub lookupUser {
+ my( $this,%opts ) = @_;
+ my $user;
+
+ if( $opts{wikiname} ) {
+ if( $user = $this->findUser($opts{wikiname},$opts{wikiname},1)) {
+ return $user;
+ }
+ }
+
+ if( $opts{login} ) {
+ if( $user = $this->findUser($opts{login},$opts{login},1)) {
+ return $user;
+ }
+ }
+
+ if( $opts{email} ) {
+ # SMELL: there is no way in TWiki to map from an email back to a user, so
+ # we have to cheat. We do this as follows:
+ unless( $this->{_MAP_OF_EMAILS} ) {
+ $this->lookupLoginName('guest'); # load the cache
+ foreach my $wn ( keys %{$this->{W2U}} ) {
+ my $ou = $this->findUser( $this->{W2U}{$wn}, $wn, 1 );
+ map { $this->{_MAP_OF_EMAILS}->{$_} = $ou; }
+ $ou->emails();
+ }
+ }
+ return $this->{_MAP_OF_EMAILS}->{$opts{email}};
+ }
+
+ return undef;
+}
+
1;
Index: bin/configure
===================================================================
--- bin/configure (revision 9051)
+++ bin/configure (working copy)
@@ -35,7 +35,7 @@
# ---++ is H3, ---+++ is H4 etc
# Comments of the form
# **TYPE opts**
-# where TYPE is one of URL, PATH, URLPATH, BOOLEAN, STRING, REGEX, SELECT
+# where TYPE is one of URL, PATH, URLPATH, BOOLEAN, STRING, REGEX, SELECT, TWIKI
# are used to indicate that a following cfg var is configurable through
# the interface. All intermediate comments are taken as documentation for
# the value.
@@ -583,6 +583,29 @@
return CGI::Select({ name => $id, size=>1 }, $sopts);
}
+sub _PROMPT_FOR_TWIKI {
+ my( $id, $opts, $value, $keys ) = @_;
+ my @modules;
+ $opts=~ s/\s+//g;
+ foreach my $libDir ( @INC ) {
+
+ print STDERR "$libDir/TWiki/$opts\n";
+ if( opendir( DIR, "$libDir/TWiki/$opts" ) ) {
+ foreach my $file ( grep { /^[A-Za-z0-9_]+Access\.pm$/ }
+ readdir DIR ) {
+ my $module = $file;
+ $module =~ s/\.pm$//;
+ $module =~ /^(.*)$/; # untaint
+ $module = $1;
+ push @modules, $module;
+ }
+ closedir( DIR );
+ }
+ }
+ return _PROMPT_FOR_SELECT($id,join(',',@modules),$value,$keys);
+ #return CGI::textfield( -name => $id, -size=>20,-default=>$value.'-'.$opts );
+}
+
########################################################################
###################### VARIABLE CHECKERS ###############################
########################################################################
@@ -1283,6 +1306,7 @@
foreach $param ( $query->param ) {
next unless $param =~ /^^TYPEOF:(.*)/;
my $type = $query->param( $param );
+ print STDERR "$type\n";
$param =~ s/^TYPEOF:(.*)$/$1/;
my $basevar = $1;
my $var = '$TWiki::cfg'.$basevar;
Index: lib/TWiki/Access/TraditionalAccess.pm
===================================================================
--- lib/TWiki/Access/TraditionalAccess.pm (revision 0)
+++ lib/TWiki/Access/TraditionalAccess.pm (revision 0)
@@ -0,0 +1,280 @@
+# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
+#
+# Copyright (C) 1999-2006 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::Access::TraditionalAccess
+
+Implementation of the traditional, topic setting-based Access check mechanism
+
+=cut
+
+package TWiki::Access::TraditionalAccess;
+
+use TWiki::Access;
+@ISA = qw(TWiki::Access);
+
+use strict;
+use Assert;
+
+sub new {
+ my ( $class, $session ) = @_;
+ my $this = bless( {}, $class );
+ ASSERT($session->isa( 'TWiki')) if DEBUG;
+ $this->{session} = $session;
+
+ %{$this->{GROUPS}} = ();
+
+ return $this;
+}
+
+sub permissionsSet {
+ my( $this, $web ) = @_;
+ ASSERT($this->isa( 'TWiki::Access')) if DEBUG;
+
+ my $permSet = 0;
+
+ my @types = qw/ALLOW DENY/;
+ my @actions = qw/CHANGE VIEW RENAME/;
+ my $prefs = $this->{session}->{prefs};
+
+ OUT: foreach my $type ( @types ) {
+ foreach my $action ( @actions ) {
+ my $pref = $type . 'WEB' . $action;
+ my $prefValue = $prefs->getWebPreferencesValue( $pref, $web ) || '';
+ if( $prefValue =~ /\S/ ) {
+ $permSet = 1;
+ last OUT;
+ }
+ }
+ }
+
+ return $permSet;
+}
+
+sub getReason {
+ my $this = shift;
+
+ return $this->{failure};
+}
+
+sub checkAccessPermission {
+ my( $this, $mode, $user, $text, $topic, $web ) = @_;
+ ASSERT($this->isa( 'TWiki::Access')) if DEBUG;
+ ASSERT($user->isa( 'TWiki::User')) if DEBUG;
+
+ undef $this->{failure};
+
+ #print STDERR "Check $mode access ", $user->stringify()," to $web.",$topic?$topic:'',"\n";
+
+ # super admin is always allowed
+ if( $user->isAdmin() ) {
+ #print STDERR $user->stringify() . " - ADMIN\n";
+ return 1;
+ }
+
+ $mode = uc( $mode ); # upper case
+ $web ||= $this->{session}->{webName};
+
+ my $prefs = $this->{session}->{prefs};
+
+ my $allowText;
+ my $denyText;
+
+ # extract the * Set (ALLOWTOPIC|DENYTOPIC)$mode
+ if( $text ) {
+ # override topic permissions. Note: ignores embedded metadata
+ # SMELL: this is horrible! But it's inevitable given the dreadful
+ # business of storing access controls embedded in topic text.
+ $allowText = $prefs->getTextPreferencesValue( 'ALLOWTOPIC'.$mode,
+ $text, $web, $topic );
+ $denyText = $prefs->getTextPreferencesValue( 'DENYTOPIC'.$mode,
+ $text, $web, $topic );
+ } elsif( $topic ) {
+ $allowText = $prefs->getTopicPreferencesValue( 'ALLOWTOPIC'.$mode,
+ $web, $topic );
+ $denyText = $prefs->getTopicPreferencesValue( 'DENYTOPIC'.$mode,
+ $web, $topic );
+ }
+
+ # Check DENYTOPIC
+ if( defined( $denyText )) {
+ if( $denyText =~ /\S$/ ) {
+ if( $user->isInList( $denyText )) {
+ $this->{failure} = $this->{session}->{i18n}->maketext('access denied on topic');
+ #print STDERR $this->{failure},"\n";
+ return 0;
+ }
+ } else {
+ # If DENYTOPIC is empty, don't deny _anyone_
+ #print STDERR "DENYTOPIC is empty\n";
+ return 1;
+ }
+ }
+
+ # Check ALLOWTOPIC. If this is defined the user _must_ be in it
+
+ if( defined( $allowText ) && $allowText =~ /\S/ ) {
+ if( $user->isInList( $allowText )) {
+ #print STDERR "in ALLOWTOPIC\n";
+ return 1;
+ }
+ $this->{failure} = $this->{session}->{i18n}->maketext('access not allowed on topic');
+ #print STDERR $this->{failure},"\n";
+ return 0;
+ }
+
+ # Check DENYWEB, but only if DENYTOPIC is not set (even if it
+ # is empty - empty means "don't deny anybody")
+ unless( defined( $denyText )) {
+ $denyText =
+ $prefs->getWebPreferencesValue( 'DENYWEB'.$mode, $web );
+ if( defined( $denyText ) && $user->isInList( $denyText )) {
+ $this->{failure} = $this->{session}->{i18n}->maketext('access denied on web');
+ #print STDERR $this->{failure},"\n";
+ return 0;
+ }
+ }
+
+ # Check ALLOWWEB. If this is defined and not overridden by
+ # ALLOWTOPIC, the user _must_ be in it.
+ $allowText = $prefs->getWebPreferencesValue( 'ALLOWWEB'.$mode, $web );
+
+ if( defined( $allowText ) && $allowText =~ /\S/ ) {
+ unless( $user->isInList( $allowText )) {
+ $this->{failure} = $this->{session}->{i18n}->maketext('access not allowed on web');
+ #print STDERR $this->{failure},"\n";
+ return 0;
+ }
+ }
+
+ #print STDERR "OK, permitted\n";
+ #print STDERR "ALLOW: $allowText\n" if defined $allowText;
+ #print STDERR "DENY: $denyText\n" if defined $denyText;
+ return 1;
+}
+
+
+sub getACLs {
+ my( $this,$modes, $web, $topic ) = @_;
+ my $session= $this->{session};
+
+ my $context = 'TOPIC';
+ unless( $topic ) {
+ $context = 'WEB';
+ $topic = $TWiki::cfg{WebPrefsTopicName};
+ }
+
+ my @knownusers = map { $_->webDotWikiName() }
+ ( @{getListOfUsers()}, @{getListOfGroups()} );
+
+ my %acls;
+
+ # By default, allow all to access all
+ foreach my $user ( @knownusers ) {
+ foreach my $mode ( @$modes ) {
+ $acls{$user}->{$mode} = 1;
+ }
+ }
+
+ my( $meta, $text ) = TWiki::Func::readTopic( $web, $topic );
+ my $modeRE = join('|', map { uc( $_ ) } @$modes );
+ while( $text =~ s/^(?: |\t)+\* Set (ALLOW|DENY)$context($modeRE) = *(.*)$//m ) {
+ my $perm = $1;
+ my $mode = $2;
+ my @lusers =
+ grep { $_ }
+ map {
+ my( $w, $t ) = TWiki::Func::normalizeWebTopicName(
+ $TWiki::cfg{UsersWebName}, $_);
+ lookupUser( wikiname => "$w.$t");
+ } split( /[ ,]+/, $3 || '' );
+
+ # expand groups
+ my @users;
+ while( scalar( @lusers )) {
+ my $user = pop( @lusers );
+ if( $user->isGroup()) {
+ # expand groups and add individual users
+ my $group = $user->groupMembers();
+ push( @lusers, @$group ) if $group;
+ }
+ push( @users, $user->webDotWikiName() );
+ }
+
+ if( $perm eq 'ALLOW' ) {
+ # If ALLOW, only users in the ALLOW list are permitted, so change
+ # the default for all other users to 0.
+ foreach my $user ( @knownusers ) {
+ $acls{$user}->{$mode} = 0;
+ }
+ foreach my $user ( @users ) {
+ $acls{$user}->{$mode} = 1;
+ }
+ } else {
+ foreach my $user ( @users ) {
+ $acls{$user}->{$mode} = 0;
+ }
+ }
+ }
+
+ return \%acls;
+}
+
+sub setACLs {
+ my( $this, $modes, $acls, $web, $topic ) = @_;
+
+ my $context = 'TOPIC';
+ unless( $topic ) {
+ $context = 'WEB';
+ $topic = $TWiki::cfg{WebPrefsTopicName};
+ }
+
+ my( $meta, $text ) = TWiki::Func::readTopic( $web, $topic );
+
+ my @knownusers = map { $_->webDotWikiName() }
+ ( @{getListOfUsers()}, @{getListOfGroups()} );
+
+ foreach my $op ( @$modes ) {
+ my @allowed = grep { $acls->{$_}->{$op} } @knownusers;
+ my @denied = grep { !$acls->{$_}->{$op} } @knownusers;
+ if( scalar( @denied )) {
+ # Work out the access modes
+ if( scalar( @denied ) <= scalar( @allowed )) {
+ $text .= " * Set DENY$context$op = ".join(' ', @denied)."\n";
+ } else {
+ $text .= " * Set ALLOW$context$op = ".join(' ', @allowed)."\n";
+ }
+ }
+ # If *anyone* is denied view, switch off search all
+ if( $context eq 'WEB' && uc( $op ) eq 'VIEW' ) {
+ if( scalar( @denied )) {
+ $text =~ s/^((?: |\t)+\* Set NOSEARCHALL =) on$/$1/gm;
+ } else {
+ $text =~ s/^((?: |\t)+\* Set NOSEARCHALL =).*?$/$1 on/gm;
+ }
+ }
+ }
+
+ # If there is an access control violation this will throw.
+ TWiki::Func::saveTopic( $web, $topic,
+ $meta, $text, { minor => 1 } );
+}
+
+1;
Index: lib/TWiki/Access/OtherAccess.pm
===================================================================
--- lib/TWiki/Access/OtherAccess.pm (revision 0)
+++ lib/TWiki/Access/OtherAccess.pm (revision 0)
@@ -0,0 +1,204 @@
+# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
+#
+# Copyright (C) 1999-2006 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::Access::OtherAccess
+
+Implementation that only allows TWikiAdmins to perform operations
+
+=cut
+
+package TWiki::Access::OtherAccess;
+
+use TWiki::Access;
+@ISA = qw(TWiki::Access);
+
+use strict;
+use Assert;
+
+sub new {
+ my ( $class, $session ) = @_;
+ my $this = bless( {}, $class );
+ ASSERT($session->isa( 'TWiki')) if DEBUG;
+ $this->{session} = $session;
+
+ %{$this->{GROUPS}} = ();
+
+ return $this;
+}
+
+sub permissionsSet {
+ my( $this, $web ) = @_;
+ ASSERT($this->isa( 'TWiki::Access')) if DEBUG;
+
+ my $permSet = 0;
+
+ my @types = qw/ALLOW DENY/;
+ my @actions = qw/CHANGE VIEW RENAME/;
+ my $prefs = $this->{session}->{prefs};
+
+ OUT: foreach my $type ( @types ) {
+ foreach my $action ( @actions ) {
+ my $pref = $type . 'WEB' . $action;
+ my $prefValue = $prefs->getWebPreferencesValue( $pref, $web ) || '';
+ if( $prefValue =~ /\S/ ) {
+ $permSet = 1;
+ last OUT;
+ }
+ }
+ }
+
+ return $permSet;
+}
+
+sub getReason {
+ my $this = shift;
+
+ return $this->{failure};
+}
+
+sub checkAccessPermission {
+ my( $this, $mode, $user, $text, $topic, $web ) = @_;
+ ASSERT($this->isa( 'TWiki::Access')) if DEBUG;
+ ASSERT($user->isa( 'TWiki::User')) if DEBUG;
+
+ undef $this->{failure};
+
+ #print STDERR "Check $mode access ", $user->stringify()," to $web.",$topic?$topic:'',"\n";
+
+ # super admin is always allowed
+ if( $user->isAdmin() ) {
+ #print STDERR $user->stringify() . " - ADMIN\n";
+ return 1;
+ }
+
+ $this->{failure} = 'Only TWikiAdmins are allowed to perform any operation';
+
+ return 0;
+}
+
+
+sub getACLs {
+ my( $this,$modes, $web, $topic ) = @_;
+ my $session= $this->{session};
+
+ my $context = 'TOPIC';
+ unless( $topic ) {
+ $context = 'WEB';
+ $topic = $TWiki::cfg{WebPrefsTopicName};
+ }
+
+ my @knownusers = map { $_->webDotWikiName() }
+ ( @{getListOfUsers()}, @{getListOfGroups()} );
+
+ my %acls;
+
+ # By default, allow all to access all
+ foreach my $user ( @knownusers ) {
+ foreach my $mode ( @$modes ) {
+ $acls{$user}->{$mode} = 1;
+ }
+ }
+
+ my( $meta, $text ) = TWiki::Func::readTopic( $web, $topic );
+ my $modeRE = join('|', map { uc( $_ ) } @$modes );
+ while( $text =~ s/^(?: |\t)+\* Set (ALLOW|DENY)$context($modeRE) = *(.*)$//m ) {
+ my $perm = $1;
+ my $mode = $2;
+ my @lusers =
+ grep { $_ }
+ map {
+ my( $w, $t ) = TWiki::Func::normalizeWebTopicName(
+ $TWiki::cfg{UsersWebName}, $_);
+ lookupUser( wikiname => "$w.$t");
+ } split( /[ ,]+/, $3 || '' );
+
+ # expand groups
+ my @users;
+ while( scalar( @lusers )) {
+ my $user = pop( @lusers );
+ if( $user->isGroup()) {
+ # expand groups and add individual users
+ my $group = $user->groupMembers();
+ push( @lusers, @$group ) if $group;
+ }
+ push( @users, $user->webDotWikiName() );
+ }
+
+ if( $perm eq 'ALLOW' ) {
+ # If ALLOW, only users in the ALLOW list are permitted, so change
+ # the default for all other users to 0.
+ foreach my $user ( @knownusers ) {
+ $acls{$user}->{$mode} = 0;
+ }
+ foreach my $user ( @users ) {
+ $acls{$user}->{$mode} = 1;
+ }
+ } else {
+ foreach my $user ( @users ) {
+ $acls{$user}->{$mode} = 0;
+ }
+ }
+ }
+
+ return \%acls;
+}
+
+sub setACLs {
+ my( $this, $modes, $acls, $web, $topic ) = @_;
+
+ my $context = 'TOPIC';
+ unless( $topic ) {
+ $context = 'WEB';
+ $topic = $TWiki::cfg{WebPrefsTopicName};
+ }
+
+ my( $meta, $text ) = TWiki::Func::readTopic( $web, $topic );
+
+ my @knownusers = map { $_->webDotWikiName() }
+ ( @{getListOfUsers()}, @{getListOfGroups()} );
+
+ foreach my $op ( @$modes ) {
+ my @allowed = grep { $acls->{$_}->{$op} } @knownusers;
+ my @denied = grep { !$acls->{$_}->{$op} } @knownusers;
+ if( scalar( @denied )) {
+ # Work out the access modes
+ if( scalar( @denied ) <= scalar( @allowed )) {
+ $text .= " * Set DENY$context$op = ".join(' ', @denied)."\n";
+ } else {
+ $text .= " * Set ALLOW$context$op = ".join(' ', @allowed)."\n";
+ }
+ }
+ # If *anyone* is denied view, switch off search all
+ if( $context eq 'WEB' && uc( $op ) eq 'VIEW' ) {
+ if( scalar( @denied )) {
+ $text =~ s/^((?: |\t)+\* Set NOSEARCHALL =) on$/$1/gm;
+ } else {
+ $text =~ s/^((?: |\t)+\* Set NOSEARCHALL =).*?$/$1 on/gm;
+ }
+ }
+ }
+
+ # If there is an access control violation this will throw.
+ TWiki::Func::saveTopic( $web, $topic,
+ $meta, $text, { minor => 1 } );
+}
+
+1;