App-CamelPKI

 view release on metacpan or  search on metacpan

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

$time is either an object of class L<App::CamelPKI::Time>, a date in the
"zulu" format (yyyymmddhhmmssZ), or the special string "now".

=item I<< -revoked => 1 >>

Returns only revoked certificates, ie those for which the most recent
call to L</revoke> did not specify C<< -reason => "removeFromCRL" >>.

=item I<< -revoked => 0 >>

Returns only valid certificates, or those that were un-revoked by
passing C<< -reason => "removeFromCRL" >> to L</revoke>.

=item I<< -revoked => undef >>

Search certificates without consideration for their revocation status.
Used to cancel the effect of the implicit value mentioned above.

=item I<< -serial => serial >>

Search certificates for the certifiate serial.

=item I<< $infokey => $infoval >>

where $infokey doesn't start by a hyphen (-): returns only
certificate(s) that had $infokey and $infoval among their %infos at
the time they where added using L</add>. $infoval may be undef,
indicating that any value for $infokey in %infos is acceptable.

=back

The return value in list context is a list of L<App::CamelPKI::Certificate>
object class. In scalar context, a B<cursor object> of the
L</App::CamelPKI::CADB::Cursor> class is returned.

=cut

sub search {
    throw App::CamelPKI::Error::Internal("WRONG_NUMBER_ARGS")
        unless (@_ % 2);
    my ($self, %searchkeys) = @_;

    if (! exists $searchkeys{-initially_valid_at} &&
        ! exists $searchkeys{-revoked}) {
        $searchkeys{-initially_valid_at} = "now";
        $searchkeys{-revoked} = 0;
    }

    # Using DBIx::Class release 0.07003, the join list to execute don't
    # support iterative enumeration, unlike the WHERE clauses. We must
    # use this dirty kludge, that violates DBIx::Class encapsulation in
    # two points:
    my @joins;
    my $cursor = $self->{dbix}->resultset("Certificate")
        ->search({ }, { join => \@joins }); # Encaps violation
    # number 1: we will be modifying \@joins later
    while(my ($k, $v) = each %searchkeys) {
        if ($k !~ m/^-/) {
            push(@joins, "infos");
            my $qualifier = (@joins == 1) ? "" : "_" . scalar(@joins);
            # encapsulation violation number 2: we try to guess the
            # way DBIx::Class disambiguates the join column names.
            $cursor = $cursor->search
                ({ "infos${qualifier}.key" => $k,
                   ( defined($v) ? ("infos${qualifier}.val" => $v) : () ),
                 });
        } elsif ($k eq "-certificate") {
            throw App::CamelPKI::Error::Internal("INCORRECT_ARGS")
                unless eval { $v->isa("App::CamelPKI::Certificate") };
            $cursor = $cursor->search
                ( { der => $v->serialize(-format => "DER") } );
        } elsif ($k eq "-initially_valid_at") {
            $v = App::CamelPKI::Time->parse($v);
            $cursor = $cursor->search
                ( { not_before => { "<=", $v->zulu },
                    not_after => { " >=", $v->zulu }} );
        } elsif ($k eq "-serial") {
        	$cursor = $cursor->search
                ( { serial => { "=", $v } } );
        } elsif ($k eq "-revoked") {
            if (! defined($v)) {
                # no-op
            } elsif ($v) {
                # Only revoked certificates
                $cursor = $cursor->search
                     # Yes, { "!=", undef } correctly translates to "IS
                     # NOT NULL". Props to SQL::Abstract!
                    ( [ -and => { revocation_time => { "!=", undef } },
                        { revocation_reason => { "!=", "removeFromCRL" } }
                      ] );
            } else {
                # Only *not* revoked certificates
                $cursor = $cursor->search
                    ( [ -or => { revocation_time => { "==", undef } },
                        { revocation_reason => "removeFromCRL" }
                      ] );
            }
        } else {
            throw App::CamelPKI::Error::Internal
                ("INCORRECT_ARGS", -details => "Unknown search key $k");
        }
    }
    $cursor = (ref($self) . "::Cursor")->_new
        ($cursor, $self->{dbix}->resultset("CertInfo"));
    return $cursor if ! wantarray;

    my @retval;
    for(; $cursor->has_more; $cursor->next) {
        push(@retval, $cursor->certificate);
    }
    return @retval;
}

=head2 revoke($cert, %options)

Mark a certificate as revoked, for the CA to know it must been 
included in the next CRLs. $cert is an instance of
L<App::CamelPKI::Certificate>. Known Named options are:

=over



( run in 1.769 second using v1.01-cache-2.11-cpan-437f7b0c052 )