App-CamelPKI

 view release on metacpan or  search on metacpan

inc/My/Module/Build.pm  view on Meta::CPAN

the Perl modules from the CPAN index.

=back

=cut

sub new {
    my ($class, %opts) = @_;
    $opts{recursive_test_files} = 1 if
        (! defined $opts{recursive_test_files});
    my $self = $class->SUPER::new(%opts);
    if ($self->maintainer_mode_enabled()) {
        print "Running specific maintainer checks...\n";
        $self->check_maintainer_dependencies();
    }
    $self->_process_options;
    $self;
}

=item I<requires_for_build()>

inc/My/Module/Build.pm  view on Meta::CPAN

=item I<ACTION_build>

Overloaded to add L</ACTION_buildXS> as a dependency.

=cut

sub ACTION_build {
    my $self = shift;

    $self->depends_on("buildXS");
    $self->SUPER::ACTION_build(@_);
}

=item I<ACTION_dist>

Overloaded so that typing C<./Build dist> does The Right Thing and
regenerates everything that is needed in order to create the
distribution tarball. This require_onces the C<Makefile.PL> if so requested
(see L<Module::Build::Compat/create_makefile_pl>) and the C<MANIFEST>
file (see L<Module::Build/manifest>).  On the other hand, the
C<META.yml> file is not regenerated automatically, so that the author

inc/My/Module/Build.pm  view on Meta::CPAN

=cut

sub ACTION_dist {
    my $self = shift;

    $self->do_create_makefile_pl if $self->create_makefile_pl;
    $self->do_create_readme if $self->create_readme;
    $self->depends_on("manifest");

    $self->SUPER::ACTION_dist(@_);
}

=item I<ACTION_buildXS>

Does nothing.  Intended for overloading by packages that have XS code,
which e.g. may want to call L</process_Inline_C_file> there.

=cut

sub ACTION_buildXS { }

inc/My/Module/Build.pm  view on Meta::CPAN

        $self->{properties}->{verbose} = 1 if
            (! defined $self->{properties}->{verbose});
    }

    # use_blib feature, cont'd:
    no warnings "once";
    local *blib = sub {
        my $self = shift;

        return File::Spec->curdir if ! $self->use_blib;
        return $self->SUPER::blib(@_);
    };


    $self->SUPER::ACTION_test(@_);
}

=item I<ACTION_distmeta>

Overloaded to ensure that .pm modules in inc/ don't get indexed and
that the C<add_to_no_index> parameter to L</new> is honored.

=cut

