\r\n\r\nGroup Name
\r\nA name for the group. It is best if the name is descriptive so you know what it is at a glance.\r\n
\r\n\r\nDescription
\r\nA longer description of the group so that other admins and content managers (or you if you forget) will know what the purpose of this group is.\r\n
\r\n\r\nExpire Offset
\r\nThe amount of time that a user will belong to this group before s/he is expired (or removed) from it. This is very useful for membership sites where users have certain privileges for a specific period of time. \r\n
\r\nNOTE: This can be overridden on a per-user basis.\r\n
\r\n\r\nNotify user about expiration?
\r\nSet this value to yes if you want WebGUI to contact the user when they are about to be expired from the group.\r\n
\r\n\r\nExpire Notification Offset
\r\nThe difference in the number of days from the expiration to the notification. You may set this to any valid integer. For instance, set this to "0" if you wish the notification to be sent on the same day that the grouping expires. Set it to "-7" if you want the notification to go out 7 days before the grouping expires. Set it to "7" if you wish the notification to be sent 7 days after the expiration.\r\n
\r\n\r\nExpire Notification Message
\r\nType the message you wish to be sent to the user telling them about the expiration.\r\n
\r\n\r\nDelete Offset
\r\nThe difference in the number of days from the expiration to the grouping being deleted from the system. You may set this to any valid integer. For instance, set this to "0" if you wish the grouping to be deleted on the same day that the grouping expires. Set it to "-7" if you want the grouping to be deleted 7 days before the grouping expires. Set it to "7" if you wish the grouping to be deleted 7 days after the expiration.\r\n
\r\n\r\nIP Address
\r\nSpecify an IP address or an IP mask to match. If the user\'s IP address matches, they\'ll automatically be included in this group. An IP mask is simply the IP address minus an octet or two. You may also specify multiple IP masks separated by semicolons.\r\n
\r\nIP Mask Example: 10.;192.168.;101.42.200.142\r\n
\r\n\r\nKarma Threshold
\r\nIf you\'ve enabled Karma, then you\'ll be able to set this value. Karma Threshold is the amount of karma a user must have to be considered part of this group.\r\n
\r\n\r\n\r\nUsers can add themselves?
\r\nDo you wish to let users add themselves to this group? See the GroupAdd macro for more info.\r\n
\r\n\r\nUsers can remove themselves?
\r\nDo you wish to let users remove themselves from this group? See the GroupDelete macro for more info.\r\n
\r\n\r\nThe following options are recommended only for advanced WebGUI administrators.\r\n
\r\n\r\nDatabase Link
\r\nIf you\'d like to have this group validate users using an external database, choose the database link to use.\r\n
\r\n\r\nSQL Query
\r\nMany organizations have external databases that map users to groups; for example an HR database might map Employee ID to Health Care Plan. To validate users against an external database, you need to construct a SQL statement that will return 1 if a user is in the group. Make sure to begin your statement with "select 1". You may use macros in this query to access data in a user\'s profile, such as Employee ID. Here is an example that checks a user against a fictional HR database. This assumes you have created an additional profile field called employeeId.
\r\n
\r\nselect 1 from employees, health_plans, empl_plan_map
\r\nwhere employees.employee_id = ^User("employeeId");
\r\nand health_plans.plan_name = \'HMO 1\'
\r\nand employees.employee_id = empl_plan_map.employee_id
\r\nand health_plans.health_plan_id = empl_plan_mp.health_plan_id
\r\n
\r\nThis group could then be named "Employees in HMO 1", and would allow you to restrict any page or wobject to only those users who are part of this health plan in the external database.\r\n
\r\n\r\nCache external groups for how long?
\r\nLarge sites using external group data will be making many calls to the external database. To help reduce the load, you may select how long you\'d like to cache the results of the external database query within the WebGUI database. More advanced background caching may be included in a future version of WebGUI.',1053779630);
diff --git a/lib/WebGUI/DatabaseLink.pm b/lib/WebGUI/DatabaseLink.pm
index 1c61769b0..8aa8a704e 100644
--- a/lib/WebGUI/DatabaseLink.pm
+++ b/lib/WebGUI/DatabaseLink.pm
@@ -34,6 +34,10 @@ This package contains utility methods for WebGUI's database link system.
%links = WebGUI::DatabaseLink::getHash();
%databaseLink = WebGUI::DatabaseLink::get($databaseLinkId);
%using = WebGUI::Databaselink::whatIsUsing($databaseLinkId);
+
+ $dbLink = WebGUI::DatabaseLink->new($databaseLinkId);
+ $dbh = $dbLink->dbh;
+ $dbLink->disconnect;
=head1 METHODS
@@ -75,7 +79,8 @@ sub get {
#-------------------------------------------------------------------
=head2 whatIsUsing ( databaseLinkId )
-Returns an array of hashrefs containing wobjects which use a database link.
+Returns an array of hashrefs containing items which use a database link. This method will
+need to be updated any time a new item starts using Database Links.
=over
@@ -88,6 +93,7 @@ A valid databaseLinkId
=cut
sub whatIsUsing {
+ # get list of SQLReports
my $sql = 'select wobject.wobjectId, wobject.title, page.menuTitle, page.urlizedTitle from wobject, SQLReport, page '.
'where SQLReport.databaseLinkId = '.$_[0].' and SQLReport.wobjectId = wobject.wobjectId '.
'and wobject.pageId = page.pageId';
@@ -97,8 +103,98 @@ sub whatIsUsing {
push @using, $data;
}
$sth->finish;
+
+ # get list of groups
+ $sql = 'select groupId, groupName from groups where databaseLinkId = '.$_[0];
+ $sth = WebGUI::SQL->read($sql);
+ while (my $data = $sth->hashRef()) {
+ push @using, $data;
+ }
+ $sth->finish;
+
return @using;
}
+#-------------------------------------------------------------------
+=head2 disconnect ( )
+
+Disconnect cleanly from the current databaseLink.
+
+=cut
+
+sub disconnect {
+ my ($class, $value);
+ $class = shift;
+ $value = shift;
+ if (defined $class->{_dbh}) {
+ $class->{_dbh}->disconnect() unless ($class->{_databaseLink}{DSN} eq $session{config}{dsn});
+ }
+}
+
+#-------------------------------------------------------------------
+=head2 dbh ( )
+
+Return a DBI handle for the current databaseLink, connecting if necessary.
+
+=cut
+
+sub dbh {
+ my ($class, $value);
+ my ($dsn, $username, $identifier);
+ $class = shift;
+ $value = shift;
+
+ if (defined $class->{_dbh}) {
+ return $class->{_dbh};
+ }
+
+ $dsn = $class->{_databaseLink}{DSN};
+ $username = $class->{_databaseLink}{username};
+ $identifier = $class->{_databaseLink}{identifier};
+ if ($dsn eq $session{config}{dsn}) {
+ $class->{_dbh} = $session{dbh};
+ return $session{dbh};
+ } elsif ($dsn =~ /\DBI\:\w+\:\w+/i) {
+ eval{
+ $class->{_dbh} = DBI->connect($dsn,$username,$identifier);
+ };
+ if ($@) {
+ WebGUI::ErrorHandler::warn("DatabaseLink [".$_[0]."] ".$@);
+ } else {
+ return $class->{_dbh};
+ }
+ } else {
+ WebGUI::ErrorHandler::warn("DatabaseLink [".$_[0]."] The DSN specified is of an improper format.");
+ }
+ return undef;
+}
+
+#-------------------------------------------------------------------
+
+=head2 new ( databaseLinkId )
+
+Constructor.
+
+=over
+
+=item databaseLinkId
+
+The databaseLinkId of the databaseLink you're creating an object reference for.
+
+=back
+
+=cut
+
+sub new {
+ my ($class, $databaseLinkId, %databaseLink);
+ tie %databaseLink, 'Tie::CPHash';
+ $class = shift;
+ $databaseLinkId = shift;
+ unless ($databaseLinkId eq "") {
+ %databaseLink = WebGUI::SQL->quickHash("select * from databaseLink where databaseLinkId='$databaseLinkId'");
+ }
+ bless {_databaseLinkId => $databaseLinkId, _databaseLink => \%databaseLink }, $class;
+}
+
1;
diff --git a/lib/WebGUI/Group.pm b/lib/WebGUI/Group.pm
index aafa96b6b..3122c8e83 100755
--- a/lib/WebGUI/Group.pm
+++ b/lib/WebGUI/Group.pm
@@ -535,6 +535,7 @@ sub new {
$group{expireNotifyOffset} = -14;
$group{deleteOffset} = 14;
$group{expireNotify} = 0;
+ $group{dbCacheTimeout} = 3600;
} else {
%group = WebGUI::SQL->quickHash("select * from groups where groupId='$groupId'");
}
@@ -569,6 +570,90 @@ sub scratchFilter {
return $class->{_group}{"scratchFilter"};
}
+#-------------------------------------------------------------------
+
+=head2 dbQuery ( [ value ] )
+
+Returns the dbQuery for this group.
+
+=over
+
+=item value
+
+If specified, the dbQuery is set to this value.
+
+=back
+
+=cut
+
+sub dbQuery {
+ my ($class, $value);
+ $class = shift;
+ $value = shift;
+ if (defined $value) {
+ $class->{_group}{"dbQuery"} = $value;
+ WebGUI::SQL->write("update groups set dbQuery=".quote($value).",
+ lastUpdated=".time()." where groupId=$class->{_groupId}");
+ }
+ return $class->{_group}{"dbQuery"};
+}
+
+#-------------------------------------------------------------------
+
+=head2 databaseLinkId ( [ value ] )
+
+Returns the databaseLinkId for this group.
+
+=over
+
+=item value
+
+If specified, the databaseLinkId is set to this value.
+
+=back
+
+=cut
+
+sub databaseLinkId {
+ my ($class, $value);
+ $class = shift;
+ $value = shift;
+ if (defined $value) {
+ $class->{_group}{"databaseLinkId"} = $value;
+ WebGUI::SQL->write("update groups set databaseLinkId=".quote($value).",
+ lastUpdated=".time()." where groupId=$class->{_groupId}");
+ }
+ return $class->{_group}{"databaseLinkId"};
+}
+
+#-------------------------------------------------------------------
+
+=head2 dbCacheTimeout ( [ value ] )
+
+Returns the dbCacheTimeout for this group.
+
+=over
+
+=item value
+
+If specified, the dbCacheTimeout is set to this value.
+
+=back
+
+=cut
+
+sub dbCacheTimeout {
+ my ($class, $value);
+ $class = shift;
+ $value = shift;
+ if (defined $value) {
+ $class->{_group}{"dbCacheTimeout"} = $value;
+ WebGUI::SQL->write("update groups set dbCacheTimeout=".quote($value).",
+ lastUpdated=".time()." where groupId=$class->{_groupId}");
+ }
+ return $class->{_group}{"dbCacheTimeout"};
+}
+
1;
diff --git a/lib/WebGUI/Operation/DatabaseLink.pm b/lib/WebGUI/Operation/DatabaseLink.pm
index 0796af840..a247af8fa 100644
--- a/lib/WebGUI/Operation/DatabaseLink.pm
+++ b/lib/WebGUI/Operation/DatabaseLink.pm
@@ -60,8 +60,12 @@ sub www_deleteDatabaseLink {
$output .= '
'; foreach my $using (WebGUI::DatabaseLink::whatIsUsing($session{form}{dlid})) { - $output .= '
'; - return $output; -} - -#------------------------------------------------------------------- - -=head2 canEditPage ( [ pageId ] ) - -Returns a boolean (0|1) value signifying that the user has the required privileges. - -=over - -=item pageId - -The unique identifier for the page that you wish to check the privileges on. Defaults to the current page id. - -=back - -=cut - -sub canEditPage { - my (%page); - tie %page, 'Tie::CPHash'; - if ($_[0] ne "") { - %page = WebGUI::SQL->quickHash("select ownerId,groupIdEdit from page where pageId=$_[0]"); - } else { - %page = %{$session{page}}; - } - if ($session{user}{userId} == $page{ownerId}) { - return 1; - } elsif (isInGroup($page{groupIdEdit})) { - return 1; - } else { - return 0; - } -} - -#Added by Frank Dillon. Wobject API not used due to possible performance issues -#------------------------------------------------------------------- - -=head2 canEditWobject ( wobjectId ) - -Returns a boolean (0|1) value signifying that the user has the required privileges. - -=over - -=item wobjectId - -The unique identifier for the wobject that you wish to check the privileges on. - -=back - -=cut - -sub canEditWobject { - my (%wobject); - tie %wobject, 'Tie::CPHash'; - return canEditPage() unless ($session{setting}{wobjectPrivileges} == 1); - %wobject = WebGUI::SQL->quickHash("select ownerId,groupIdEdit from wobject where wobjectId=".quote($_[0])); - if ($session{user}{userId} == $wobject{ownerId}) { - return 1; - } elsif (isInGroup($wobject{groupIdEdit})) { - return 1; - } else { - return 0; - } -} - -#------------------------------------------------------------------- - -=head2 canViewPage ( [ pageId ] ) - -Returns a boolean (0|1) value signifying that the user has the required privileges. Always returns true for Admins and users that have the rights to edit this page. - -=over - -=item pageId - -The unique identifier for the page that you wish to check the privileges on. Defaults to the current page id. - -=back - -=cut - -sub canViewPage { - my (%page, $inDateRange); - tie %page, 'Tie::CPHash'; - if ($_[0] eq "") { - %page = %{$session{page}}; - } else { - %page = WebGUI::SQL->quickHash("select ownerId,groupIdView,startDate,endDate from page where pageId=$_[0]"); - } - if ($page{startDate} < time() && $page{endDate} > time()) { - $inDateRange = 1; - } - if ($session{user}{userId} == $page{ownerId}) { - return 1; - } elsif (isInGroup($page{groupIdView}) && $inDateRange) { - return 1; - } elsif (canEditPage($_[0])) { - return 1; - } else { - return 0; - } -} - -#Added by Frank Dillon. Wobject API not used due to possible performance issues -#------------------------------------------------------------------- - -=head2 canViewWobject ( wobjectId ) - -Returns a boolean (0|1) value signifying that the user has the required privileges. Always returns true for Admins and users that have the rights to edit this wobject. - -=over - -=item wobjectId - -The unique identifier for the wobject that you wish to check the privileges on. - -=back - -=cut - -sub canViewWobject { - my (%wobject); - tie %wobject, 'Tie::CPHash'; - return canViewPage() unless ($session{setting}{wobjectPrivileges} == 1); - %wobject = WebGUI::SQL->quickHash("select ownerId,groupIdView,startDate,endDate from wobject where wobjectId=".quote($_[0])); - if ($wobject{startDate} < time() && $wobject{endDate} > time()) { - if ($session{user}{userId} == $wobject{ownerId}) { - return 1; - } elsif (isInGroup($wobject{groupIdView})) { - return 1; - } elsif (canEditWobject($_[0])) { - return 1; - } else { - return 0; - } - }else{ - return 0; - } -} - -#------------------------------------------------------------------- - -=head2 insufficient ( ) - -Returns a message stating that the user does not have the required privileges to perform the operation they requested. This method also sets the HTTP header status to 401. - -=cut - -sub insufficient { - if($session{env}{MOD_PERL}) { - my $r = Apache->request; - if(defined($r)) { - $r->custom_response(401, '' ); - $r->status(401); - } - } else { - $session{header}{status} = 401; - } - my ($output); - $output = '
'; - return $output; -} - -#------------------------------------------------------------------- - -=head2 isInGroup ( groupId [ , userId ] ) - -Returns a boolean (0|1) value signifying that the user has the required privileges. Always returns true for Admins. - -=over - -=item groupId - -The group that you wish to verify against the user. - -=item userId - -The user that you wish to verify against the group. Defaults to the currently logged in user. - -=back - -=cut - -sub isInGroup { - my ($gid, $uid, @data, %group, $groupId); - ($gid, $uid) = @_; - $uid = $session{user}{userId} if ($uid eq ""); - ### The "Everyone" group automatically returns true. - if ($gid == 7) { - return 1; - } - ### The "Visitor" group returns false, unless the user is visitor. - if ($gid == 1) { - if ($uid == 1) { - return 1; - } else { - return 0; - } - } - ### The "Registered Users" group returns true if user is not visitor. - if ($gid==2 && $uid != 1) { - return 1; - } - ### Use session to cache multiple lookups of the same group. - if ($session{isInGroup}{$gid}{$uid} || $session{isInGroup}{3}{$uid}) { - return 1; - } elsif ($session{isInGroup}{$gid}{$uid} eq "0") { - return 0; - } - ### Lookup the actual groupings. - my $groups = WebGUI::Grouping::getGroupsForUser($uid,1); - foreach (@{$groups}) { - $session{isInGroup}{$_}{$uid} = 1; - } - if ($session{isInGroup}{$gid}{$uid} || $session{isInGroup}{3}{$uid}) { - return 1; - } - ### Get data for auxillary checks. - tie %group, 'Tie::CPHash'; - %group = WebGUI::SQL->quickHash("select karmaThreshold,ipFilter,scratchFilter from groups where groupId='$gid'"); - ### Check IP Address - if ($group{ipFilter} ne "") { - $group{ipFilter} =~ s/\t//g; - $group{ipFilter} =~ s/\r//g; - $group{ipFilter} =~ s/\n//g; - $group{ipFilter} =~ s/\s//g; - $group{ipFilter} =~ s/\./\\\./g; - my @ips = split(";",$group{ipFilter}); - foreach my $ip (@ips) { - if ($session{env}{REMOTE_ADDR} =~ /^$ip/) { - $session{isInGroup}{$gid}{$uid} = 1; - return 1; - } - } - } - ### Check Scratch Variables - if ($group{scratchFilter} ne "") { - $group{scratchFilter} =~ s/\t//g; - $group{scratchFilter} =~ s/\r//g; - $group{scratchFilter} =~ s/\n//g; - $group{scratchFilter} =~ s/\s//g; - my @vars = split(";",$group{scratchFilter}); - foreach my $var (@vars) { - my ($name, $value) = split(/\=/,$var); - if ($session{scratch}{$name} eq $value) { - $session{isInGroup}{$gid}{$uid} = 1; - return 1; - } - } - } - ### Check karma levels. - if ($session{setting}{useKarma}) { - my $karma; - if ($uid == $session{user}{userId}) { - $karma = $session{user}{karma}; - } else { - ($karma) = WebGUI::SQL->quickHash("select karma from users where userId='$uid'"); - } - if ($karma >= $group{karmaThreshold}) { - $session{isInGroup}{$gid}{$uid} = 1; - return 1; - } - } - ### Check for groups of groups. - $groups = WebGUI::Grouping::getGroupsInGroup($gid,1); - foreach (@{$groups}) { - $session{isInGroup}{$_}{$uid} = isInGroup($_, $uid); - if ($session{isInGroup}{$_}{$uid}) { - $session{isInGroup}{$gid}{$uid} = 1; - return 1; - } - } - $session{isInGroup}{$gid}{$uid} = 0; - return 0; -} - -#------------------------------------------------------------------- - -=head2 noAccess ( ) - -Returns a message stating that the user does not have the privileges necessary to access this page. This method also sets the HTTP header status to 401. - -=cut - -sub noAccess { - if($session{env}{MOD_PERL}) { - my $r = Apache->request; - if(defined($r)) { - $r->custom_response(401, '' ); - $r->status(401); - } - } else { - $session{header}{status} = 401; - } - my ($output); - if ($session{user}{userId} <= 1) { - $output = WebGUI::Operation::Account::www_displayAccount(); - } else { - $output = '
'; - } - return $output; -} - -#------------------------------------------------------------------- - -=head2 notMember ( ) - -Returns a message stating that the user they requested information about is no longer active on this server. This method also sets the HTTP header status to 400. - -=cut - -sub notMember { - if($session{env}{MOD_PERL}) { - my $r = Apache->request; - if(defined($r)) { - $r->custom_response(400, '' ); - $r->status(400); - } - } else { - $session{header}{status} = 400; - } - my ($output); - $output = '
'; - return $output; -} - -#------------------------------------------------------------------- - -=head2 vitalComponent ( ) - -Returns a message stating that the user made a request to delete something that should never delete. This method also sets the HTTP header status to 403. - -=cut - -sub vitalComponent { - if($session{env}{MOD_PERL}) { - my $r = Apache->request; - if(defined($r)) { - $r->custom_response(403, '' ); - $r->status(403); - } - } else { - $session{header}{status} = 403; - } - my ($output); - $output = '
'; - return $output; -} - - - - - - -1; - +package WebGUI::Privilege; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=cut + +use strict; +use Tie::CPHash; +use WebGUI::DatabaseLink; +use WebGUI::DateTime; +use WebGUI::Group; +use WebGUI::Grouping; +use WebGUI::International; +use WebGUI::Macro; +use WebGUI::Operation::Account (); +use WebGUI::Session; +use WebGUI::SQL; +use WebGUI::URL; + +=head1 NAME + +Package WebGUI::Privilege + +=head1 DESCRIPTION + +This package provides access to the WebGUI security system and security messages. + +=head1 SYNOPSIS + + use WebGUI::Privilege; + $html = WebGUI::Privilege::adminOnly(); + $boolean = WebGUI::Privilege::canEditPage(); + $boolean = WebGUI::Privilege::canViewPage(); + $html = WebGUI::Privilege::insufficient(); + $boolean = WebGUI::Privilege::isInGroup($groupId); + $html = WebGUI::Privilege::noAccess(); + $html = WebGUI::Privilege::notMember(); + $html = WebGUI::Privilege::vitalComponent(); + +=head1 METHODS + +These functions are available from this package: + +=cut + +#------------------------------------------------------------------- + +=head2 adminOnly ( ) + +Returns a message stating that this functionality can only be used by administrators. This method also sets the HTTP header status to 401. + +=cut + +sub adminOnly { + if($session{env}{MOD_PERL}) { + my $r = Apache->request; + if(defined($r)) { + $r->custom_response(401, '' ); + $r->status(401); + } + } else { + $session{header}{status} = 401; + } + my ($output, $sth, @data); + $output = '
'; + return $output; +} + +#------------------------------------------------------------------- + +=head2 canEditPage ( [ pageId ] ) + +Returns a boolean (0|1) value signifying that the user has the required privileges. + +=over + +=item pageId + +The unique identifier for the page that you wish to check the privileges on. Defaults to the current page id. + +=back + +=cut + +sub canEditPage { + my (%page); + tie %page, 'Tie::CPHash'; + if ($_[0] ne "") { + %page = WebGUI::SQL->quickHash("select ownerId,groupIdEdit from page where pageId=$_[0]"); + } else { + %page = %{$session{page}}; + } + if ($session{user}{userId} == $page{ownerId}) { + return 1; + } elsif (isInGroup($page{groupIdEdit})) { + return 1; + } else { + return 0; + } +} + +#Added by Frank Dillon. Wobject API not used due to possible performance issues +#------------------------------------------------------------------- + +=head2 canEditWobject ( wobjectId ) + +Returns a boolean (0|1) value signifying that the user has the required privileges. + +=over + +=item wobjectId + +The unique identifier for the wobject that you wish to check the privileges on. + +=back + +=cut + +sub canEditWobject { + my (%wobject); + tie %wobject, 'Tie::CPHash'; + return canEditPage() unless ($session{setting}{wobjectPrivileges} == 1); + %wobject = WebGUI::SQL->quickHash("select ownerId,groupIdEdit from wobject where wobjectId=".quote($_[0])); + if ($session{user}{userId} == $wobject{ownerId}) { + return 1; + } elsif (isInGroup($wobject{groupIdEdit})) { + return 1; + } else { + return 0; + } +} + +#------------------------------------------------------------------- + +=head2 canViewPage ( [ pageId ] ) + +Returns a boolean (0|1) value signifying that the user has the required privileges. Always returns true for Admins and users that have the rights to edit this page. + +=over + +=item pageId + +The unique identifier for the page that you wish to check the privileges on. Defaults to the current page id. + +=back + +=cut + +sub canViewPage { + my (%page, $inDateRange); + tie %page, 'Tie::CPHash'; + if ($_[0] eq "") { + %page = %{$session{page}}; + } else { + %page = WebGUI::SQL->quickHash("select ownerId,groupIdView,startDate,endDate from page where pageId=$_[0]"); + } + if ($page{startDate} < time() && $page{endDate} > time()) { + $inDateRange = 1; + } + if ($session{user}{userId} == $page{ownerId}) { + return 1; + } elsif (isInGroup($page{groupIdView}) && $inDateRange) { + return 1; + } elsif (canEditPage($_[0])) { + return 1; + } else { + return 0; + } +} + +#Added by Frank Dillon. Wobject API not used due to possible performance issues +#------------------------------------------------------------------- + +=head2 canViewWobject ( wobjectId ) + +Returns a boolean (0|1) value signifying that the user has the required privileges. Always returns true for Admins and users that have the rights to edit this wobject. + +=over + +=item wobjectId + +The unique identifier for the wobject that you wish to check the privileges on. + +=back + +=cut + +sub canViewWobject { + my (%wobject); + tie %wobject, 'Tie::CPHash'; + return canViewPage() unless ($session{setting}{wobjectPrivileges} == 1); + %wobject = WebGUI::SQL->quickHash("select ownerId,groupIdView,startDate,endDate from wobject where wobjectId=".quote($_[0])); + if ($wobject{startDate} < time() && $wobject{endDate} > time()) { + if ($session{user}{userId} == $wobject{ownerId}) { + return 1; + } elsif (isInGroup($wobject{groupIdView})) { + return 1; + } elsif (canEditWobject($_[0])) { + return 1; + } else { + return 0; + } + }else{ + return 0; + } +} + +#------------------------------------------------------------------- + +=head2 insufficient ( ) + +Returns a message stating that the user does not have the required privileges to perform the operation they requested. This method also sets the HTTP header status to 401. + +=cut + +sub insufficient { + if($session{env}{MOD_PERL}) { + my $r = Apache->request; + if(defined($r)) { + $r->custom_response(401, '' ); + $r->status(401); + } + } else { + $session{header}{status} = 401; + } + my ($output); + $output = '
'; + return $output; +} + +#------------------------------------------------------------------- + +=head2 isInGroup ( groupId [ , userId ] ) + +Returns a boolean (0|1) value signifying that the user has the required privileges. Always returns true for Admins. + +=over + +=item groupId + +The group that you wish to verify against the user. + +=item userId + +The user that you wish to verify against the group. Defaults to the currently logged in user. + +=back + +=cut + +sub isInGroup { + my ($gid, $uid, @data, %group, $groupId); + ($gid, $uid) = @_; + $uid = $session{user}{userId} if ($uid eq ""); + ### The "Everyone" group automatically returns true. + if ($gid == 7) { + return 1; + } + ### The "Visitor" group returns false, unless the user is visitor. + if ($gid == 1) { + if ($uid == 1) { + return 1; + } else { + return 0; + } + } + ### The "Registered Users" group returns true if user is not visitor. + if ($gid==2 && $uid != 1) { + return 1; + } + ### Use session to cache multiple lookups of the same group. + if ($session{isInGroup}{$gid}{$uid} || $session{isInGroup}{3}{$uid}) { + return 1; + } elsif ($session{isInGroup}{$gid}{$uid} eq "0") { + return 0; + } + ### Lookup the actual groupings. + my $groups = WebGUI::Grouping::getGroupsForUser($uid,1); + foreach (@{$groups}) { + $session{isInGroup}{$_}{$uid} = 1; + } + if ($session{isInGroup}{$gid}{$uid} || $session{isInGroup}{3}{$uid}) { + return 1; + } + ### Get data for auxillary checks. + tie %group, 'Tie::CPHash'; + %group = WebGUI::SQL->quickHash("select karmaThreshold,ipFilter,scratchFilter,databaseLinkId,dbQuery,dbCacheTimeout from groups where groupId='$gid'"); + ### Check IP Address + if ($group{ipFilter} ne "") { + $group{ipFilter} =~ s/\t//g; + $group{ipFilter} =~ s/\r//g; + $group{ipFilter} =~ s/\n//g; + $group{ipFilter} =~ s/\s//g; + $group{ipFilter} =~ s/\./\\\./g; + my @ips = split(";",$group{ipFilter}); + foreach my $ip (@ips) { + if ($session{env}{REMOTE_ADDR} =~ /^$ip/) { + $session{isInGroup}{$gid}{$uid} = 1; + return 1; + } + } + } + ### Check Scratch Variables + if ($group{scratchFilter} ne "") { + $group{scratchFilter} =~ s/\t//g; + $group{scratchFilter} =~ s/\r//g; + $group{scratchFilter} =~ s/\n//g; + $group{scratchFilter} =~ s/\s//g; + my @vars = split(";",$group{scratchFilter}); + foreach my $var (@vars) { + my ($name, $value) = split(/\=/,$var); + if ($session{scratch}{$name} eq $value) { + $session{isInGroup}{$gid}{$uid} = 1; + return 1; + } + } + } + ### Check karma levels. + if ($session{setting}{useKarma}) { + my $karma; + if ($uid == $session{user}{userId}) { + $karma = $session{user}{karma}; + } else { + ($karma) = WebGUI::SQL->quickHash("select karma from users where userId='$uid'"); + } + if ($karma >= $group{karmaThreshold}) { + $session{isInGroup}{$gid}{$uid} = 1; + return 1; + } + } + + ### Check external database + if ($group{dbQuery} ne "" && $group{databaseLinkId}) { + # skip if not logged in and query contains a User macro + unless ($group{dbQuery} =~ /\^User/i && $uid == 1) { + my $dbLink = WebGUI::DatabaseLink->new($group{databaseLinkId}); + my $dbh = $dbLink->dbh; + if (defined $dbh) { + if ($group{dbQuery} =~ /select 1/i) { + $group{dbQuery} = WebGUI::Macro::process($group{dbQuery}); + my $sth = WebGUI::SQL->unconditionalRead($group{dbQuery},$dbh); + unless ($sth->errorCode < 1) { + WebGUI::ErrorHandler::warn("There was a problem with the database query for group ID $gid."); + } else { + my ($result) = $sth->array; + if ($result == 1) { + $session{isInGroup}{$gid}{$uid} = 1; + if ($group{dbCacheTimeout} > 0) { + WebGUI::Grouping::deleteUsersFromGroups([$uid],[$gid]); + WebGUI::Grouping::addUsersToGroups([$uid],[$gid],$group{dbCacheTimeout}); + } + } else { + $session{isInGroup}{$gid}{$uid} = 0; + WebGUI::Grouping::deleteUsersFromGroups([$uid],[$gid]) if ($group{dbCacheTimeout} > 0); + } + } + $sth->finish; + } else { + WebGUI::ErrorHandler::warn("Database query for group ID $gid must use 'select 1'"); + } + $dbLink->disconnect; + return 1 if ($session{isInGroup}{$gid}{$uid}); + } + } + } + + ### Check for groups of groups. + $groups = WebGUI::Grouping::getGroupsInGroup($gid,1); + foreach (@{$groups}) { + $session{isInGroup}{$_}{$uid} = isInGroup($_, $uid); + if ($session{isInGroup}{$_}{$uid}) { + $session{isInGroup}{$gid}{$uid} = 1; + return 1; + } + } + $session{isInGroup}{$gid}{$uid} = 0; + return 0; +} + +#------------------------------------------------------------------- + +=head2 noAccess ( ) + +Returns a message stating that the user does not have the privileges necessary to access this page. This method also sets the HTTP header status to 401. + +=cut + +sub noAccess { + if($session{env}{MOD_PERL}) { + my $r = Apache->request; + if(defined($r)) { + $r->custom_response(401, '' ); + $r->status(401); + } + } else { + $session{header}{status} = 401; + } + my ($output); + if ($session{user}{userId} <= 1) { + $output = WebGUI::Operation::Account::www_displayAccount(); + } else { + $output = '
'; + } + return $output; +} + +#------------------------------------------------------------------- + +=head2 notMember ( ) + +Returns a message stating that the user they requested information about is no longer active on this server. This method also sets the HTTP header status to 400. + +=cut + +sub notMember { + if($session{env}{MOD_PERL}) { + my $r = Apache->request; + if(defined($r)) { + $r->custom_response(400, '' ); + $r->status(400); + } + } else { + $session{header}{status} = 400; + } + my ($output); + $output = '
'; + return $output; +} + +#------------------------------------------------------------------- + +=head2 vitalComponent ( ) + +Returns a message stating that the user made a request to delete something that should never delete. This method also sets the HTTP header status to 403. + +=cut + +sub vitalComponent { + if($session{env}{MOD_PERL}) { + my $r = Apache->request; + if(defined($r)) { + $r->custom_response(403, '' ); + $r->status(403); + } + } else { + $session{header}{status} = 403; + } + my ($output); + $output = '
'; + return $output; +} + + + + + + +1; + diff --git a/lib/WebGUI/Wobject/SQLReport.pm b/lib/WebGUI/Wobject/SQLReport.pm index a48e5794a..af55c87a8 100644 --- a/lib/WebGUI/Wobject/SQLReport.pm +++ b/lib/WebGUI/Wobject/SQLReport.pm @@ -148,7 +148,7 @@ sub www_edit { #------------------------------------------------------------------- sub www_view { - my ($dsn, $username, $identifier, $query, @row, $i, $rownum, $p, $ouch, $output, $sth, $dbh, @result, @template, $temp, $col, $errorMessage, $url); + my ($dsn, $username, $identifier, $dbLink, $query, @row, $i, $rownum, $p, $ouch, $output, $sth, $dbh, @result, @template, $temp, $col, $errorMessage, $url); if ($_[0]->get("preprocessMacros")) { $query = WebGUI::Macro::process($_[0]->get("dbQuery")); } else { @@ -161,29 +161,24 @@ sub www_view { $output .= $_[0]->description; $output .= WebGUI::International::get(17,$_[0]->get("namespace"))." ".$query."
" if ($_[0]->get("debugMode")); - # pull database link info if selected + # connect to external database if used if ($_[0]->get("databaseLinkId")) { - my %databaseLink = WebGUI::DatabaseLink::get($_[0]->get("databaseLinkId")); - # failsafe check in case the link gets deleted - if ($databaseLink{DSN}) { - $dsn = $databaseLink{DSN}; - $username = $databaseLink{username}; - $identifier = $databaseLink{identifier}; + $dbLink = WebGUI::DatabaseLink->new($_[0]->get("databaseLinkId")); + $dbh = $dbLink->dbh; + } else { + if ($dsn eq $session{config}{dsn}) { + $dbh = $session{dbh}; + } elsif ($dsn =~ /\DBI\:\w+\:\w+/i) { + eval{$dbh = DBI->connect($dsn,$username,$identifier)}; + if ($@) { + WebGUI::ErrorHandler::warn("SQL Report [".$_[0]->get("wobjectId")."] ".$@); + undef $dbh; + } + } else { + $output .= WebGUI::International::get(9,$_[0]->get("namespace")).'
' if ($_[0]->get("debugMode")); + WebGUI::ErrorHandler::warn("SQLReport [".$_[0]->get("wobjectId")."] The DSN specified is of an improper format."); } } - - if ($dsn eq $session{config}{dsn}) { - $dbh = $session{dbh}; - } elsif ($dsn =~ /\DBI\:\w+\:\w+/) { - eval{$dbh = DBI->connect($dsn,$username,$identifier)}; - if ($@) { - WebGUI::ErrorHandler::warn("SQL Report [".$_[0]->get("wobjectId")."] ".$@); - undef $dbh; - } - } else { - $output .= WebGUI::International::get(9,$_[0]->get("namespace")).'
' if ($_[0]->get("debugMode")); - WebGUI::ErrorHandler::warn("SQLReport [".$_[0]->get("wobjectId")."] The DSN specified is of an improper format."); - } if (defined $dbh) { if ($query =~ /^select/i || $query =~ /^show/i || $query =~ /^describe/i) { $sth = WebGUI::SQL->unconditionalRead($query,$dbh); @@ -242,7 +237,11 @@ sub www_view { $output .= WebGUI::International::get(10,$_[0]->get("namespace")).'
' if ($_[0]->get("debugMode")); WebGUI::ErrorHandler::warn("SQLReport [".$_[0]->get("wobjectId")."] The SQL query is improperly formatted."); } - $dbh->disconnect() unless ($dsn eq $session{config}{dsn}); + if ($dbLink) { + $dbLink->disconnect; + } else { + $dbh->disconnect() unless ($dsn eq $session{config}{dsn}); + } } else { $output .= WebGUI::International::get(12,$_[0]->get("namespace")).'
' if ($_[0]->get("debugMode")); WebGUI::ErrorHandler::warn("SQLReport [".$_[0]->get("wobjectId")."] Could not connect to database."); diff --git a/sbin/Hourly/DeleteExpiredGroupings.pm b/sbin/Hourly/DeleteExpiredGroupings.pm index c33bb209d..b95d0b807 100644 --- a/sbin/Hourly/DeleteExpiredGroupings.pm +++ b/sbin/Hourly/DeleteExpiredGroupings.pm @@ -19,10 +19,15 @@ use WebGUI::SQL; sub process { my @date = WebGUI::DateTime::localtime(); if ($date[4] == 3) { # only occurs at 3am on the day in question. - my $sth = WebGUI::SQL->read("select groupId,deleteOffset from groups"); + my $sth = WebGUI::SQL->read("select groupId,deleteOffset,dbCacheTimeout from groups"); while (my $data = $sth->hashRef) { - WebGUI::SQL->write("delete from groupings where groupId=$data->{groupId} and expireDate < " + if ($data->{dbCacheTimeout} > 0) { + # there is no need to wait deleteOffset days for expired external group cache data + WebGUI::SQL->write("delete from groupings where groupId=$data->{groupId} and expireDate < ".time()); + } else { + WebGUI::SQL->write("delete from groupings where groupId=$data->{groupId} and expireDate < " .(time()-(86400*$data->{deleteOffset}))); + } } $sth->finish; }