view release on metacpan or  search on metacpan

lib/App/CamelPKI/RestrictedClassMethod.pm  view on Meta::CPAN

#!perl -w

package App::CamelPKI::RestrictedClassMethod;
use strict;
use warnings;

=head1 NAME

B<App::CamelPKI::RestrictedClassMethod> - Application of the "brand"
capability discipline pattern to sensitive constructors and classes.

=head1 SYNOPSIS

=for My::Tests::Below "synopsis" begin

  package App::CamelPKI::Foo;

  use App::CamelPKI::RestrictedClassMethod ":Restricted";

  sub new : Restricted {
      my ($class) = @_;
      # ...
  }

  App::CamelPKI::RestrictedClassMethod->lockdown(__PACKAGE__);

  # Meanwhile, in a nearby piece of privileged code...

  my $brand = grab App::CamelPKI::RestrictedClassMethod("App::CamelPKI::Foo");
  my $object = $brand->invoke("new", @args);

=for My::Tests::Below "synopsis" end

=head1 DESCRIPTION

B<App::CamelPKI::RestrictedClassMethod> is an implementation of the "brand"
pattern, which is of general use in capability discipline (see
L<App::CamelPKI::CodingStyle/Capability discipline>).  It is used to
ascertain that the security-sensitive class methods, especially the
construction of objects that use the ambiant autority of the process,
are kept secure in capability discipline style.

=head1 CAPABILITY DISCIPLINE

An instance of I<App::CamelPKI::RestrictedClassMethod> represents the right
to invoke methods marked as C<Restricted> in an given Perl class.

=cut

use Class::Inspector;
use App::CamelPKI::Error;

=head1 "use" form

The L</SYNOPSIS> formula

    use App::CamelPKI::RestrictedClassMethod ":Restricted";

indicates that the calling package wants to use the C<Restricted>
attribute for its methods.  When affixed the C<Restricted> on a method
class (again as shown in the synopsis) prevents the execution of this
method to all excepted to holder of the corresponding
I<App::CamelPKI::RestrictedClassMethod> object (see L</METHODS>).

=cut

sub import {
    my ($class, @args) = @_;
    return if ! @args;
    die "unsupported import form" unless (@args == 1 &&
                                          $args[0] eq ":Restricted");
    my ($caller) = caller;
    no strict "refs";
    *{$caller . "::MODIFY_CODE_ATTRIBUTES"} = sub {
        my ($package, $coderef, @attrs) = @_;
        return @attrs unless (@attrs == 1 && $attrs[0] eq "Restricted");
        __PACKAGE__->_create($package)->
            _register_restricted_constructor($coderef);
        return;
    };
}

=head1 CONSTRUCTORS

=head2 grab($classname)

Commences an hostile takeover on $classname. I<grab> will only succeed
once on any given $classname during the lifetime of the Perl
interpreter; when it succeeds, it returns an instance of the
I<App::CamelPKI::RestrictedClassMethod> class which represents the right to
invoke methods marked as C<Restricted> in $classname.

=cut

sub grab {
    my ($class, $wantclass) = @_;
    # Can also be invoked as an instance method from inside this
    # package:
    my $self = ref($class) ? $class : $class->_get($wantclass);
    throw App::CamelPKI::Error::Privilege("$wantclass is not loaded yet")
        if (! defined $self);
    throw App::CamelPKI::Error::Privilege("$wantclass is already taken")
        if ($self->{grabbed});
    $self->lockdown();
    $self->{grabbed}++;
    return $self;
}

=head2 fake_grab($classname)

Returns an object of class
L</App::CamelPKI::RestrictedClassMethod::FakeBrand>.  Unlike the real
L</grab>, a C<fake_grab()> has no security consequences: restricted
methods are not locked down (see L</lockdown>), and C<fake_grab()> may
succeed several times for the same $classname.