1 rizwank 1.1 # Module of TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Copyright (C) 2000-2004 Peter Thoeny, peter@thoeny.com
4 #
5 # For licensing info read license.txt file in the TWiki root.
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details, published at
15 # http://www.gnu.org/copyleft/gpl.html
16 #
17 # Notes:
18 # - Latest version at http://twiki.org/
19 # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt
20 # - Customize variables in wikicfg.pm when installing TWiki.
21 # - Optionally change wikicfg.pm for custom extensions of rendering rules.
22 rizwank 1.1 # - Upgrading TWiki is easy as long as you only customize wikicfg.pm.
23 # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log
24
25 =begin twiki
26
27 ---+ TWiki::Access Package
28
29 This package manages access control to view and change topics. Plugins
30 should only use the equivalent interface in TWiki::Func.
31
32 =cut
33
34 package TWiki::Access;
35
36 use strict;
37
38 use vars qw(
39 %allGroups @processedGroups
40 );
41
42 # =========================
43 rizwank 1.1 =pod
44
45 ---++ initializeAccess()
46 | Description: | Basic module initialization, called from TWiki::initialize |
47
48 =cut
49
50 sub initializeAccess
51 {
52 %allGroups = ();
53 @processedGroups = ();
54 }
55
56 # =========================
57 # Are there any security restrictions for this Web
58 # (ignoring settings on individual pages).
59 =pod
60
61 ---++ sub permissionsSet ( $web )
62
63 Not yet documented.
64 rizwank 1.1
65 =cut
66
67 sub permissionsSet
68 {
69 my( $web ) = @_;
70
71 my $permSet = 0;
72
73 my @types = qw/ALLOW DENY/;
74 my @actions = qw/CHANGE VIEW RENAME/;
75
76 OUT: foreach my $type ( @types ) {
77 foreach my $action ( @actions ) {
78 my $pref = $type . "WEB" . $action;
79 my $prefValue = TWiki::Prefs::getPreferencesValue( $pref, $web ) || "";
80 if( $prefValue !~ /^\s*$/ ) {
81 $permSet = 1;
82 last OUT;
83 }
84 }
85 rizwank 1.1 }
86
87 return $permSet;
88 }
89
90 # =========================
91 =pod
92
93 ---++ checkAccessPermission( $action, $user, $text, $topic, $web ) ==> $ok
94 | Description: | Check if user is allowed to access topic |
95 | Parameter: =$action= | "VIEW", "CHANGE", "CREATE", etc. |
96 | Parameter: =$user= | Remote WikiName, e.g. "Main.PeterThoeny" |
97 | Parameter: =$text= | If empty: Read "$theWebName.$theTopicName" to check permissions |
98 | Parameter: =$topic= | Topic name to check, e.g. "SomeTopic" |
99 | Parameter: =$web= | Web, e.g. "Know" |
100 | Return: =$ok= | 1 if OK to access, 0 if no permission |
101
102 =cut
103
104 sub checkAccessPermission
105 {
106 rizwank 1.1 my( $theAccessType, $theUserName,
107 $theTopicText, $theTopicName, $theWebName ) = @_;
108
109 #AS 2001-11-04 see Codev.UnchangeableTopicBug
110 if ( $TWiki::doSuperAdminGroup &&
111 $TWiki::superAdminGroup ) {
112 if ( &userIsInGroup( $theUserName, $TWiki::superAdminGroup ) ) {
113 return 1;
114 }
115 }
116 #/AS
117
118 $theAccessType = uc( $theAccessType ); # upper case
119 if( ! $theWebName ) {
120 $theWebName = $TWiki::webName;
121 }
122 if( ! $theTopicText ) {
123 # text not supplied as parameter, so read topic
124 $theTopicText = &TWiki::Store::readWebTopic( $theWebName, $theTopicName );
125 }
126 ##&TWiki::writeDebug( "checkAccessPermission: Type $theAccessType, user $theUserName, topic $theTopicName" );
127 rizwank 1.1
128 # parse the " * Set (ALLOWTOPIC|DENYTOPIC)$theAccessType = " in body text
129 my @denyList = ();
130 my @allowList = ();
131 foreach( split( /\n/, $theTopicText ) ) {
132 if( /^\s+\*\sSet\s(ALLOWTOPIC|DENYTOPIC)$theAccessType\s*\=\s*(.*)/ ) {
133 if( $2 ) {
134 my $allowOrDeny = $1; # "ALLOWTOPIC" or "DENYTOPIC"
135 my @tmpList = map { getUsersOfGroup( $_ ) }
136 prvGetUserList( $2 );
137 ##my $tmp = join( ', ', @tmpList );
138 ##&TWiki::writeDebug( " Topic $allowOrDeny$theAccessType: {$tmp}" );
139 if( $allowOrDeny eq "DENYTOPIC" ) {
140 @denyList = @tmpList;
141 } else {
142 @allowList = @tmpList;
143 }
144 }
145 }
146 }
147
148 rizwank 1.1 # if empty, get access permissions from preferences
149 if( ! @denyList ) {
150 my $tmpVal = &TWiki::Prefs::getPreferencesValue( "DENYWEB$theAccessType", $theWebName );
151 @denyList = map { getUsersOfGroup( $_ ) }
152 prvGetUserList( $tmpVal );
153 ##my $tmp = join( ', ', @denyList );
154 ##&TWiki::writeDebug( " Prefs DENYWEB$theAccessType: {$tmp}" );
155 }
156 if( ! @allowList ) {
157 my $tmpVal = &TWiki::Prefs::getPreferencesValue( "ALLOWWEB$theAccessType", $theWebName );
158 @allowList = map { getUsersOfGroup( $_ ) }
159 prvGetUserList( $tmpVal );
160 ##my $tmp = join( ', ', @allowList );
161 ##&TWiki::writeDebug( " Prefs ALLOWWEB$theAccessType: {$tmp}" );
162 }
163
164 # access permission logic
165 if( @denyList ) {
166 if( grep { /^$theUserName$/ } @denyList ) {
167 # user is on deny list
168 ##&TWiki::writeDebug( " return 0, user is on deny list" );
169 rizwank 1.1 return 0;
170 }
171 }
172 if( @allowList ) {
173 if( grep { /^$theUserName$/ } @allowList ) {
174 # user is on allow list
175 ##&TWiki::writeDebug( " return 1, user is on allow list" );
176 return 1;
177 } else {
178 # user is not on allow list
179 ##&TWiki::writeDebug( " return 0, user is not on allow list" );
180 return 0;
181 }
182 }
183 # allow is undefined, so grant access
184 ##&TWiki::writeDebug( " return 1, allow is undefined" );
185 return 1;
186 }
187
188 # =========================
189 =pod
190 rizwank 1.1
191 ---++ getListOfGroups( ) ==> @listOfGroups
192 | Description: | get a list of groups definedin this TWiki |
193 | Return: =@listOfGroups= | list of all the groups |
194
195 =cut
196
197 sub getListOfGroups
198 {
199 my $text = &TWiki::Search::searchWeb(
200 "inline" => "1",
201 "search" => "Set GROUP =",
202 "web" => "all",
203 "topic" => "*Group",
204 "type" => "regex",
205 "nosummary" => "on",
206 "nosearch" => "on",
207 "noheader" => "on",
208 "nototal" => "on",
209 "noempty" => "on",
210 "format" => "\$web.\$topic",
211 rizwank 1.1 );
212
213 my ( @list ) = split ( /\n/, $text );
214 return @list;
215 }
216
217 # =========================
218 =pod
219
220 ---++ getGroupsUserIsIn( $user ) ==> @listOfGroups
221 | Description: | get a list of groups a user is in |
222 | Parameter: =$user= | Remote WikiName, e.g. "Main.PeterThoeny" |
223 | Return: =@listOfGroups= | list os all the WikiNames for a group |
224
225 =cut
226
227 sub getGroupsUserIsIn
228 {
229 my( $theUserName ) = @_;
230
231 my $userTopic = prvGetWebTopicName( $TWiki::mainWebname, $theUserName );
232 rizwank 1.1 my @grpMembers = ();
233 my @listOfGroups = getListOfGroups();
234 my $group;
235
236 &TWiki::writeDebug("Checking [$userTopic]");
237 foreach $group ( @listOfGroups) {
238 if ( userIsInGroup ( $userTopic, $group )) {
239 push ( @grpMembers, $group );
240 }
241 }
242
243 return @grpMembers;
244 }
245
246 # =========================
247 =pod
248
249 ---++ userIsInGroup( $user, $group ) ==> $ok
250 | Description: | Check if user is a member of a group |
251 | Parameter: =$user= | Remote WikiName, e.g. "Main.PeterThoeny" |
252 | Parameter: =$group= | Group name, e.g. "Main.EngineeringGroup" |
253 rizwank 1.1 | Return: =$ok= | 1 user is in group, 0 if not |
254 | TODO: | what are we checking if we are not specifying a Group? |
255 | | more detailed documentation@! |
256
257 =cut
258
259 sub userIsInGroup
260 {
261 my( $theUserName, $theGroupTopicName ) = @_;
262
263 my $usrTopic = prvGetWebTopicName( $TWiki::mainWebname, $theUserName );
264 my $grpTopic = prvGetWebTopicName( $TWiki::mainWebname, $theGroupTopicName );
265 my @grpMembers = ();
266
267 if( $grpTopic !~ /.*Group$/ ) {
268 # not a group, so compare user to user
269 push( @grpMembers, $grpTopic );
270 } elsif( ( %allGroups ) && ( exists $allGroups{ $grpTopic } ) ) {
271 # group is allready known
272 @grpMembers = @{ $allGroups{ $grpTopic } };
273 } else {
274 rizwank 1.1 @grpMembers = prvGetUsersOfGroup( $grpTopic, 1 );
275 }
276
277 my $isInGroup = grep { /^$usrTopic$/ } @grpMembers;
278 return $isInGroup;
279 }
280
281 # =========================
282 =pod
283
284 ---++ getUsersOfGroup( $group ) ==> @users
285 | Description: | Get all members of a group; groups are expanded recursively |
286 | Parameter: =$group= | Group topic name, e.g. "Main.EngineeringGroup" |
287 | Return: =@users= | List of users, e.g. ( "Main.JohnSmith", "Main.JaneMiller" ) |
288
289 =cut
290
291 sub getUsersOfGroup
292 {
293 my( $theGroupTopicName ) = @_;
294 ##TWiki::writeDebug( "group is $theGroupTopicName" );
295 rizwank 1.1 return prvGetUsersOfGroup( $theGroupTopicName, 1 );
296 }
297
298 # =========================
299 =pod
300
301 ---++ sub prvGetUsersOfGroup ( $theGroupTopicName, $theFirstCall )
302
303 Not yet documented.
304
305 =cut
306
307 sub prvGetUsersOfGroup
308 {
309 my( $theGroupTopicName, $theFirstCall ) = @_;
310
311 my @resultList = ();
312 # extract web and topic name
313 my $topic = $theGroupTopicName;
314 my $web = $TWiki::mainWebname;
315 $topic =~ /^([^\.]*)\.(.*)$/;
316 rizwank 1.1 if( $2 ) {
317 $web = $1;
318 $topic = $2;
319 }
320 ##TWiki::writeDebug( "Web is $web, topic is $topic" );
321
322 if( $topic !~ /.*Group$/ ) {
323 # return user, is not a group
324 return ( "$web.$topic" );
325 }
326
327 # check if group topic is already processed
328 if( $theFirstCall ) {
329 # FIXME: Get rid of this global variable
330 @processedGroups = ();
331 } elsif( grep { /^$web\.$topic$/ } @processedGroups ) {
332 # do nothing, already processed
333 return ();
334 }
335 push( @processedGroups, "$web\.$topic" );
336
337 rizwank 1.1 # read topic
338 my $text = &TWiki::Store::readWebTopic( $web, $topic );
339
340 # reset variables, defensive coding needed for recursion
341 (my $baz = "foo") =~ s/foo//;
342
343 # extract users
344 my $user = "";
345 my @glist = ();
346 foreach( split( /\n/, $text ) ) {
347 if( /^\s+\*\sSet\sGROUP\s*\=\s*(.*)/ ) {
348 if( $1 ) {
349 @glist = prvGetUserList( $1 );
350 }
351 }
352 }
353 foreach( @glist ) {
354 if( /.*Group$/ ) {
355 # $user is actually a group
356 my $group = $_;
357 if( ( %allGroups ) && ( exists $allGroups{ $group } ) ) {
358 rizwank 1.1 # allready known, so add to list
359 push( @resultList, @{ $allGroups{ $group } } );
360 } else {
361 # call recursively
362 my @userList = prvGetUsersOfGroup( $group, 0 );
363 # add group to allGroups hash
364 $allGroups{ $group } = [ @userList ];
365 push( @resultList, @userList );
366 }
367 } else {
368 # add user to list
369 push( @resultList, $_ );
370 }
371 }
372 ##TWiki::writeDebug( "Returning group member list of @resultList" );
373 return @resultList;
374 }
375
376 # =========================
377 =pod
378
379 rizwank 1.1 ---++ sub prvGetWebTopicName ( $theWebName, $theTopicName )
380
381 Not yet documented.
382
383 =cut
384
385 sub prvGetWebTopicName
386 {
387 my( $theWebName, $theTopicName ) = @_;
388 $theTopicName =~ s/%MAINWEB%/$theWebName/go;
389 $theTopicName =~ s/%TWIKIWEB%/$theWebName/go;
390 if( $theTopicName =~ /[\.]/ ) {
391 $theWebName = ""; # to suppress warning
392 } else {
393 $theTopicName = "$theWebName\.$theTopicName";
394 }
395 return $theTopicName;
396 }
397
398 # =========================
399 =pod
400 rizwank 1.1
401 ---++ sub prvGetUserList ( $theItems )
402
403 Not yet documented.
404
405 =cut
406
407 sub prvGetUserList
408 {
409 my( $theItems ) = @_;
410 # comma delimited list of users or groups
411 # i.e.: "%MAINWEB%.UserA, UserB, Main.UserC # something else"
412 $theItems =~ s/(<[^>]*>)//go; # Remove HTML tags
413 # TODO: i18n fix for user name
414 $theItems =~ s/\s*([a-zA-Z0-9_\.\,\s\%]*)\s*(.*)/$1/go; # Limit list
415 my @list = map { prvGetWebTopicName( $TWiki::mainWebname, $_ ) }
416 split( /[\,\s]+/, $theItems );
417 return @list;
418 }
419
420 # =========================
421 rizwank 1.1
422 1;
423
424 # EOF
|
Return to
Access.pm
CVS log
Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki