App-CamelPKI

 view release on metacpan or  search on metacpan

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

    $ca = load_ca->facet_certtemplate("App::CamelPKI::CertTemplate::Foo");
    $ca->issue("App::CamelPKI::CertTemplate::Foo", $pubkey,
               name => "user1", uid => 1);

    # A new certificate for UID 43 must revoke the old one:
    my $cursor = $ca->database->search(name => "Fred");
    is($cursor->revocation_time(), undef,
       "The Fred's certificate is not yet revoked");
    is(my $fredid = $cursor->infos->{uid}->[0], 43,
       "Using CADB to get the Fred's UID")
        or warn Data::Dumper::Dumper(scalar($cursor->infos));
    # Fred got his operation, so he need a new certificate:
    $ca->issue("App::CamelPKI::CertTemplate::Foo", $pubkey,
               name => "Frida", uid => $fredid);
    $cursor = $ca->database->search(name => "Fred", -revoked => undef);
    isnt($cursor->revocation_time(), undef,
       "the Fred certificate is revoked");
    is($ca->database->search(-revoked => undef, name => "Frida")->count, 0,
       q"No means to use $ca->databae to get "
       . q"new certificats in preview");

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

    $cursor = $cadb->search(template => "foobar", -revoked => 1);
    ok(! $cursor->has_more);
    is($cursor->count, 0, 'Filter "and" which exclude all');

    # This one is tricky: the search matches for two reasons (zoinx =>
    # "is" and zoinx => "tan"), but we want only one response back.
    $cursor = $cadb->search(zoinx => undef);
    is($cursor->count, 1);
    is_deeply([ sort @{$cursor->infos->{zoinx}}], [qw(is tan)])
        or warn Data::Dumper::Dumper(scalar $cursor->infos);
};

test "REGRESSION: searching with multiple nominatives keys" => sub {
    my $cadb = open_db;
    my @certs = $cadb->search(foo => "bar", zoinx => "is");
    is(scalar(@certs), 1);

    @certs = $cadb->search(foo => "bar", zoinx => "is", zoinx => "tan");
    is(scalar(@certs), 1);
};

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

    my $cadb = open_db;
    my $cert = App::CamelPKI::Certificate->parse
        ($test_self_signed_certs{"rsa2048"});
    $cadb->add($cert, foo => "bar", baz => [ "quux", "bloggs" ]);

    # Witness Experiency:
    my $cursor = $cadb->search();
    is($cursor->count, 1);
    my $infos = $cursor->infos;
    is($infos->{foo}->[0], "bar")
        or warn Data::Dumper::Dumper($infos);
    is_deeply([sort @{$infos->{baz}}], [qw(bloggs quux)]);

    # Experiency test:
    $cursor = $cadb->search(foo => "bar");
    is($cursor->count, 1);
    is_deeply(scalar($cursor->infos), $infos)
        or warn Data::Dumper::Dumper(scalar($cursor->infos));
};

change_db_dir();

test "synopsis" => sub {
    my $code = My::Tests::Below->pod_code_snippet("synopsis");
    $code =~ s/\bmy /our /g;

    my $dir = $testdir;
    my $certificate = $cert;

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

    }

The effect is to revoke all certificates that have $host as their DNS
name in any of the templates that this controller class deals with.

=cut

sub revokeJSON : Local :  ActionClass("+App::CamelPKI::Action::JSON") {
    my ($self, $c, $revocdetails) = @_;

	print "\n\n\n 1-- ".Data::Dumper::Dumper($self->_revocation_keys."\n\n\n");
    my $ca = $c->model("CA")->instance;
    foreach my $shorttemplate ($self->_list_template_shortnames()) {
        my $template = "App::CamelPKI::CertTemplate::$shorttemplate";
        
        my @revocation_criteria =
            map { exists($revocdetails->{$_}) ?
                      ($_ => $revocdetails->{$_}) :
                          () } ($self->_revocation_keys);
        throw App::CamelPKI::Error::User
            ("Attempt revoke whole template group")

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

Returns ref($c->model("CA")), which is an indicator of the privilege
level that the HTTP/S client is wielding (deduced from its client
certificate in L<App::CamelPKI>). A JSON request is not needed, allowing
the use of C<curl> in command-line mode for testing purposes.

=cut

sub ca_permission_level : Local {
    my ($self, $c) = @_;

    require Data::Dumper;

    local $Data::Dumper::Indent = $Data::Dumper::Indent = 1;
    local $Data::Dumper::Terse = $Data::Dumper::Terse = 1;

    $c->response->content_type("text/plain");
    $c->response->body
        (sprintf(<<'TEMPLATE',
ref($c->model("CA")) = "%s"
$c->engine->apache->subprocess_env =
  %s
TEMPLATE
                 ref($c->model("CA")),
                 Data::Dumper::Dumper([$c->engine->apache
                                       ->subprocess_env])));
}

=head2 throw_exception

As the name implies, throws a structured exception.

=cut

use App::CamelPKI::Error;

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

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";
    }
    $retval .= $self->stacktrace;
    return $retval;
}



require My::Tests::Below unless caller();

t/04-RevokeByJSON.t  view on Meta::CPAN

=head2 cert_is_revoked($certobj)

Returns true if $certobj is currently in the CRL.

=cut

sub cert_is_revoked {
    my $crl = App::CamelPKI::CRL->parse
        (plaintextcall_remote("https://localhost:$port/ca/current_crl"));
        #print Data::Dumper::Dumper($crl);
        my $dlcrl = shift;

    return $crl->is_member($dlcrl);
};

t/maintainer/dependencies.t  view on Meta::CPAN

The list of modules that can be assumed to always be present
regardless of the version of Perl, and need not be checked for.  By
default only pragmatic modules (starting with a lowercase letter) and
modules that already were in 5.000 according to L<Module::CoreList>
are listed.

=cut

our @pervasives = qw(base warnings strict overload utf8 vars constant
                     Exporter Data::Dumper Carp
                     Getopt::Std Getopt::Long
                     DynaLoader ExtUtils::MakeMaker
                     POSIX Fcntl Cwd Sys::Hostname
                     IPC::Open2 IPC::Open3
                     File::Basename File::Find);

=head2 @maintainer_dependencies

The list of modules that are used in C<t/maintainer>, and for which
there should be provisions to bail out cleanly if they are missing (as