Apache-iNcom
view release on metacpan or search on metacpan
* demo/incom.sql: Fix errors in group_acl index definitions.
* lib/Apache/iNcom.pm (new_session_handler): Forgot to pass
request object in call to return_error.
(dispatch_handler): Added Pragma and Cache-control headers for
browser that ignores the Expires header.
1999-11-01 Francis J. Lacoste <francis.lacoste@iNsu.COM>
* lib/DBIx/UserDB.pm (group_get): $gid renamed to $gidorname.
* lib/Apache/iNcom/OrderManager.pm (checkout): Variable $profile
is really variable $order. items is an array ref. Remove
Data::Dumper reference.
(order_report): %fdat of calling page was overwritten. Order data
is now passed into the %order global hash.
* lib/Apache/iNcom/CartManager.pm (apply_charges): Didn't
deference array.
(apply_discount): Ditto.
* lib/Apache/iNcom/Localizer.pm (pod): Added module documentation.
* lib/Apache/iNcom/Session.pm (pod): Added module documentation.
* lib/DBIx/UserDB.pm (license): Changed license to perl terms.
(user_search): Pass all arguments to underlying record_search.
(user_get): Accept either a uid or username.
(user_update): Removed unused $data variable.
(group_search): Pass all arguments to underlying record_search.
(group_get): Accept either a gid or groupname.
(group_update): New method.
(pod): Added module documentation.
* lib/DBIx/SearchProfiles.pm (pod): Completed documentation.
1999-10-21 Francis J. Lacoste <francis.lacoste@iNsu.COM>
* lib/DBIx/SearchProfiles.pm (new): Possibility to specify
DBI parameters to open a connection. Possibility to give the
demo/incom.sql view on Meta::CPAN
s_country CHAR(2),
s_zipcode CHAR(32),
email CHAR(128),
day_phone CHAR(20),
night_phone CHAR(20)
);
CREATE UNIQUE INDEX userdb_idx ON userdb (username);
CREATE TABLE groupdb (
gid SERIAL PRIMARY KEY,
groupname CHAR(32) UNIQUE
);
CREATE UNIQUE INDEX groupdb_idx ON groupdb (groupname);
CREATE TABLE groupmembers (
gid INT REFERENCES groupdb,
uid INT REFERENCES userdb,
PRIMARY KEY (gid,uid)
);
CREATE INDEX group2users_idx ON groupmembers (gid);
CREATE INDEX user2groups_idx ON groupmembers (uid);
CREATE TABLE user_acl (
uid INT REFERENCES userdb,
target CHAR(128),
privilege CHAR(32),
negated BOOL DEFAULT 0,
PRIMARY KEY (uid,target,privilege)
);
CREATE INDEX user_acl_uid_idx ON user_acl (uid);
CREATE INDEX user_acl_target_idx ON user_acl (target);
CREATE TABLE group_acl (
gid INT REFERENCES groupdb,
target CHAR(128),
privilege CHAR(32),
negated BOOL DEFAULT 0,
PRIMARY KEY (gid,target,privilege)
);
CREATE INDEX group_acl_uid_idx ON group_acl (gid);
CREATE INDEX group_acl_target_idx ON group_acl (target);
CREATE TABLE default_acl (
target CHAR(128),
privilege CHAR(32),
negated BOOL DEFAULT 0,
PRIMARY KEY (target,privilege)
);
CREATE INDEX default_acl_target_idx ON user_acl (target);
lib/DBIx/UserDB.pm view on Meta::CPAN
group schema may be modified for application specific data since only
a few fields are required by the UserDB. This is possible thanks to
DBIx::SearchProfiles.
=head1 CONCEPTS
=head2 Users and Groups
Users are represented as hash and as one SQL table. They have a unique
username and a unique uid. Group have also a unique name and a unique
gid. A user may be a members of many groups.
=head2 ACLs
UserDB can also be used to manage complex ACL (Acccess Control Lists).
Access to resources is determined by the tuple (user,target,privilege)
which determines if a I<user> has the required I<privilege> on
I<target>. I<Privilege> and I<target> are treated as application
specific character strings.
=head1 CONFIGURATION
lib/DBIx/UserDB.pm view on Meta::CPAN
Here is the minimal schema required in your DBMS :
CREATE TABLE userdb (
uid SERIAL PRIMARY KEY,
username CHAR(32) UNIQUE,
password CHAR(32)
);
CREATE TABLE groupdb (
gid SERIAL PRIMARY KEY,
groupname CHAR(32) UNIQUE
);
CREATE TABLE groupmembers (
gid INT REFERENCES groupdb,
uid INT REFERENCES userdb,
PRIMARY KEY (gid,uid)
);
CREATE TABLE user_acl (
uid INT REFERENCES userdb,
target CHAR(128),
privilege CHAR(32),
negated BOOL DEFAULT 0,
PRIMARY KEY (uid,target,privilege)
);
CREATE TABLE group_acl (
gid INT REFERENCES groupdb,
target CHAR(128),
privilege CHAR(32),
negated BOOL DEFAULT 0,
PRIMARY KEY (gid,target,privilege)
);
CREATE TABLE default_acl (
target CHAR(128),
privilege CHAR(32),
negated BOOL DEFAULT 0,
PRIMARY KEY (target,privilege)
);
This SQL was tested with PostgreSQL, modify according to your RDBMS.
lib/DBIx/UserDB.pm view on Meta::CPAN
{
userdb =>
{
fields => [qw( username password ) ],
keys => [qw( uid )],
table => "userdb",
},
groupdb =>
{
query => q{ SELECT m.gid,uid,groupname FROM groupdb, groupmembers m
WHERE uid = ? },
params => [ qw( uid ) ],
fields => [ qw( groupname ) ],
keys => [ qw( gid )],
table => "groupdb",
} ,
}
You may add any fields to the groupdb and userdb tables as long as you
add them to the profiles. The I<userdb> profile should be a C<record>
profile (see DBIx::SearchProfiles(3)) and I<groupdb> should contains
both template profile's information (for finding the users associated
with a group) and record profile's information (for inserting and
updating group's information). Additionaly you may change the fields
lib/DBIx/UserDB.pm view on Meta::CPAN
Here are the methods to manage group information
=head2 group_create ( \%group )
This method creates a new group in the database. At least the
I<groupname> key should be set in the hash.
This methods returns false if there is already a group with the same
groupname. It returns true if the creation succeeded. Additionnaly, on
return, the key I<gid> will be set in the original group's hash.
=cut
sub group_create {
my ( $self, $group ) = @_;
my $DB = $self->{DB};
# Check for group with same name
my $old_group = $DB->record_search( $self->{group_profile},
lib/DBIx/UserDB.pm view on Meta::CPAN
$group->{$name} = $value;
}
return $group;
}
sub load_group {
my ( $self, $group ) = @_;
$group->{members} =
$self->{DB}->sql_search( q{ SELECT uid FROM groupmembers WHERE gid = ? },
$group->{gid} );
return $group;
}
=pod
=head2 group_search ( \%params )
This method will search the database for groups matching the
DBIx::SearchProfiles record search and will return its results as a
lib/DBIx/UserDB.pm view on Meta::CPAN
my $groups = $self->{DB}->record_search( $self->{group_profile}, @_ );
for my $group( @$groups) {
$self->load_group( $group );
}
return $groups;
}
=pod
=head2 group_get ( $gid_or_name )
This method takes a gid or groupname and will fetch the corresponding
group. It returns the corresponding group or undef if there is no such
group. Additionnaly there is a key I<members> defined in the resulting
hash which contains in an array the name of all members of the group.
=cut
sub group_get {
my ( $self, $gidorname ) = @_;
my $group;
if ( $gidorname =~ /\d+/ ) {
$group = $self->{DB}->record_get( $self->{group_profile}, $gidorname );
return undef unless $group;
} else {
my $groups = $self->{DB}->record_search( $self->{group_profile},
{ groupname => $gidorname } );
return undef unless @$groups;
$group = $groups->[0];
}
$self->load_group( $group );
}
=pod
=head2 group_delete ( \%group )
This methods removes the given group from the database.
=cut
sub group_delete {
my ( $self, $group ) = @_;
my $DB = $self->{DB};
$DB->sql_delete( q{ DELETE FROM groupmembers WHERE gid = ? },
$group->{gid} );
$DB->record_delete( $self->{group_profile}, $group->{gid} );
}
=pod
=head2 group_update ( \%group )
This methods updates the information associated with the given group
in that database. This methods doesn't modify the list of members of
this group. User C<group_add_user> and C<group_remove_user> for that.
lib/DBIx/UserDB.pm view on Meta::CPAN
=head2 group_add_user ( \%group, \%user )
Adds the user to that group.
=cut
sub group_add_user {
my ( $self, $group, $user ) = @_;
my $DB = $self->{DB};
$DB->sql_insert( q{ INSERT INTO groupmembers (gid,uid)
VALUES (?,?) },
$group->{gid}, $user->{uid} );
push @{$group->{members}}, $user->{uid};
}
=pod
=head2 group_remove_user ( \%group, \%user )
Removes the user from that group.
=cut
sub group_remove_user {
my ( $self, $group, $user ) = @_;
my $DB = $self->{DB};
$DB->sql_insert( q{ DELETE FROM groupmembers WHERE gid = ? AND uid = ?) },
$group->{gid}, $user->{uid} );
$group->{members} = [ grep { $_ != $user->{uid} } @{$group->{members} } ];
}
=pod
=head1 ACL METHODS
Here are the methods to access the ACL information :
lib/DBIx/UserDB.pm view on Meta::CPAN
$rv = $DB->sql_update( q{ UPDATE default_acl SET negated = ?
WHERE target = ? AND privilege = ? },
$negated, $target, $priv );
} elsif ( exists $whom->{uid} ) {
$rv = $DB->sql_update( q{ UPDATE user_acl SET negated = ?
WHERE uid = ? AND target = ?
AND privilege = ? },
$negated, $whom->{uid}, $target, $priv );
} else {
$rv = $DB->sql_updated( q{ UPDATED group_acl SET negated = ?
WHERE gid = ? AND target = ?
AND privilege = ? },
$negated, $whom->{gid}, $target, $priv );
}
unless ( $rv ) {
if ( not ref $whom) {
$DB->sql_insert( q{ INSERT INTO default_acl
(target,privilege,negated)
VALUES (?,?,?) },
$target, $priv, $negated );
} elsif ( exists $whom->{uid} ) {
$DB->sql_insert( q{ INSERT INTO user_acl
(uid,target,privilege,negated)
VALUES (?,?,?,?) },
$whom->{uid}, $target, $priv, $negated );
} else {
$DB->sql_insert( q{ INSERT INTO group_acl
(gid,target,privilege,negated)
VALUES (?,?,?,?) },
$whom->{gid}, $target, $priv, $negated );
}
}
}
=pod
=head2 revoke ( \%user_or_group, $target, $privilege )
Removes the specified I<privilege> on I<target> associated with user
or group. If you want to remove the default policy, use undef as the
lib/DBIx/UserDB.pm view on Meta::CPAN
if ( not ref $whom) {
$DB->sql_delete( q{ DELETE FROM default_acl
WHERE target = ? AND privilege = ? },
$target, $priv );
} elsif ( exists $whom->{uid} ) {
$DB->sql_delete( q{ DELETE FROM user_acl
WHERE uid = ? AND target = ? AND privilege = ? },
$whom->{uid}, $target, $priv );
} else {
$DB->sql_delete( q{ DELETE FROM group_acl
WHERE gid = ? AND target = ? AND privilege = ? },
$whom->{gid}, $target, $priv );
}
}
=pod
=head2 allowed ( \%user, $target, $privilege )
Determine if I<user> has I<prilivege> on I<target>. This how the access is determined :
=over
lib/DBIx/UserDB.pm view on Meta::CPAN
my $user_policy =
$DB->sql_get( q{ SELECT negated FROM user_acl
WHERE uid = ? AND target = ? AND privilege = ? },
$user->{uid}, $target, $priv
);
return not $user_policy->{negated} if $user_policy;
# Now check the group in which this user is.
# All the group policy must match for this to be returned as
# a result. If there is a conflict, we use the default policy.
my $groups = join ",", map { $_->{gid} } @{$user->{groups}};
my $group_policy =
$DB->sql_search( qq{ SELECT DISTINCT negated FROM group_acl
WHERE gid IN ( $groups ) AND
target = ? AND privilege = ?},
$target, $priv );
return not $group_policy->[0]{negated} if @$group_policy == 1;
# Use the default policy
my $default_policy =
$DB->sql_get( q{ SELECT negated FROM default_acl
WHERE target = ? AND privilege = ? },
$target, $priv );
( run in 0.883 second using v1.01-cache-2.11-cpan-5735350b133 )