torrus/perllib/Torrus/ACL/Edit.pm

   1 #  Copyright (C) 2002  Stanislav Sinyagin
   2 #
   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.
   7 #
   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.
  12 #
  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.
  16
  17 # $Id: Edit.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20
  21 package Torrus::ACL::Edit;
  22
  23 use Torrus::ACL;
  24 use Torrus::Log;
  25
  26 use strict;
  27
  28 @Torrus::ACL::Edit::ISA = qw(Torrus::ACL);
  29
  30 sub new
  31 {
  32     my $proto = shift;
  33     my %options = @_;
  34     my $class = ref($proto) || $proto;
  35     $options{'-WriteAccess'} = 1;
  36     my $self  = $class->SUPER::new( %options );
  37     bless $self, $class;
  38     return $self;
  39 }
  40
  41
  42 sub addGroups
  43 {
  44     my $self = shift;
  45     my @groups = shift;
  46
  47     my $ok = 1;
  48     foreach my $group ( @groups )
  49     {
  50         if( length( $group ) == 0 or $group =~ /\W/ )
  51         {
  52             Error('Invalid group name: ' . $group);
  53             $ok = 0;
  54         }
  55         elsif( $self->groupExists( $group ) )
  56         {
  57             Error('Cannot add group ' . $group . ': the group already exists');
  58             $ok = 0;
  59         }
  60         else
  61         {
  62             $self->{'db_users'}->addToList( 'G:', $group );
  63             $self->setGroupModified( $group );
  64             Info('Group added: ' . $group);
  65         }
  66     }
  67     return $ok;
  68 }
  69
  70 sub deleteGroups
  71 {
  72     my $self = shift;
  73     my @groups = shift;
  74
  75     my $ok = 1;
  76     foreach my $group ( @groups )
  77     {
  78         if( $self->groupExists( $group ) )
  79         {
  80             my $members = $self->listGroupMembers( $group );
  81             foreach my $uid ( @{$members} )
  82             {
  83                 $self->{'db_users'}->delFromList( 'gm:' . $uid, $group );
  84             }
  85             $self->{'db_users'}->delFromList( 'G:', $group );
  86
  87             my $cursor = $self->{'db_acl'}->cursor( -Write => 1 );
  88             while( my ($key, $val) = $self->{'db_acl'}->next( $cursor ) )
  89             {
  90                 my( $dbgroup, $object, $privilege ) = split( ':', $key );
  91                 if( $dbgroup eq $group )
  92                 {
  93                     $self->{'db_acl'}->c_del( $cursor );
  94                 }
  95             }
  96             undef $cursor;
  97
  98             Info('Group deleted: ' . $group);
  99         }
 100         else
 101         {
 102             Error('Cannot delete group ' . $group .
 103                   ': the group does not exist');
 104             $ok = 0;
 105         }
 106     }
 107     return $ok;
 108 }
 109
 110 sub groupExists
 111 {
 112     my $self = shift;
 113     my $group = shift;
 114
 115     return $self->{'db_users'}->searchList( 'G:', $group );
 116 }
 117
 118
 119 sub listGroups
 120 {
 121     my $self = shift;
 122
 123     my $list = $self->{'db_users'}->get( 'G:' );
 124
 125     return split( ',', $list );
 126 }
 127
 128
 129 sub listGroupMembers
 130 {
 131     my $self = shift;
 132     my $group = shift;
 133
 134     my $members = [];
 135
 136     my $cursor = $self->{'db_users'}->cursor();
 137     while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
 138     {
 139         my( $selector, $uid ) = split(':', $key);
 140         if( $selector eq 'gm' )
 141         {
 142             if( defined($val) and length($val) > 0 and
 143                 grep {$group eq $_} split(',', $val) )
 144             {
 145                 push( @{$members}, $uid );
 146             }
 147         }
 148     }
 149     undef $cursor;
 150     return $members;
 151 }
 152
 153
 154 sub addUserToGroups
 155 {
 156     my $self = shift;
 157     my $uid = shift;
 158     my @groups = @_;
 159
 160     my $ok = 1;
 161     if( $self->userExists( $uid ) )
 162     {
 163         foreach my $group ( @groups )
 164         {
 165             if( $self->groupExists( $group ) )
 166             {
 167                 if( not grep {$group eq $_} $self->memberOf( $uid ) )
 168                 {
 169                     $self->{'db_users'}->addToList( 'gm:' . $uid, $group );
 170                     $self->setGroupModified( $group );
 171                     Info('Added ' . $uid . ' to group ' . $group);
 172                 }
 173                 else
 174                 {
 175                     Error('Cannot add ' . $uid . ' to group ' . $group .
 176                           ': user is already a member of this group');
 177                     $ok = 0;
 178                 }
 179             }
 180             else
 181             {
 182                 Error('Cannot add ' . $uid . ' to group ' . $group .
 183                       ': group does not exist');
 184                 $ok = 0;
 185             }
 186         }
 187     }
 188     else
 189     {
 190         Error('Cannot add user ' . $uid .
 191               'to groups: user does not exist');
 192         $ok = 0;
 193     }
 194     return $ok;
 195 }
 196
 197
 198 sub delUserFromGroups
 199 {
 200     my $self = shift;
 201     my $uid = shift;
 202     my @groups = shift;
 203
 204     my $ok = 1;
 205     if( $self->userExists( $uid ) )
 206     {
 207         foreach my $group ( @groups )
 208         {
 209             if( $self->groupExists( $group ) )
 210             {
 211                 if( grep {$group eq $_} $self->memberOf( $uid ) )
 212                 {
 213                     $self->{'db_users'}->delFromList( 'gm:' . $uid, $group );
 214                     $self->setGroupModified( $group );
 215                     Info('Deleted ' . $uid . ' from group ' . $group);
 216                 }
 217                 else
 218                 {
 219                     Error('Cannot delete ' . $uid . ' from group ' . $group .
 220                           ': user is not a member of this group');
 221                     $ok = 0;
 222                 }
 223             }
 224             else
 225             {
 226                 Error('Cannot detete ' . $uid . ' from group ' . $group .
 227                       ': group does not exist');
 228                 $ok = 0;
 229             }
 230         }
 231     }
 232     else
 233     {
 234         Error('Cannot delete user ' . $uid .
 235               'from groups: user does not exist');
 236         $ok = 0;
 237     }
 238     return $ok;
 239 }
 240
 241
 242 sub addUser
 243 {
 244     my $self = shift;
 245     my $uid = shift;
 246     my $attrValues = shift;
 247
 248     my $ok = 1;
 249     if( length( $uid ) == 0 or $uid =~ /\W/ )
 250     {
 251         Error('Invalid user ID: ' . $uid);
 252         $ok = 0;
 253     }
 254     elsif( $self->userExists( $uid ) )
 255     {
 256         Error('Cannot add user ' . $uid . ': the user already exists');
 257         $ok = 0;
 258     }
 259     else
 260     {
 261         $self->setUserAttribute( $uid, 'uid', $uid );
 262         if( defined( $attrValues ) )
 263         {
 264             $self->setUserAttributes( $uid, $attrValues );
 265         }
 266         Info('User added: ' . $uid);
 267     }
 268     return $ok;
 269 }
 270
 271
 272 sub userExists
 273 {
 274     my $self = shift;
 275     my $uid = shift;
 276
 277     my $dbuid = $self->userAttribute( $uid, 'uid' );
 278     return( defined( $dbuid ) and ( $dbuid eq $uid ) );
 279 }
 280
 281 sub listUsers
 282 {
 283     my $self = shift;
 284
 285     my @ret;
 286
 287     my $cursor = $self->{'db_users'}->cursor();
 288     while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
 289     {
 290         my( $selector, $uid, $attr ) = split(':', $key);
 291         if( $selector eq 'ua' and $attr eq 'uid' )
 292         {
 293             push( @ret, $uid );
 294         }
 295     }
 296     undef $cursor;
 297     return @ret;
 298 }
 299
 300 sub setUserAttribute
 301 {
 302     my $self = shift;
 303     my $uid = shift;
 304     my $attr = shift;
 305     my $val = shift;
 306
 307     my $ok = 1;
 308     if( length( $attr ) == 0 or $attr =~ /\W/ )
 309     {
 310         Error('Invalid attribute name: ' . $attr);
 311         $ok = 0;
 312     }
 313     else
 314     {
 315         $self->{'db_users'}->put( 'ua:' . $uid . ':' . $attr, $val );
 316         $self->{'db_users'}->addToList( 'uA:' . $uid, $attr );
 317         if( $attr ne 'modified' )
 318         {
 319             $self->setUserModified( $uid );
 320         }
 321         Debug('Set ' . $attr . ' for ' . $uid . ': ' . $val);
 322     }
 323     return $ok;
 324 }
 325
 326
 327 sub delUserAttribute
 328 {
 329     my $self = shift;
 330     my $uid = shift;
 331     my @attrs = @_;
 332
 333     foreach my $attr ( @attrs )
 334     {
 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);
 339     }
 340 }
 341
 342
 343 sub setUserAttributes
 344 {
 345     my $self = shift;
 346     my $uid = shift;
 347     my $attrValues = shift;
 348
 349     my $ok = 1;
 350
 351     foreach my $attr ( keys %{$attrValues} )
 352     {
 353         $ok = $self->setUserAttribute( $uid, $attr, $attrValues->{$attr} )
 354             ? $ok:0;
 355     }
 356
 357     return $ok;
 358 }
 359
 360
 361 sub setUserModified
 362 {
 363     my $self = shift;
 364     my $uid = shift;
 365
 366     $self->setUserAttribute( $uid, 'modified', scalar( localtime( time() ) ) );
 367 }
 368
 369 sub listUserAttributes
 370 {
 371     my $self = shift;
 372     my $uid = shift;
 373
 374     my $list = $self->{'db_users'}->get( 'uA:' . $uid );
 375
 376     return split( ',', $list );
 377 }
 378
 379
 380 sub setPassword
 381 {
 382     my $self = shift;
 383     my $uid = shift;
 384     my $password = shift;
 385
 386     my $ok = 1;
 387     if( $self->userExists( $uid ) )
 388     {
 389         if( length( $password ) < $Torrus::ACL::minPasswordLength )
 390         {
 391             Error('Password too short: must be ' .
 392                   $Torrus::ACL::minPasswordLength . ' characters long');
 393             $ok = 0;
 394         }
 395         else
 396         {
 397             my $attrValues = $self->{'auth'}->setPassword( $uid, $password );
 398             $self->setUserAttributes( $uid, $attrValues );
 399             Info('Password set for ' . $uid);
 400         }
 401     }
 402     else
 403     {
 404         Error('Cannot change password for user ' . $uid .
 405               ': user does not exist');
 406         $ok = 0;
 407     }
 408     return $ok;
 409 }
 410
 411
 412 sub deleteUser
 413 {
 414     my $self = shift;
 415     my $uid = shift;
 416
 417     my $ok = 1;
 418     if( $self->userExists( $uid ) )
 419     {
 420         my $cursor = $self->{'db_users'}->cursor( -Write => 1 );
 421         while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
 422         {
 423             my( $selector, $dbuid ) = split(':', $key);
 424             if( ( $selector eq 'gm' or $selector eq 'ua' ) and
 425                 $dbuid eq $uid )
 426             {
 427                 $self->{'db_users'}->c_del( $cursor );
 428             }
 429         }
 430         undef $cursor;
 431
 432         Info('User deleted: ' . $uid);
 433     }
 434     else
 435     {
 436         Error('Cannot delete user ' . $uid . ': user does not exist');
 437         $ok = 0;
 438     }
 439     return $ok;
 440 }
 441
 442
 443 sub setGroupAttribute
 444 {
 445     my $self = shift;
 446     my $group = shift;
 447     my $attr = shift;
 448     my $val = shift;
 449
 450     my $ok = 1;
 451     if( length( $attr ) == 0 or $attr =~ /\W/ )
 452     {
 453         Error('Invalid attribute name: ' . $attr);
 454         $ok = 0;
 455     }
 456     else
 457     {
 458         $self->{'db_users'}->put( 'ga:' . $group . ':' . $attr, $val );
 459         $self->{'db_users'}->addToList( 'gA:' . $group, $attr );
 460         if( $attr ne 'modified' )
 461         {
 462             $self->setGroupModified( $group );
 463         }
 464         Debug('Set ' . $attr . ' for ' . $group . ': ' . $val);
 465     }
 466     return $ok;
 467 }
 468
 469
 470 sub listGroupAttributes
 471 {
 472     my $self = shift;
 473     my $group = shift;
 474
 475     my $list = $self->{'db_users'}->get( 'gA:' . $group );
 476
 477     return split( ',', $list );
 478 }
 479
 480
 481
 482 sub setGroupModified
 483 {
 484     my $self = shift;
 485     my $group = shift;
 486
 487     $self->setGroupAttribute( $group, 'modified',
 488                               scalar( localtime( time() ) ) );
 489 }
 490
 491
 492 sub setPrivilege
 493 {
 494     my $self = shift;
 495     my $group = shift;
 496     my $object = shift;
 497     my $privilege = shift;
 498
 499     my $ok = 1;
 500     if( $self->groupExists( $group ) )
 501     {
 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);
 506     }
 507     else
 508     {
 509         Error('Cannot set privilege for group ' . $group .
 510               ': group does not exist');
 511         $ok = 0;
 512     }
 513     return $ok;
 514 }
 515
 516
 517 sub clearPrivilege
 518 {
 519     my $self = shift;
 520     my $group = shift;
 521     my $object = shift;
 522     my $privilege = shift;
 523
 524     my $ok = 1;
 525     if( $self->groupExists( $group ) )
 526     {
 527         my $key = $group.':'.$object.':'.$privilege;
 528         if( $self->{'db_acl'}->get( $key ) )
 529         {
 530             $self->{'db_acl'}->del( $key );
 531             $self->setGroupModified( $group );
 532             Info('Privilege ' . $privilege . ' for object ' . $object .
 533                  ' revoked from group ' . $group);
 534         }
 535     }
 536     else
 537     {
 538         Error('Cannot revoke privilege from group ' . $group .
 539               ': group does not exist');
 540         $ok = 0;
 541     }
 542     return $ok;
 543 }
 544
 545
 546 sub listPrivileges
 547 {
 548     my $self = shift;
 549     my $group = shift;
 550
 551     my $ret = {};
 552
 553     my $cursor = $self->{'db_acl'}->cursor();
 554     while( my ($key, $val) = $self->{'db_acl'}->next( $cursor ) )
 555     {
 556         my( $dbgroup, $object, $privilege ) = split( ':', $key );
 557         if( $dbgroup eq $group )
 558         {
 559             $ret->{$object}{$privilege} = 1;
 560         }
 561     }
 562     undef $cursor;
 563
 564     return $ret;
 565 }
 566
 567
 568 sub clearConfig
 569 {
 570     my $self = shift;
 571
 572     $self->{'db_acl'}->trunc();
 573     $self->{'db_users'}->trunc();
 574
 575     Info('Cleared the ACL configuration');
 576     return 1;
 577 }
 578
 579 sub exportACL
 580 {
 581     my $self = shift;
 582     my $exportfile = shift;
 583     my $exporttemplate = shift;
 584
 585     my $ok;
 586     eval 'require Torrus::ACL::Export;
 587           $ok = Torrus::ACL::Export::exportACL( $self, $exportfile,
 588                                               $exporttemplate );';
 589     if( $@ )
 590     {
 591         Error($@);
 592         return 0;
 593     }
 594     else
 595     {
 596         return $ok;
 597     }
 598 }
 599
 600 sub importACL
 601 {
 602     my $self = shift;
 603     my $importfile = shift;
 604
 605     my $ok;
 606     eval 'require Torrus::ACL::Import;
 607           $ok = Torrus::ACL::Import::importACL( $self, $importfile );';
 608
 609     if( $@ )
 610     {
 611         Error($@);
 612         return 0;
 613     }
 614     else
 615     {
 616         return $ok;
 617     }
 618 }
 619
 620 1;
 621
 622
 623 # Local Variables:
 624 # mode: perl
 625 # indent-tabs-mode: nil
 626 # perl-indent-level: 4
 627 # End: