torrus/perllib/Torrus/ACL.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: ACL.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20
  21 package Torrus::ACL;
  22
  23 use Torrus::DB;
  24 use Torrus::Log;
  25
  26 use strict;
  27
  28 BEGIN
  29 {
  30     eval( 'require ' . $Torrus::ACL::userAuthModule );
  31     die( $@ ) if $@;
  32 }
  33
  34 sub new
  35 {
  36     my $self = {};
  37     my $class = shift;
  38     my %options = @_;
  39     bless $self, $class;
  40
  41     eval( '$self->{"auth"} = new ' . $Torrus::ACL::userAuthModule );
  42     die( $@ ) if $@;
  43
  44     my $writing = $options{'-WriteAccess'};
  45
  46     $self->{'db_users'} = new Torrus::DB('users', -WriteAccess => $writing );
  47     defined( $self->{'db_users'} ) or return( undef );
  48
  49     $self->{'db_acl'} = new Torrus::DB('acl', -WriteAccess => $writing );
  50     defined( $self->{'db_acl'} ) or return( undef );
  51
  52     $self->{'is_writing'} = $writing;
  53
  54     return $self;
  55 }
  56
  57
  58 sub DESTROY
  59 {
  60     my $self = shift;
  61
  62     Debug('Destroying ACL object');
  63
  64     undef $self->{'db_users'};
  65     undef $self->{'db_acl'};
  66 }
  67
  68
  69 sub hasPrivilege
  70 {
  71     my $self = shift;
  72     my $uid = shift;
  73     my $object = shift;
  74     my $privilege = shift;
  75
  76     foreach my $group ( $self->memberOf( $uid ) )
  77     {
  78         if( $self->{'db_acl'}->get( $group.':'.$object.':'.$privilege ) )
  79         {
  80             Debug('User ' . $uid . ' has privilege ' . $privilege .
  81                   ' for ' . $object);
  82             return 1;
  83         }
  84     }
  85
  86     if( $object ne '*' )
  87     {
  88         return $self->hasPrivilege( $uid, '*', $privilege );
  89     }
  90
  91     Debug('User ' . $uid . ' has NO privilege ' . $privilege .
  92           ' for ' . $object);
  93     return undef;
  94 }
  95
  96
  97 sub memberOf
  98 {
  99     my $self = shift;
 100     my $uid = shift;
 101
 102     my $glist = $self->{'db_users'}->get( 'gm:' . $uid );
 103     return( defined( $glist ) ? split(',', $glist) : () );
 104 }
 105
 106
 107 sub authenticateUser
 108 {
 109     my $self = shift;
 110     my $uid = shift;
 111     my $password = shift;
 112
 113     my @attrList = $self->{'auth'}->getUserAttrList();
 114     my $attrValues = {};
 115     foreach my $attr ( @attrList )
 116     {
 117         $attrValues->{$attr} = $self->userAttribute( $uid, $attr );
 118     }
 119
 120     my $ret = $self->{'auth'}->authenticateUser( $uid, $password,
 121                                                  $attrValues );
 122     Debug('User authentication: uid=' . $uid . ', result=' .
 123           ($ret ? 'true':'false'));
 124     return $ret;
 125 }
 126
 127
 128 sub userAttribute
 129 {
 130     my $self = shift;
 131     my $uid = shift;
 132     my $attr = shift;
 133
 134     return $self->{'db_users'}->get( 'ua:' . $uid . ':' . $attr );
 135 }
 136
 137
 138 sub groupAttribute
 139 {
 140     my $self = shift;
 141     my $group = shift;
 142     my $attr = shift;
 143
 144     return $self->{'db_users'}->get( 'ga:' . $group . ':' . $attr );
 145 }
 146
 147
 148
 149 1;
 150
 151
 152 # Local Variables:
 153 # mode: perl
 154 # indent-tabs-mode: nil
 155 # perl-indent-level: 4
 156 # End: