cgi-bin/ljcapabilities.pl

   1 package LJ;
   2 use strict;
   3
   4 sub class_bit {
   5     my ($class) = @_;
   6     foreach my $bit (0..65) {
   7         my $def = $LJ::CAP{$bit};
   8         next unless $def->{_key} && $def->{_key} eq $class;
   9         return $bit;
  10     }
  11     return undef;
  12 }
  13
  14 # what class name does a given bit number represent?
  15 sub class_of_bit {
  16     my $bit = shift;
  17     return $LJ::CAP{$bit}->{_key};
  18 }
  19
  20 sub classes_from_mask {
  21     my $caps = shift;
  22
  23     my @classes = ();
  24     foreach my $bit (0..15) {
  25         my $class = LJ::class_of_bit($bit);
  26         next unless $class && LJ::caps_in_group($caps, $class);
  27         push @classes, $class;
  28     }
  29
  30     return @classes;
  31 }
  32
  33 sub mask_from_classes {
  34     my @classes = @_;
  35
  36     my $mask = 0;
  37     foreach my $class (@classes) {
  38         my $bit = LJ::class_bit($class);
  39         $mask |= (1 << $bit);
  40     }
  41
  42     return $mask;
  43 }
  44
  45 sub mask_from_bits {
  46     my @bits = @_;
  47
  48     my $mask = 0;
  49     foreach my $bit (@bits) {
  50         $mask |= (1 << $bit);
  51     }
  52
  53     return $mask;
  54 }
  55
  56 sub caps_in_group {
  57     my ($caps, $class) = @_;
  58     my $bit = LJ::class_bit($class);
  59     unless (defined $bit) {
  60         # this site has no underage class?  'underage' is the only
  61         # general class.
  62         return 0 if $class eq "underage";
  63
  64         # all other classes are site-defined, so we die on those not existing.
  65         die "unknown class '$class'";
  66     }
  67
  68     return ($caps+0 & (1 << $bit)) ? 1 : 0;
  69 }
  70
  71 # <LJFUNC>
  72 # name: LJ::name_caps
  73 # des: Given a user's capability class bit mask, returns a
  74 #      site-specific string representing the capability class name.
  75 # args: caps
  76 # des-caps: 16 bit capability bitmask
  77 # </LJFUNC>
  78 sub name_caps
  79 {
  80     return undef unless LJ::are_hooks("name_caps");
  81     my $caps = shift;
  82     return LJ::run_hook("name_caps", $caps);
  83 }
  84
  85 # <LJFUNC>
  86 # name: LJ::name_caps_short
  87 # des: Given a user's capability class bit mask, returns a
  88 #      site-specific short string code.
  89 # args: caps
  90 # des-caps: 16 bit capability bitmask
  91 # </LJFUNC>
  92 sub name_caps_short
  93 {
  94     return undef unless LJ::are_hooks("name_caps_short");
  95     my $caps = shift;
  96     return LJ::run_hook("name_caps_short", $caps);
  97 }
  98
  99 # <LJFUNC>
 100 # name: LJ::user_caps_icon
 101 # des: Given a user's capability class bit mask, returns
 102 #      site-specific HTML with the capability class icon.
 103 # args: caps
 104 # des-caps: 16 bit capability bitmask
 105 # </LJFUNC>
 106 sub user_caps_icon
 107 {
 108     return undef unless LJ::are_hooks("user_caps_icon");
 109     my $caps = shift;
 110     return LJ::run_hook("user_caps_icon", $caps);
 111 }
 112
 113 # <LJFUNC>
 114 # name: LJ::get_cap
 115 # des: Given a user object, capability class key or capability class bit mask
 116 #      and a capability/limit name,
 117 #      returns the maximum value allowed for given user or class, considering
 118 #      all the limits in each class the user is a part of.
 119 # args: u_cap, capname
 120 # des-u_cap: 16 bit capability bitmask or a user object from which the
 121 #            bitmask could be obtained
 122 # des-capname: the name of a limit, defined in [special[caps]].
 123 # </LJFUNC>
 124 sub get_cap
 125 {
 126     my $caps = shift;   # capability bitmask (16 bits), cap key or user object
 127     my $cname = shift;  # capability limit name
 128     my $opts  = shift;  # { no_hook => 1/0 }
 129     $opts ||= {};
 130
 131     # If caps is a reference
 132     my $u = ref $caps ? $caps : undef;
 133
 134     # If caps is a reference get caps from User object
 135     if ($u) {
 136         $caps = $u->{'caps'};
 137     # If it is not all digits assume it is a key
 138     } elsif ($caps && $caps !~ /^\d+$/) {
 139         $caps = 1 << LJ::class_bit($caps);
 140     }
 141     # The caps is the cap mask already or undef, force it to be a number
 142     $caps += 0;
 143
 144     my $max = undef;
 145
 146     # allow a way for admins to force-set the read-only cap
 147     # to lower writes on a cluster.
 148     if ($cname eq "readonly" && $u &&
 149         ($LJ::READONLY_CLUSTER{$u->{clusterid}} ||
 150          $LJ::READONLY_CLUSTER_ADVISORY{$u->{clusterid}} &&
 151          ! LJ::get_cap($u, "avoid_readonly"))) {
 152
 153         # HACK for desperate moments.  in when_needed mode, see if
 154         # database is locky first
 155         my $cid = $u->{clusterid};
 156         if ($LJ::READONLY_CLUSTER_ADVISORY{$cid} eq "when_needed") {
 157             my $now = time();
 158             return 1 if $LJ::LOCKY_CACHE{$cid} > $now - 15;
 159
 160             my $dbcm = LJ::get_cluster_master($u->{clusterid});
 161             return 1 unless $dbcm;
 162             my $sth = $dbcm->prepare("SHOW PROCESSLIST");
 163             $sth->execute;
 164             return 1 if $dbcm->err;
 165             my $busy = 0;
 166             my $too_busy = $LJ::WHEN_NEEDED_THRES || 300;
 167             while (my $r = $sth->fetchrow_hashref) {
 168                 $busy++ if $r->{Command} ne "Sleep";
 169             }
 170             if ($busy > $too_busy) {
 171                 $LJ::LOCKY_CACHE{$cid} = $now;
 172                 return 1;
 173             }
 174         } else {
 175             return 1;
 176         }
 177     }
 178
 179     # underage/coppa check etc
 180     if ($cname eq "underage" && $u && $u->in_class("underage")) {
 181         return 1;
 182     }
 183
 184     # is there a hook for this cap name?
 185     if (! $opts->{no_hook} && LJ::are_hooks("check_cap_$cname")) {
 186         die "Hook 'check_cap_$cname' requires full user object"
 187             unless LJ::isu($u);
 188         my $val = LJ::run_hook("check_cap_$cname", $u, $opts);
 189         return $val if defined $val;
 190
 191         # otherwise fall back to standard means
 192     }
 193
 194     # otherwise check via other means
 195     foreach my $bit (keys %LJ::CAP) {
 196         next unless ($caps & (1 << $bit));
 197         my $v = $LJ::CAP{$bit}->{$cname};
 198         next unless (defined $v);
 199         next if (defined $max && $max > $v);
 200         $max = $v;
 201     }
 202
 203     return defined $max ? $max : $LJ::CAP_DEF{$cname};
 204 }
 205
 206 # <LJFUNC>
 207 # name: LJ::get_cap_min
 208 # des: Just like [func[LJ::get_cap]], but returns the minimum value.
 209 #      Although it might not make sense at first, some things are
 210 #      better when they're low, like the minimum amount of time
 211 #      a user might have to wait between getting updates or being
 212 #      allowed to refresh a page.
 213 # args: u_cap, capname
 214 # des-u_cap: 16 bit capability bitmask or a user object from which the
 215 #            bitmask could be obtained
 216 # des-capname: the name of a limit, defined in [special[caps]].
 217 # </LJFUNC>
 218 sub get_cap_min
 219 {
 220     my $caps = shift;   # capability bitmask (16 bits), or user object
 221     my $cname = shift;  # capability name
 222     if (! defined $caps) { $caps = 0; }
 223     elsif (isu($caps)) { $caps = $caps->{'caps'}; }
 224     my $min = undef;
 225     foreach my $bit (keys %LJ::CAP) {
 226         next unless ($caps & (1 << $bit));
 227         my $v = $LJ::CAP{$bit}->{$cname};
 228         next unless (defined $v);
 229         next if (defined $min && $min < $v);
 230         $min = $v;
 231     }
 232     return defined $min ? $min : $LJ::CAP_DEF{$cname};
 233 }
 234
 235 1;