view release on metacpan or  search on metacpan

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

B<App::CamelPKI::Test> - L<App::CamelPKI> Tests.

=head1 SYNOPSIS

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

  use App::CamelPKI::Test qw(:default %test_der_DNs);
  use Test::Group;

  my $utf8 = App::CamelPKI::Test->test_simple_utf8();

  run_perl_ok(<<"SCRIPT");
  use App::CamelPKI::Test;
  warn "Hello world";
  SCRIPT

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

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

 use App::CamelPKI::Test qw(x509_decoder);

 my $dn_as_tree = x509_decoder('Name')->decode($dn_der);

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

 server_start();
 server_stop();

=head1 DESCRIPTION

This module is a library which aims at simplifying App-PKI test writing.
It started as a raw copy of I<Crypt::OpenSSL::CA:Test> you can find in
the C<t/lib> directory of the source L<Crypt::OpenSSL::CA> CPAN source
package.


=head1 EXPORTED FUNCTIONS

All functions described in this section factor some useful test
tactics and are exported by default.  The L</SAMPLE INPUTS> may also
be exported upon request.

=over

=cut

use Test::Builder;
use Test::More;
use Test::Group;
use File::Find;
use File::Path ();
use File::Spec::Functions qw(catfile catdir);
use File::Slurp;
use File::Temp ();
use POSIX ":sys_wait_h";
use File::Which ();
use IO::Socket::SSL;
use LWP::UserAgent;
use HTTP::Request;
#pour formulaires
use URI::URL;
use HTTP::Request::Common;
use HTTP::Request::Form;
use HTML::TreeBuilder 3.0;

use base 'Exporter';
BEGIN {
    our @EXPORT =
        qw(openssl_path run_thru_openssl run_dumpasn1
           run_perl run_perl_ok
           certificate_looks_ok
           certificate_chain_ok certificate_chain_invalid_ok
           x509_schema x509_decoder
           run_php run_php_script
           http_request_prepare http_request_execute
           plaintextcall_remote
           call_remote formcall_remote formreq_remote
           jsoncall_local jsonreq_remote jsoncall_remote
           is_php_cli_present);
    our @EXPORT_OK = (@EXPORT,
                      qw(test_simple_utf8 test_bmp_utf8
                         @test_DN_CAs
                         %test_der_DNs
                         %test_public_keys
                         %test_reqs_SPKAC %test_reqs_PKCS10
                         %test_keys_plaintext %test_keys_password
                         %test_self_signed_certs %test_rootca_certs
                         %test_entity_certs
                         test_CRL
                         server_start server_stop server_port
                         create_camel_pki_conf_php
                         camel_pki_chain
                         ));
    our %EXPORT_TAGS = ("default" => \@EXPORT);
}

=item I<plaintextcall_remote($url)>

Qureies a real Apache server at $url, which must be fully-qualified.
Throws an exception if the HTTP request isn't a success; otherwise,
Returns the C<text/plain> response as a string.

Available named options are:

=over

=item I<< -certificate => $certobj >>

=item I<< -certificate => $certpem >>

The certificate to identify oneself as, as an L<App::CamelPKI::Certificate>
instance or PEM string.

=item I<< -key => $keyobj >>

=item I<< -key => $keypem >>

The private key to use along with the certificate, as an
L<App::CamelPKI::PrivateKey> instance or PEM string.

=cut

sub plaintextcall_remote {

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

    return http_request_execute($req, @args);
}

=item I<jsoncall_remote($url, $struct, %args)>

Like L</jsonreq_remote> but instead of returning an L<HTTP::Response>
object, returns the decoded JSON data structure by reference and
throws an exception if the HTTP request isn't a success or doesn't
decode properly.

=cut

sub jsoncall_remote {
    my $response = jsonreq_remote(@_);
    my $content = $response->content;
    die sprintf("jsoncall_remote: failed with code %d\n%s\n",
                $response->code, $content) if ! $response->is_success;
    my $retval = eval { JSON::from_json($content) };
    return $retval if defined $retval;
    die $content;
}

=item I<call_remote($url)>

Gets $url and return the result.

=cut

sub call_remote {
	my ($url, @args) = @_;
	my $ua = LWP::UserAgent->new;
	my $req = http_request_prepare($url, @args);
    my $res = http_request_execute($req, @args);
 	
 	my $content = $res->content;
 	die sprintf("call_remote: failed with code %d\n%s\n",
                $res->code, $content) if ! $res->is_success;
    return $content if defined $content;
    die $content;
 	
}

