1 # Copyright (C) 2002 Stanislav Sinyagin
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version.
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this program; if not, write to the Free Software
15 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
17 # $Id: Edit.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $
18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
21 package Torrus::ACL::Edit;
28 @Torrus::ACL::Edit::ISA = qw(Torrus::ACL);
34 my $class = ref($proto) || $proto;
35 $options{'-WriteAccess'} = 1;
36 my $self = $class->SUPER::new( %options );
48 foreach my $group ( @groups )
50 if( length( $group ) == 0 or $group =~ /\W/ )
52 Error('Invalid group name: ' . $group);
55 elsif( $self->groupExists( $group ) )
57 Error('Cannot add group ' . $group . ': the group already exists');
62 $self->{'db_users'}->addToList( 'G:', $group );
63 $self->setGroupModified( $group );
64 Info('Group added: ' . $group);
76 foreach my $group ( @groups )
78 if( $self->groupExists( $group ) )
80 my $members = $self->listGroupMembers( $group );
81 foreach my $uid ( @{$members} )
83 $self->{'db_users'}->delFromList( 'gm:' . $uid, $group );
85 $self->{'db_users'}->delFromList( 'G:', $group );
87 my $cursor = $self->{'db_acl'}->cursor( -Write => 1 );
88 while( my ($key, $val) = $self->{'db_acl'}->next( $cursor ) )
90 my( $dbgroup, $object, $privilege ) = split( ':', $key );
91 if( $dbgroup eq $group )
93 $self->{'db_acl'}->c_del( $cursor );
98 Info('Group deleted: ' . $group);
102 Error('Cannot delete group ' . $group .
103 ': the group does not exist');
115 return $self->{'db_users'}->searchList( 'G:', $group );
123 my $list = $self->{'db_users'}->get( 'G:' );
125 return split( ',', $list );
136 my $cursor = $self->{'db_users'}->cursor();
137 while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
139 my( $selector, $uid ) = split(':', $key);
140 if( $selector eq 'gm' )
142 if( defined($val) and length($val) > 0 and
143 grep {$group eq $_} split(',', $val) )
145 push( @{$members}, $uid );
161 if( $self->userExists( $uid ) )
163 foreach my $group ( @groups )
165 if( $self->groupExists( $group ) )
167 if( not grep {$group eq $_} $self->memberOf( $uid ) )
169 $self->{'db_users'}->addToList( 'gm:' . $uid, $group );
170 $self->setGroupModified( $group );
171 Info('Added ' . $uid . ' to group ' . $group);
175 Error('Cannot add ' . $uid . ' to group ' . $group .
176 ': user is already a member of this group');
182 Error('Cannot add ' . $uid . ' to group ' . $group .
183 ': group does not exist');
190 Error('Cannot add user ' . $uid .
191 'to groups: user does not exist');
198 sub delUserFromGroups
205 if( $self->userExists( $uid ) )
207 foreach my $group ( @groups )
209 if( $self->groupExists( $group ) )
211 if( grep {$group eq $_} $self->memberOf( $uid ) )
213 $self->{'db_users'}->delFromList( 'gm:' . $uid, $group );
214 $self->setGroupModified( $group );
215 Info('Deleted ' . $uid . ' from group ' . $group);
219 Error('Cannot delete ' . $uid . ' from group ' . $group .
220 ': user is not a member of this group');
226 Error('Cannot detete ' . $uid . ' from group ' . $group .
227 ': group does not exist');
234 Error('Cannot delete user ' . $uid .
235 'from groups: user does not exist');
246 my $attrValues = shift;
249 if( length( $uid ) == 0 or $uid =~ /\W/ )
251 Error('Invalid user ID: ' . $uid);
254 elsif( $self->userExists( $uid ) )
256 Error('Cannot add user ' . $uid . ': the user already exists');
261 $self->setUserAttribute( $uid, 'uid', $uid );
262 if( defined( $attrValues ) )
264 $self->setUserAttributes( $uid, $attrValues );
266 Info('User added: ' . $uid);
277 my $dbuid = $self->userAttribute( $uid, 'uid' );
278 return( defined( $dbuid ) and ( $dbuid eq $uid ) );
287 my $cursor = $self->{'db_users'}->cursor();
288 while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
290 my( $selector, $uid, $attr ) = split(':', $key);
291 if( $selector eq 'ua' and $attr eq 'uid' )
308 if( length( $attr ) == 0 or $attr =~ /\W/ )
310 Error('Invalid attribute name: ' . $attr);
315 $self->{'db_users'}->put( 'ua:' . $uid . ':' . $attr, $val );
316 $self->{'db_users'}->addToList( 'uA:' . $uid, $attr );
317 if( $attr ne 'modified' )
319 $self->setUserModified( $uid );
321 Debug('Set ' . $attr . ' for ' . $uid . ': ' . $val);
333 foreach my $attr ( @attrs )
335 $self->{'db_users'}->del( 'ua:' . $uid . ':' . $attr );
336 $self->{'db_users'}->delFromList( 'uA:' . $uid, $attr );
337 $self->setUserModified( $uid );
338 Debug('Deleted ' . $attr . ' from ' . $uid);
343 sub setUserAttributes
347 my $attrValues = shift;
351 foreach my $attr ( keys %{$attrValues} )
353 $ok = $self->setUserAttribute( $uid, $attr, $attrValues->{$attr} )
366 $self->setUserAttribute( $uid, 'modified', scalar( localtime( time() ) ) );
369 sub listUserAttributes
374 my $list = $self->{'db_users'}->get( 'uA:' . $uid );
376 return split( ',', $list );
384 my $password = shift;
387 if( $self->userExists( $uid ) )
389 if( length( $password ) < $Torrus::ACL::minPasswordLength )
391 Error('Password too short: must be ' .
392 $Torrus::ACL::minPasswordLength . ' characters long');
397 my $attrValues = $self->{'auth'}->setPassword( $uid, $password );
398 $self->setUserAttributes( $uid, $attrValues );
399 Info('Password set for ' . $uid);
404 Error('Cannot change password for user ' . $uid .
405 ': user does not exist');
418 if( $self->userExists( $uid ) )
420 my $cursor = $self->{'db_users'}->cursor( -Write => 1 );
421 while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
423 my( $selector, $dbuid ) = split(':', $key);
424 if( ( $selector eq 'gm' or $selector eq 'ua' ) and
427 $self->{'db_users'}->c_del( $cursor );
432 Info('User deleted: ' . $uid);
436 Error('Cannot delete user ' . $uid . ': user does not exist');
443 sub setGroupAttribute
451 if( length( $attr ) == 0 or $attr =~ /\W/ )
453 Error('Invalid attribute name: ' . $attr);
458 $self->{'db_users'}->put( 'ga:' . $group . ':' . $attr, $val );
459 $self->{'db_users'}->addToList( 'gA:' . $group, $attr );
460 if( $attr ne 'modified' )
462 $self->setGroupModified( $group );
464 Debug('Set ' . $attr . ' for ' . $group . ': ' . $val);
470 sub listGroupAttributes
475 my $list = $self->{'db_users'}->get( 'gA:' . $group );
477 return split( ',', $list );
487 $self->setGroupAttribute( $group, 'modified',
488 scalar( localtime( time() ) ) );
497 my $privilege = shift;
500 if( $self->groupExists( $group ) )
502 $self->{'db_acl'}->put( $group.':'.$object.':'.$privilege, 1 );
503 $self->setGroupModified( $group );
504 Info('Privilege ' . $privilege . ' for object ' . $object .
505 ' set for group ' . $group);
509 Error('Cannot set privilege for group ' . $group .
510 ': group does not exist');
522 my $privilege = shift;
525 if( $self->groupExists( $group ) )
527 my $key = $group.':'.$object.':'.$privilege;
528 if( $self->{'db_acl'}->get( $key ) )
530 $self->{'db_acl'}->del( $key );
531 $self->setGroupModified( $group );
532 Info('Privilege ' . $privilege . ' for object ' . $object .
533 ' revoked from group ' . $group);
538 Error('Cannot revoke privilege from group ' . $group .
539 ': group does not exist');
553 my $cursor = $self->{'db_acl'}->cursor();
554 while( my ($key, $val) = $self->{'db_acl'}->next( $cursor ) )
556 my( $dbgroup, $object, $privilege ) = split( ':', $key );
557 if( $dbgroup eq $group )
559 $ret->{$object}{$privilege} = 1;
572 $self->{'db_acl'}->trunc();
573 $self->{'db_users'}->trunc();
575 Info('Cleared the ACL configuration');
582 my $exportfile = shift;
583 my $exporttemplate = shift;
586 eval 'require Torrus::ACL::Export;
587 $ok = Torrus::ACL::Export::exportACL( $self, $exportfile,
603 my $importfile = shift;
606 eval 'require Torrus::ACL::Import;
607 $ok = Torrus::ACL::Import::importACL( $self, $importfile );';
625 # indent-tabs-mode: nil
626 # perl-indent-level: 4