sub ACTION_distmeta {

inc/My/Module/Build.pm  view on Meta::CPAN

    # Steals a reference to the YAML object that will be constructed
    # by the parent class (duhh)
    local our $orig_yaml_node_new = \&YAML::Node::new;
    local our $node;
    no warnings "redefine";
    local *YAML::Node::new = sub {
        $node = $orig_yaml_node_new->(@_);
    };

    my $retval = $self->SUPER::ACTION_distmeta;
    die "Failed to steal the YAML node" unless defined $node;

    $node->{no_index} = $self->{properties}->{add_to_no_index} || {};
    $node->{no_index}->{directory} ||= [];
    unshift(@{$node->{no_index}->{directory}}, qw(examples inc t),
            (map { File::Spec::Unix->catdir("lib", split m/::/) }
             (@{$node->{no_index}->{namespace} || []})));

    foreach my $package (keys %{$node->{provides}}) {
        delete $node->{provides}->{$package} if

inc/My/Module/Build.pm  view on Meta::CPAN

blib/**.pm counterpart; overloaded here to remove the test suite (see
L</Unit tests>) and standardize the copyright of the files authored by
me.

=cut

sub process_pm_files {
    no warnings "once";
    local *copy_if_modified = \*process_pm_file_if_modified;
    my $self = shift;
    return $self->SUPER::process_pm_files(@_);
}

=item I<process_pm_file_if_modified(%args)>

Does the same as L<copy_file_if_modified> (which it actually replaces
while L<process_pm_files> runs), except that the L</new_pm_filter> is
applied instead of performing a vanilla copy as L<Module::Build> does.

=cut

inc/My/Module/Build.pm  view on Meta::CPAN

=cut

sub find_test_files {
    my $self = shift;

    # Short-cut activated by L</ACTION_test>:
    return $self->{FORCE_find_test_files_result} if
        (defined $self->{FORCE_find_test_files_result});

    my @tests = @{$self->SUPER::find_test_files(@_)};
    # Short-cut activated by putting a 'test_files' key in the constructor
    # arguments:
    return @tests if $self->{test_files};

    @tests = grep { ! m/^t.maintainer/ } @tests unless
        ($self->maintainer_mode_enabled());

    File::Find::find
        ({no_chdir => 1, wanted => sub {
              push(@tests, $_) if $self->find_test_files_predicate();

inc/My/Module/Build.pm  view on Meta::CPAN

do that).

This easter egg was a feature of an old GNU-make based build framework
that I created in a former life.  So there.

=cut

sub do_create_makefile_pl {
  my ($self, %args) = @_;
  warn("Cannot take off any Zig, sorry"),
      return $self->SUPER::do_create_makefile_pl(%args) if ($args{fh});
  $args{file} ||= 'Makefile.PL';
  my $retval = $self->SUPER::do_create_makefile_pl(%args);
  my $MakefilePL = read_file($args{file});
  $MakefilePL = <<'PREAMBLE' . $MakefilePL;
use FindBin qw($Bin);
use lib "$Bin/inc";
PREAMBLE
  $MakefilePL =~ s|Module::Build::Compat->write_makefile|My::Module::Build::HowAreYouGentlemen->write_makefile|;
  write_file($args{file}, $MakefilePL);
  return $retval;
}

{
    package My::Module::Build::HowAreYouGentlemen;
    our @ISA=qw(Module::Build::Compat); # Do not explicitly load it because
    # Makefile.PL will set up us the Module::Build::Compat itself (and
    # also we want to take off every zig of bloat when
    # My::Module::Build is loaded from elsewhere). Moreover, "use
    # base" is not yet belong to us at this time.

    sub fake_makefile {
        my $self = shift;
        return $self->SUPER::fake_makefile(@_). <<'MAIN_SCREEN_TURN_ON';
# In 2101 AD war was beginning...
your:
	@echo
	@echo -n "     All your codebase"

time:
	@echo " are belong to us !"
	@echo

MAIN_SCREEN_TURN_ON

inc/My/Module/Build.pm  view on Meta::CPAN

# Kludge inserted by My::Module::Build to work around some brokenness
# in the \@ISA setup code above:
use base "My::Module::Build";
our \@ISA;
BEGIN { our \@ISAorig = \@ISA; }
\@ISA = our \@ISAorig;

$opts{code}
KLUDGE_ME_UP

    return $pack->SUPER::subclass(%opts);
}

=item I<_startperl>

Overloaded from parent to attempt a chdir() into the right place in
./Build during initialization. This is an essential enabler to the
Emacs debugger support (see L</ACTION_test>) because we simply cannot
tell where Emacs will be running us from.

=cut

sub _startperl {
    my $self = shift;
    my $basedir = $self->base_dir;
    $basedir = Win32::GetShortPathName($basedir) if is_win32;
    return $self->SUPER::_startperl(@_) . <<"MORE";

# Hack by My::Module::Build to give the Emacs debugger one
# more chance to work:
use Cwd;
BEGIN {
  \$My::Module::Build::initial_cwd = \$My::Module::Build::initial_cwd =
    Cwd::cwd;
  chdir("$basedir") || 1;
}
MORE

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

The overloading of this method is key to applying capability
discipline, because it forces the Principle of Least Authority (POLA)
onto Camel-PKI HTTP/S clients.

=cut

sub model {
    my ($self, $shortclass) = @_;

    my $full_model = $self->SUPER::model($shortclass);
    # Privileges are unconstrained except under Apache.
    return $full_model if (! App::CamelPKI::SysV::Apache->is_running_under);

    my $r = $self->engine->apache;
    my $client_dn = $r->subprocess_env("SSL_CLIENT_S_DN");

    my $admin_dn = '/O=CamelPKI.fr/OU=CamelPKI/OU=role/CN=administrator';

    # FIXME: privileges are immutable, and that makes the switch-case
    # below quite messy. In a future version, capabilities will be

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

class methods in the Camel-PKI model after the respective classes are
loaded (see L<App::CamelPKI::RestrictedClassMethod>).  This only occurs in
production (that is, when running under Apache, as determined by
L<App::CamelPKI::SysV::Apache/is_running_under>), so that tests can still
call restricted methods freely.

=cut

sub setup_components {
    my $self = shift;
    $self->SUPER::setup_components(@_);
    return unless App::CamelPKI::SysV::Apache->is_running_under;
    my %brands = App::CamelPKI::RestrictedClassMethod->grab_all;
    # FIXME: this is just clumsy.  We should use one directory
    # capability for the CA instead (even though
    # ::RestrictedClassMethod is still useful to some extent eg to
    # disable debug methods).
    $brands{"App::CamelPKI::Model::CA"}->invoke
        ("set_brands",
         $brands{"App::CamelPKI::CA"}, $brands{"App::CamelPKI::CADB"});
}

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

test_certificate_conflict must not see other templates's certificates.
MESSAGE
            foreach my $cert (map {$_->{cert}} @{$ca->{signed}}) {
                is($db->search(-revoked => undef,
                               -certificate => $cert)->count(), 0,
                   <<"MESSAGE");
test_certificate_conflict must not see certificates of the current
transaction.
MESSAGE
            }
            return $class->SUPER::test_certificate_conflict($db, @keyvals);
        }
    }
    #

    $ca->issue("Bogus::CertTemplate", $pubkey,
               name => "Harry", uid => 1001);
    $ca->issue("Bogus::CertTemplate", $pubkey,
               name => "Sally", uid => 1002);
    $ca->commit();
};

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

and therefore should not be tested by error catching code.

=cut

package App::CamelPKI::Error::IO;
use vars qw(@ISA); @ISA=qw(App::CamelPKI::Error);

sub new {
    my $class = shift;
    local $Error::Depth = $Error::Depth + 1;
    return $class->SUPER::new(@_,
                              -errorcode => $! + 0, -error => "$!");
}

=head2 App::CamelPKI::Error::Privilege

Thrown each time the owner of a facet, another object or a class with
restricted privileges, try to exceeds those which were granted to it.
To this effect, the I<App::CamelPKI::Error::Privilege> also defines a
B<on_facet_error> function that can be installed as a L<Class::Facet>
error handler, as shown in L</SYNOPSIS>.

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

Overloaded to throw a complete error trace. If this does not match
your need, feel free to trap the exception in your own code.

=cut


sub stringify {
    my ($self) = @_;
    my $retval = sprintf("%s=%s\n",
                         ref($self), $self->SUPER::stringify);
    foreach my $k (keys %$self) {
        next if ($k eq "-text" || $k eq "-stacktrace");
        local $@; # if exceptions brakes exceptions... Where do we goes?!
        my $v = eval {
            require Data::Dumper;
            local $Data::Dumper::Indent = $Data::Dumper::Indent = 1;
            local $Data::Dumper::Terse = $Data::Dumper::Terse = 1;
            Data::Dumper::Dumper($self->{$k});
        } || "<huh?>";
        $retval .= "  $k => $v";

lib/App/CamelPKI/Model/CA.pm  view on Meta::CPAN

=head1 METHODS

=head2 new

Constuctor of the singleton called by Catalyst. Overloaded to use
L<App::CamelPKI::RestrictedClassMethod>, so that it cannot be called from
anywere, except from the application's initialization sequence.

=cut

sub new : Restricted { shift->SUPER::new(@_) }

=head2 set_brands($ca_brand, $cadb_brand)

Conveys authority to create instances of L<App::CamelPKI::CA> and
L<App::CamelPKI::CADB> to this class when the restricted class method
discipline is enabled (see L<App::CamelPKI::RestrictedClassMethod>). Called
by L<App::CamelPKI/setup> after restricting all the constructors in the
application .  $ca_brand and $cadb_brand are the respective brands for
classes B<App::CamelPKI::CA> and B<App::CamelPKI::CADB>, as created by
L<App::CamelPKI::RestrictedClassMethod/grab>.