# This code was forked from the LiveJournal project owned and operated
# by Live Journal, Inc. The code has been modified and expanded by
# Dreamwidth Studios, LLC. These files were originally licensed under
# the terms of the license supplied by Live Journal, Inc, which can
# currently be found at:
#
# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
#
# In accordance with the original license, this code and all its
# modifications are provided under the GNU General Public License.
# A copy of that license can be found in the LICENSE file included as
# part of this distribution.
package LJ::Capabilities;
use strict;
sub class_bit {
my ($class) = @_;
foreach my $bit ( 0 .. 15 ) {
my $def = $LJ::CAP{$bit};
next unless $def->{_key} && $def->{_key} eq $class;
return $bit;
}
return undef;
}
# what class name does a given bit number represent?
sub class_of_bit {
my $bit = shift;
return $LJ::CAP{$bit}->{_key};
}
sub classes_from_mask {
my $caps = shift;
my @classes = ();
foreach my $bit ( 0 .. 15 ) {
my $class = class_of_bit($bit);
next unless $class && caps_in_group( $caps, $class );
push @classes, $class;
}
return @classes;
}
sub mask_from_classes {
my @classes = @_;
my $mask = 0;
foreach my $class (@classes) {
my $bit = class_bit($class);
$mask |= ( 1 << $bit );
}
return $mask;
}
sub mask_from_bits {
my @bits = @_;
my $mask = 0;
foreach my $bit (@bits) {
$mask |= ( 1 << $bit );
}
return $mask;
}
sub caps_in_group {
my ( $caps, $class ) = @_;
$caps = $caps ? $caps + 0 : 0;
my $bit = class_bit($class);
die "unknown class '$class'" unless defined $bit;
return ( $caps & ( 1 << $bit ) ) ? 1 : 0;
}
#
# name: LJ::Capabilities::name_caps
# des: Given a user's capability class bit mask, returns a
# site-specific string representing the capability class(es) name.
# args: caps
# des-caps: 16 bit capability bitmask
#
sub name_caps {
my $bit = shift;
my @caps = caps_string( $bit, '_visible_name' );
if (@caps) {
return join( ', ', @caps );
}
else {
return name_caps_short($bit);
}
}
#
# name: LJ::Capabilities::name_caps_short
# des: Given a user's capability class bit mask, returns a
# site-specific string representing the capability class(es) short name.
# args: caps
# des-caps: 16 bit capability bitmask
#
sub name_caps_short {
my $bit = shift;
return join( ', ', caps_string( $bit, '_name' ) );
}
#
# name: LJ::Capabilities::caps_string
# des: Given a user's capability class bitfield and a name field key,
# returns an array of all the account class names.
# args: caps, name_value
# des-caps: bitfield
# des-name_value: string (_name for short name, _visible_name for long)
sub caps_string {
my ( $caps, $name_value ) = @_;
my @classes = ();
foreach my $bit ( 0 .. 15 ) {
my $class = class_of_bit($bit);
next unless $class && caps_in_group( $caps, $class );
my $name = $LJ::CAP{$bit}->{$name_value} // "";
push @classes, $name if $name ne "";
}
return @classes;
}
#
# name: LJ::Capabilities::user_caps_icon
# des: Given a user's capability class bit mask, returns
# site-specific HTML with the capability class icon.
# args: caps
# des-caps: 16 bit capability bitmask
#
sub user_caps_icon {
return undef unless LJ::Hooks::are_hooks("user_caps_icon");
my $caps = shift;
return LJ::Hooks::run_hook( "user_caps_icon", $caps );
}
#
# name: LJ::get_cap
# des: Given a user object, capability class key or capability class bit mask
# and a capability/limit name,
# returns the maximum value allowed for given user or class, considering
# all the limits in each class the user is a part of.
# args: u_cap, capname
# des-u_cap: 16 bit capability bitmask or a user object from which the
# bitmask could be obtained
# des-capname: the name of a limit, defined in [special[caps]].
#
sub get_cap {
my $caps = shift; # capability bitmask (16 bits), cap key or user object
my $cname = shift; # capability limit name
my $opts = shift; # { no_hook => 1/0 }
$opts ||= {};
# If caps is a reference
my $u = ref $caps ? $caps : undef;
# If caps is a reference get caps from User object
if ($u) {
$caps = $u->{'caps'};
# If it is not all digits assume it is a key
}
elsif ( $caps && $caps !~ /^\d+$/ ) {
my $bit = class_bit($caps) || 0;
$caps = 1 << $bit;
}
# The caps is the cap mask already or undef, force it to be a number
$caps += 0;
my $max = undef;
# allow a way for admins to force-set the read-only cap
# to lower writes on a cluster.
if (
$cname eq "readonly"
&& $u
&& ( $LJ::READONLY_CLUSTER{ $u->{clusterid} }
|| $LJ::READONLY_CLUSTER_ADVISORY{ $u->{clusterid} }
&& !LJ::get_cap( $u, "avoid_readonly" ) )
)
{
# HACK for desperate moments. in when_needed mode, see if
# database is locky first
my $cid = $u->{clusterid};
if ( $LJ::READONLY_CLUSTER_ADVISORY{$cid} eq "when_needed" ) {
my $now = time();
return 1 if $LJ::LOCKY_CACHE{$cid} > $now - 15;
my $dbcm = LJ::get_cluster_master( $u->{clusterid} );
return 1 unless $dbcm;
my $sth = $dbcm->prepare("SHOW PROCESSLIST");
$sth->execute;
return 1 if $dbcm->err;
my $busy = 0;
my $too_busy = $LJ::WHEN_NEEDED_THRES || 300;
while ( my $r = $sth->fetchrow_hashref ) {
$busy++ if $r->{Command} ne "Sleep";
}
if ( $busy > $too_busy ) {
$LJ::LOCKY_CACHE{$cid} = $now;
return 1;
}
}
else {
return 1;
}
}
# is there a hook for this cap name?
if ( !$opts->{no_hook} && LJ::Hooks::are_hooks("check_cap_$cname") ) {
die "Hook 'check_cap_$cname' requires full user object"
unless LJ::isu($u);
my $val = LJ::Hooks::run_hook( "check_cap_$cname", $u );
return $val if defined $val;
# otherwise fall back to standard means
}
# otherwise check via other means
foreach my $bit ( keys %LJ::CAP ) {
next unless ( $caps & ( 1 << $bit ) );
my $v = $LJ::CAP{$bit}->{$cname};
next unless ( defined $v );
next if ( defined $max && $max > $v );
$max = $v;
}
return defined $max ? $max : $LJ::CAP_DEF{$cname};
}
*LJ::get_cap = \&get_cap;
#
# name: LJ::Capabilities::get_cap_min
# des: Just like [func[LJ::get_cap]], but returns the minimum value.
# Although it might not make sense at first, some things are
# better when they're low, like the minimum amount of time
# a user might have to wait between getting updates or being
# allowed to refresh a page.
# args: u_cap, capname
# des-u_cap: 16 bit capability bitmask or a user object from which the
# bitmask could be obtained
# des-capname: the name of a limit, defined in [special[caps]].
#
sub get_cap_min {
my $caps = shift; # capability bitmask (16 bits), or user object
my $cname = shift; # capability name
if ( !defined $caps ) { $caps = 0; }
elsif ( LJ::isu($caps) ) { $caps = $caps->{'caps'}; }
my $min = undef;
foreach my $bit ( keys %LJ::CAP ) {
next unless ( $caps & ( 1 << $bit ) );
my $v = $LJ::CAP{$bit}->{$cname};
next unless ( defined $v );
next if ( defined $min && $min < $v );
$min = $v;
}
return defined $min ? $min : $LJ::CAP_DEF{$cname};
}
1;