=item I<formreq_remote($url $struct, $button, @args)>

Call a form and fill it based on $struct, then push on $button

=cut
sub formreq_remote {
    my ($url, $structure, $button, @args) = @_;
    
	my $ua = LWP::UserAgent->new;
	my $req = http_request_prepare($url, @args);
    my $res = http_request_execute($req, @args);
    
    my $tree = HTML::TreeBuilder->new;
    $tree->parse($res->content);
    $tree->eof();
    
    my @Forms = $tree->find_by_tag_name('FORM');
    die "No forms in page" unless @Forms;
    my $f = HTTP::Request::Form->new($Forms[0], $url);
    foreach my $part (keys(%$structure)){
    	$f->field($part, $structure->{$part});
    }
    my $response = http_request_execute($f->press($button), @args);
    return $response;
}

=item I<formcall_remote($url, $struct, %args)>

Like L</jsonreq_remote> but instead of returning an L<HTTP::Response>
object, returns the page and
throws an exception if the HTTP request isn't a success .

=cut

sub formcall_remote {
    my $response = formreq_remote(@_);
    my $content = $response->content;
    die sprintf("formcall_remote: failed with code %d\n%s\n",
                $response->code, $content) if ! $response->is_success;
    return $content if defined $content;
    die $content;
}

=item I<http_request_prepare($url, %args)>

=item I<http_request_execute($request, %args)>

These functions factor code between L</jsonreq_remote>,
L</plaintextcall_remote> and such, although they may also be called
directly.  I<http_request_prepare> creates and returns and returns a GET
L<HTTP::Request> object that the caller may further tweak, prior to
passing it along to I<http_request_execute>, which in turn does the HTTP/S
request and returns an L<HTTP::Response> object.  Named arguments are
the same as in L</jsonreq_remote>, L</plaintextcall_remote> or
L</jsoncall_remote>.

=cut

sub http_request_prepare {
    my ($url) = @_;
    return HTTP::Request->new("GET", $url);
}

sub http_request_execute {
    my ($req, %args) = @_;
    die "Bad argument $req" unless eval { $req->isa("HTTP::Request") };
    # Trust me, snarfing this undocumented variable really is the
    # most elegant way of causing LWP to use a client certificate.
    # I've gone through these hoops many, many times.
    local @LWP::Protocol::http::EXTRA_SOCK_OPTS;
    if ($args{-key} && $args{-certificate}) {
        my $keysdir = catdir(tempdir(), "test_ssl_client_keys");
        if (! -d $keysdir) {
            mkdir($keysdir) or die "Cannot mkdir($keysdir): $!\n";
        }
        write_file(my $clientcertfile = catfile($keysdir, "cert.pem"),
                   (ref($args{-certificate}) ?
                    $args{-certificate}->serialize() :
                    $args{-certificate}));
        write_file(my $clientkeyfile = catfile($keysdir, "key.pem"),
                   (ref($args{-key}) ? $args{-key}->serialize() :
                    $args{-key}));
        @LWP::Protocol::http::EXTRA_SOCK_OPTS =
            (SSL_use_cert => 1,
             SSL_cert_file => $clientcertfile,
             SSL_key_file => $clientkeyfile,
            );
    }
    return LWP::UserAgent->new->request($req);
}

=item I<camel_pki_chain>

Returns the certification chain of the App-PKI application under test,
starting with the Operational CA certificate.

=cut

sub camel_pki_chain {
    require Catalyst::Test;
    Catalyst::Test->import("App::CamelPKI");

    my $req = Catalyst::Utils::request("/ca/certificate_chain_pem");
    my $resp = Catalyst::Test::local_request("App::CamelPKI", $req)
        ->content;
    return map {$_->serialize} (App::CamelPKI::Certificate->parse_bundle($resp));
}



=item I<openssl_path>

Returns the path to the C<openssl> command-line tool, if it is known,
or undef.  Useful for skipping tests that depend on
L</run_thru_openssl> being able to run.

=cut

sub openssl_path {
    my ($openssl_bin) =
        ( `which openssl 2>/dev/null` =~ m/^(.*)/ ); # Chopped, untainted
    return if ! ($openssl_bin && -x $openssl_bin);
    return $openssl_bin;
}

=item I<run_thru_openssl($stdin_text, $arg1, $arg2, ...)>