1## OpenXPKI::Tests
2##
3## Written 2007 by Alexander Klink for the OpenXPKI project
4## (C) Copyright 2007 by The OpenXPKI Project
5package OpenXPKI::Tests;
6
7use strict;
8use warnings;
9use English;
10use Carp;
11
12use OpenXPKI::Client;
13use Test::More;
14use File::Path;
15use Cwd;
16
17use Data::Dumper;
18
19use vars qw( @EXPORT );
20use Exporter 'import';
21@EXPORT = qw(
22    deploy_test_server
23    start_test_server
24    login
25    is_error_response
26    isnt_deeply
27    create_ca_cert
28    wfconnect
29    wfexec
30    wfstate
31    wfparam
32    wfdisconnect
33    wfconnect_ok
34    wfcreate_ok
35    wfexec_ok
36    wfparam_is
37    wfstate_is
38);
39
40
41## TODO - this uses only outdated stuff
42sub deploy_test_server {
43    my $arg_ref     = shift;
44    my $instancedir = $arg_ref->{DIRECTORY};
45    my $opensslfile = '';
46    if ( -e 't/cfg.binary.openssl' ) {
47        open my $OPENSSLCFG, '<', 't/cfg.binary.openssl';
48        $opensslfile = <$OPENSSLCFG>;
49        close $OPENSSLCFG;
50        $opensslfile = ''
51            if ( ( !( -e $opensslfile ) )
52            || ( !( -x _ ) )
53            || ( `$opensslfile version` !~ m{\A OpenSSL\ 0\.9\.8 }xms ) );
54    }
55
56    diag("Locally deploying OpenXPKI");
57
58    # check if infrastructure commands are installed
59
60    my $openxpkiadm        = "openxpkiadm";
61    my $openxpki_configure = "openxpki-configure";
62    if ( $ENV{DEPLOYMENT_PREFIX} ) {
63        diag "Deployment prefix is: $ENV{DEPLOYMENT_PREFIX}\n ";
64        $openxpkiadm = $ENV{DEPLOYMENT_PREFIX} . "/$openxpkiadm"
65            if ( -e $ENV{DEPLOYMENT_PREFIX} . "/$openxpkiadm" && -x _ );
66        diag "Using openxpkiadm: $openxpkiadm\n ";
67        $openxpki_configure = $ENV{DEPLOYMENT_PREFIX} . "/$openxpki_configure"
68            if ( -e $ENV{DEPLOYMENT_PREFIX} . "/$openxpki_configure"
69            && -x _ );
70        diag "Using openxpki-configure: $openxpki_configure\n ";
71        $ENV{PATH} = $ENV{DEPLOYMENT_PREFIX} . ":" . $ENV{PATH};
72    }
73
74    if ( system("$openxpkiadm >/dev/null 2>&1") != 0 ) {
75        diag("openxpkiadm is not installed!");
76        return 0;
77    }
78
79    if ( !mkpath($instancedir) ) {
80        diag("$instancedir could not be created");
81        return 0;
82    }
83
84    # be quiet by default
85    my $stderr = '>/dev/null 2>/dev/null';
86    if ( $ENV{DEBUG} ) {
87        $stderr = '';
88    }
89
90    # deployment
91    if ( system("$openxpkiadm deploy --prefix $instancedir $stderr") ) {
92        diag("openxpkiadm deploy failed");
93        return 0;
94    }
95
96    # meta config should now exist
97    if ( !-e "$instancedir/usr/local/etc/openxpki/openxpki.conf" ) {
98        diag("openxpki.conf does not exist");
99        return 0;
100    }
101
102    my ($pw_name)          = getpwuid($EUID);
103    my ($gr_name)          = getgrgid($EGID);
104    my %configure_settings = (
105        'dir.prefix'        => File::Spec->rel2abs($instancedir),
106        'dir.dest'          => File::Spec->rel2abs($instancedir),
107        'server.socketfile' => "$instancedir/var/openxpki/openxpki.socket",
108        'server.runuser'    => $pw_name,
109        'server.rungroup'   => $gr_name,
110        'database.type'     => 'SQLite',
111        'database.name'     => "$instancedir/var/openxpki/sqlite.db",
112    );
113    $configure_settings{'file.openssl'} = $opensslfile if ($opensslfile);
114
115    # configure in this directory
116    my $dir = getcwd();
117    if ( !chdir $instancedir ) {
118        diag("Could not change to $instancedir");
119        return 0;
120    }
121
122    my $args = "--batch --createdirs --";
123    foreach my $key ( keys %configure_settings ) {
124        $args .= " --setcfgvalue $key=$configure_settings{$key}";
125    }
126    if ( system("$openxpki_configure $args $stderr") ) {
127        diag("openxpki-configure failed");
128        return 0;
129    }
130
131    # and back
132    chdir($dir);
133
134    $args = '';
135    if ( $ENV{DEBUG} ) {
136        $args .= ' --debug 128 ';
137    }
138    if (system(
139            "$openxpkiadm initdb $args --config $instancedir/usr/local/etc/openxpki/config.xml $stderr"
140        )
141        )
142    {
143        diag("openxpkiadm initdb failed");
144        return 0;
145    }
146    return 1;
147}
148
149sub create_ca_cert {
150    my $arg_ref     = shift;
151    my $instancedir = $arg_ref->{DIRECTORY};
152    my $configfile;
153    $configfile = $arg_ref->{CONFIGFILE} if ( $arg_ref->{CONFIGFILE} );
154
155    my $openssl = 'openssl';
156    if ( $arg_ref->{OPENSSL_FILE} ) {
157        $openssl = $arg_ref->{OPENSSL_FILE};
158        $openssl = 'openssl' if ( ( !( -e $openssl ) ) || ( !( -x _ ) ) );
159    }
160
161    if ( !( `$openssl version` =~ m{\A OpenSSL\ 0\.9\.8 }xms ) ) {
162        diag "OpenSSL 0.9.8 not available";
163        return 0;
164    }
165
166    if ( !$configfile || !-e $configfile ) {
167        diag "Trying to use default OpenSSL config file.";
168        $configfile = '';
169    }
170    else {
171        $configfile = cwd() . "/$configfile"
172            if ( $configfile !~ m{ \A \/ }xms );
173        diag "Using local OpenSSL config file ($configfile).";
174        $configfile = "-config $configfile";
175    }
176
177    my $openxpkiadm = "openxpkiadm";
178    if ( $ENV{DEPLOYMENT_PREFIX} ) {
179        diag "Using deployment prefix: $ENV{DEPLOYMENT_PREFIX}\n ";
180        $openxpkiadm = $ENV{DEPLOYMENT_PREFIX} . "/$openxpkiadm"
181            if ( -e $ENV{DEPLOYMENT_PREFIX} . "/$openxpkiadm" && -x _ );
182    }
183
184    `mkdir -p $instancedir/usr/local/etc/openxpki/ca/testdummyca1/`;
185    if ($CHILD_ERROR) {
186        diag "Could not create directory";
187        return 0;
188    }
189
190    `pwd=1234567890 $openssl genrsa -des -passout env:pwd -out $instancedir/usr/local/etc/openxpki/ca/testdummyca1/cakey.pem`;
191    if ($CHILD_ERROR) {
192        diag "Could not generate CA key";
193        return 0;
194    }
195    `(echo '.'; echo '.'; echo '.'; echo 'OpenXPKI'; echo 'Testing CA'; echo 'Testing CA'; echo '.'; echo '.'; echo '.')|pwd=1234567890 $openssl req -new $configfile -key $instancedir/usr/local/etc/openxpki/ca/testdummyca1/cakey.pem -passin env:pwd -out $instancedir/csr.pem`;
196    if ($CHILD_ERROR) {
197        diag "Could not generate CA CSR";
198        return 0;
199    }
200
201    `mkdir $instancedir/demoCA`;
202    `touch $instancedir/demoCA/index.txt`;
203    `echo 01 > $instancedir/demoCA/serial`;
204
205    `cd $instancedir; pwd=1234567890 $openssl ca -selfsign $configfile -in csr.pem -keyfile etc/openxpki/ca/testdummyca1/cakey.pem -passin env:pwd -utf8 -outdir . -policy policy_anything -batch -extensions v3_ca -preserveDN -out cacert.pem`;
206    if ($CHILD_ERROR) {
207        diag "Could not issue CA certificate";
208        return 0;
209    }
210
211    open CACERT_IN, '<', "$instancedir/cacert.pem";
212    open CACERT_OUT, '>',
213        "$instancedir/usr/local/etc/openxpki/ca/testdummyca1/cert.pem";
214    my $cert;
215    while (<CACERT_IN>) {
216        if ( $_ =~ m{ \A -----BEGIN }xms ) {
217            $cert = 1;
218        }
219        next if ( !$cert );
220        print CACERT_OUT $_;
221    }
222    close CACERT_IN;
223    close CACERT_OUT;
224
225    my $identifier
226        = `$openxpkiadm certificate import --config $instancedir/usr/local/etc/openxpki/config.xml --file $instancedir/usr/local/etc/openxpki/ca/testdummyca1/cert.pem|tail -1|sed -e 's/  Identifier: //'`;
227    if ( $CHILD_ERROR || !$identifier ) {
228        diag "Could not import CA cert into DB";
229        return 0;
230    }
231    `$openxpkiadm certificate alias --config $instancedir/usr/local/etc/openxpki/config.xml -realm I18N_OPENXPKI_DEPLOYMENT_TEST_DUMMY_CA --alias testdummyca1 --identifier $identifier`;
232    if ($CHILD_ERROR) {
233        diag "Could not create alias for certificate";
234        return 0;
235    }
236    open PATCH, "|patch -p0";
237    print PATCH << "XEOF";
238--- $instancedir/usr/local/etc/openxpki/config.xml  2006-12-04 10:41:16.000000000 +0100
239+++ $instancedir/usr/local/etc/openxpki/config.xml  2006-12-04 10:49:32.000000000 +0100
240@@ -46,8 +46,8 @@
241
242       <secret>
243         <group id="default" label="I18N_OPENXPKI_CONFIG_DEFAULT_SECRET_AUTHENTICATION_GROUP">
244-          <method id="plain">
245-            <total_shares>1</total_shares>
246+          <method id="literal">
247+            <value>1234567890</value>
248           </method>
249           <cache>
250             <type>daemon</type>
251XEOF
252    close PATCH;
253    if ($CHILD_ERROR) {
254        diag "Could not patch file";
255        return 0;
256    }
257
258    return 1;
259}
260
261sub start_test_server {
262    my $arg_ref     = shift;
263    my $instancedir = $arg_ref->{DIRECTORY};
264    if ( !defined $instancedir ) {
265        diag "No DIRECTORY passed";
266        return 0;
267    }
268    my $configfile = $instancedir . '/usr/local/etc/openxpki/config.xml';
269
270    my $stderr = '>/dev/null 2>/dev/null';
271
272# TODO
273# if this is uncommented, prove hangs on t/60_workflow/09_deploy_and_start_testserver - !???
274# uncommented for now, the information is not that important anyways
275# (it is the STDERR output before the stderr is redirect, this is
276# only interesting if the server does not start, but this can and should
277# be investigated manually anyways ...)
278#
279#if ($ENV{DEBUG}) {
280#    $stderr = '';
281#}
282
283    my $args = '';
284    if ( $arg_ref->{FOREGROUND} ) {
285        $args = '--foreground';
286    }
287    if ( $ENV{DEBUG} ) {
288        $args .= ' --debug 128 ';
289    }
290
291    my $openxpkictl = "openxpkictl";
292    if (   $ENV{DEPLOYMENT_PREFIX}
293        && -e $ENV{DEPLOYMENT_PREFIX} . "/$openxpkictl"
294        && -x _ )
295    {
296        $openxpkictl = $ENV{DEPLOYMENT_PREFIX} . "/$openxpkictl";
297        diag "Using openxpkictl: $openxpkictl\n ";
298    }
299
300    return !system("$openxpkictl --config $configfile $args start $stderr");
301}
302
303sub login {
304    my $arg_ref = shift;
305    my $client  = $arg_ref->{CLIENT};
306    my $user    = $arg_ref->{USER};
307    my $pass    = $arg_ref->{PASSWORD};
308    my $realm    = $arg_ref->{REALM};
309    my $msg;
310
311    $client->init_session();
312
313    if ( $realm ) {
314        $msg = $client->send_receive_service_msg( 'GET_PKI_REALM', { PKI_REALM => $realm } );
315        if (is_error_response($msg)) {
316            diag "Login failed (get pki realm): " . Dumper $msg;
317            return 0;
318        }
319        $msg = $client->send_receive_service_msg( 'PING',  );
320        if (is_error_response($msg)) {
321            diag "Login failed (ping): " . Dumper $msg;
322            return 0;
323        }
324    }
325
326    if ( $user ) {
327        $msg = $client->send_receive_service_msg(
328            'GET_AUTHENTICATION_STACK',
329            {
330                'AUTHENTICATION_STACK' => 'External Dynamic',
331            },
332        );
333        if (is_error_response($msg)) {
334            diag "Login failed (get auth stack 'External Dynamic'): " . Dumper $msg;
335            return 0;
336        }
337
338        $msg = $client->send_receive_service_msg(
339        'GET_PASSWD_LOGIN',
340        {   'LOGIN'  => $user,
341            'PASSWD' => $pass,
342        },
343        );
344        if (is_error_response($msg)) {
345            diag "Login failed (login as user $user): " . Dumper $msg;
346            return 0;
347        }
348    } else {
349        $msg = $client->send_receive_service_msg(
350            'GET_AUTHENTICATION_STACK',
351            {
352                'AUTHENTICATION_STACK' => 'Anonymous',
353            },
354        );
355        if (is_error_response($msg)) {
356            diag "Login failed (get auth stack 'Anonymous'): " . Dumper $msg;
357            return 0;
358        }
359    }
360
361    return 1;
362}
363
364sub is_error_response {
365    my $msg = shift;
366    if ( exists $msg->{'SERVICE_MSG'} && $msg->{'SERVICE_MSG'} eq 'ERROR' ) {
367        return 1;
368    }
369    else {
370        return 0;
371    }
372}
373
374sub isnt_deeply {
375    my $a    = shift;
376    my $b    = shift;
377    my $name = shift;
378    local $Test::Builder::Level = $Test::Builder::Level + 1;
379    ok( !Test::More::_deep_check( $a, $b ), $name );
380}
381
382############################################################
383# Subroutines to query and manipulate workflows
384############################################################
385# $client = wfconnect( USER, PASS, SOCKETFILE, REALM );
386sub wfconnect {
387    my ( $u, $p, $sock, $realm ) = @_;
388    my $c = OpenXPKI::Client->new(
389        {   TIMEOUT    => 100,
390            SOCKETFILE => $sock,
391        }
392    );
393    croak "Unable to create OpenXPKI::Client instance: $@" unless $c;
394
395    if ($u) {
396    login(
397            {   CLIENT   => $c,
398            USER     => $u,
399            PASSWORD => $p,
400            REALM => $realm,
401        }
402        ) or croak "Login as $u failed: $@";
403    }
404    else {
405        login( { CLIENT => $c, REALM => $realm } ) or croak "Login as anonymous failed: $@";
406    }
407    return $c;
408}
409
410# usage: my $msg = wfexec( CLIENT, ID, ACTIVITY, { PARAMS } );
411sub wfexec {
412    my ( $client, $id, $act, $params ) = @_;
413    my $msg;
414
415    croak("Unable to exec action '$act' on closed connection")
416        unless defined $client;
417
418    $msg = $client->send_receive_command_msg(
419        'execute_workflow_activity',
420        {   'ID'       => $id,
421            'ACTIVITY' => $act,
422            'PARAMS'   => $params,
423#            'WORKFLOW' => $wf_type,
424        },
425    );
426    return $msg;
427
428}
429
430# usage: my $state = wfstate( CLIENT, ID );
431# Note: $@ contains either error message or Dumper($msg)
432sub wfstate {
433    my ($client, $id) = @_;
434    my ( $msg, $state );
435    $@ = '';
436
437    croak("Unable to fetch state on closed connection")
438        unless defined $client;
439
440    $msg = $client->send_receive_command_msg( 'get_workflow_info',
441        { #'WORKFLOW' => $wf_type,
442            'ID' => $id, } );
443    if ( is_error_response($msg) ) {
444        $@ = "Error running get_workflow_info: " . Dumper($msg);
445        return;
446    }
447    $@ = Dumper($msg);
448    return $msg->{PARAMS}->{WORKFLOW}->{STATE};
449}
450
451# usage: my $param = wfparam( CLIENT, ID, PARAM );
452# Note: $@ contains either error message or Dumper($msg)
453sub wfparam {
454    my ( $client, $id, $name ) = @_;
455    my ( $msg, $state );
456    $@ = '';
457
458
459    croak("Unable to fetch state on closed connection")
460        unless defined $client;
461
462    $msg = $client->send_receive_command_msg( 'get_workflow_info',
463        { #'WORKFLOW' => $wf_type,
464            'ID' => $id, } );
465    if ( is_error_response($msg) ) {
466        $@ = "Error running get_workflow_info: " . Dumper($msg);
467        return;
468    }
469    $@ = Dumper($msg);
470    diag( "msg=" . Dumper($msg) );
471    return $msg->{PARAMS}->{WORKFLOW}->{STATE};
472}
473
474# usage: wfdisconnect( CLIENT );
475sub wfdisconnect {
476    my $client = shift;
477    eval { $client && $client->send_receive_service_msg('LOGOUT'); };
478    $client = undef;
479}
480
481
482
483############################################################
484# Helper subroutines that are similar to Test::More, etc.
485############################################################
486# CLIENT = wfconnect_ok( PARAMSREF [, TESTNAME ] )
487# PARAMSREF is a hash ref with the keys 'user', 'role', 'socketfile', 'realm'
488#
489sub wfconnect_ok {
490    my ( $params, $testname ) = @_;
491    my $client = undef;
492    warn "Entered wfconnect_ok with params: ", join(', ', %{ $params } );
493
494    if ( $params->{user} ) {
495        if ( not defined $testname ) {
496            $testname = 'Connect to OpenXPKI with user ' . $params->{user};
497        }
498        $client = wfconnect( $params->{user}, $params->{role}, $params->{socketfile}, $params->{realm} );
499    } else {
500        if ( not defined $testname ) {
501            $testname = 'Connect to OpenXPKI as Anonymous';
502        }
503        $client = wfconnect(undef, undef, $params->{socketfile}, $params->{realm});
504    }
505    if ( ok($client, $testname) ) {
506        return $client;
507    } else {
508        return;
509    }
510
511}
512
513# WFID = wfcreate_ok( CLIENT, WFTYPE [, PARAMSREF ] );
514sub wfcreate_ok {
515    my ( $client, $wftype, $params ) = @_;
516
517    my $msg = $client->send_receive_command_msg(
518        'create_workflow_instance',
519        { PARAMS => $params, WORKFLOW => $wftype },
520    );
521
522    if ( not ok( !is_error_response($msg), 'Creating workflow ' . $wftype ) ) {
523        $@ = Dumper($msg);
524        return;
525    }
526    return $msg->{PARAMS}->{WORKFLOW}->{ID};
527}
528
529# wfexec_ok( CLIENT, WFID, ACTION, PARAMS, DIEONFAIL )
530sub wfexec_ok {
531    my ( $client, $wfid, $action, $params, $dieonfail ) = @_;
532    my $msg;
533
534    if ( not defined $params ) {
535        $params = {};
536    }
537
538    croak("Unable to exec action '$action' on closed connection")
539        unless defined $client;
540
541    $msg = $client->send_receive_command_msg(
542        'execute_workflow_activity',
543        {   'ID'       => $wfid,
544            'ACTIVITY' => $action,
545            'PARAMS'   => $params,
546
547            #            'WORKFLOW' => $wf_type,
548        },
549    );
550
551    if (not ok( !is_error_response($msg), 'Executed WF activity ' . $action )
552        )
553    {
554        if ($dieonfail) {
555            croak( "Error executing ", $action, ": ", Dumper($msg) );
556        }
557        else {
558            diag( "Error executing ", $action, ": ", Dumper($msg) );
559        }
560    }
561    return $msg;
562}
563
564# wfparam_is( CLIENT, WFID, PARAM_NAME, EXPECTED, TESTNAME );
565sub wfparam_is {
566    my ( $client, $wfid, $param, $expected, $testname ) = @_;
567    my $msg;
568
569    croak("Unable to fetch params on closed connection")
570        unless defined $client;
571    $msg = $client->send_receive_command_msg(
572        'get_workflow_info',
573        {    #'WORKFLOW' => $wf_type,
574            'ID' => $wfid,
575        }
576    );
577    if ( is_error_response($msg) ) {
578        fail($testname);
579        diag( "Error running get_workflow_info: " . Dumper($msg) );
580        return;
581    }
582    else {
583        is( $msg->{PARAMS}->{WORKFLOW}->{CONTEXT}->{$param},
584            $expected, $testname ) or diag "MSG=", Dumper($msg);
585    }
586}
587
588
589# wfstate_is( CLIENT, WFID, EXPECTED_STATE [, TESTNAME ] );
590sub wfstate_is {
591    my ( $client, $wfid, $expected, $testname ) = @_;
592    my $msg;
593
594    $testname ||= "Checking WF $wfid for state $expected";
595
596    croak("Unable to fetch state on closed connection")
597        unless defined $client;
598    $msg = $client->send_receive_command_msg(
599        'get_workflow_info',
600        {    #'WORKFLOW' => $wf_type,
601            'ID' => $wfid,
602        }
603    );
604    if ( is_error_response($msg) ) {
605        fail($testname);
606        diag( "Error running get_workflow_info: " . Dumper($msg) );
607        return;
608    }
609    else {
610        is( $msg->{PARAMS}->{WORKFLOW}->{STATE},
611            $expected, $testname );
612    }
613}
614
6151;
616
617__END__
618
619=head1 Name
620
621OpenXPKI::Tests
622
623=head1 Description
624
625This is a helper module for the OpenXPKI test suites. It
626adds a lot of helper functions for deploying, starting,
627stopping a server as well as own test functions that add tests for
628various things.
629
630=head1 Functions
631
632All of these functions are exported into the caller namespace for
633easier calling (and because it is assumed that tests don't use
634much of the namespace for themselves anyways).
635
636=head2 deploy_test_server
637
638Deploys test server configuration. Takes a named argument of 'DIRECTORY',
639which is the directory into which the server will be deployed.
640Returns 1 if deployment was successfull, 0 otherwise.
641
642=head2 create_ca_cert
643
644Creates a CA certificate using OpenSSL for installation in a freshly
645deployed test server. Takes a named argument of 'DIRECTORY', which is
646the directory of the deployed server.
647Also imports the certificate into the OpenXPKI database and creates an
648appropriate alias for it. Then patches the config file to use the
649literal password for the key. This enables you to start a test server
650with a working CA certificate using start_test_server().
651
652=head2 start_test_server
653
654Starts the deployed test server. Takes an optional argument of
655FOREGROUND, which will start the server in the foreground (this is
656useful so that a forked child can send commands to the server and
657the coverage report gets server information instead of client information).
658The named argument 'DIRECTORY' is the one used in deploy_test_server()
659to find the corresponding configuration file.
660Returns 1 if starting the server was successfull, 0 otherwise.
661
662=head2 login
663
664Expects the named arguments CLIENT (which is an OpenXPKI::Client object),
665USER and PASSWORD. Initializes the client session and logs the user in
666using the Operator stack and the given username and password.
667Returns 1 on success, 0 on failure.
668
669=head2 is_error_response
670
671Expects a message returned by a call to send_receive_command_msg().
672Returns 1 if the response from the server signifies an error, 0 otherwise.
673
674=head2 isnt_deeply
675
676Checks that structures differ deeply. This is the opposite of
677is_deeply from Test::More.
678