commit ede04d9be3627030102a816420511210c521a0e6
Author: mbartosch <mbartosch@95d9436f-6502-0410-902c-bd9569d1a17e>
Date:   Tue Aug 23 09:29:32 2011 +0000

    Security fix for OpenXPKI::Crypto::CLI
    
    Please refer to the email to the OpenXPKI Users and Development mailing
    list for details.
    
    This commit introduces an additional dependency to the Perl module
    Proc::SafeExec and addresses a security issue in the Crypto CLI
    interface.
    
    git-svn-id: https://openxpki.svn.sourceforge.net/svnroot/openxpki@1570 95d9436f-6502-0410-902c-bd9569d1a17e

diff --git a/trunk/perl-modules/core/trunk/Makefile.PL b/trunk/perl-modules/core/trunk/Makefile.PL
index 24464d8..912a75c 100644
--- a/trunk/perl-modules/core/trunk/Makefile.PL
+++ b/trunk/perl-modules/core/trunk/Makefile.PL
@@ -316,6 +316,7 @@ WriteMakefile(
         'Net::Server'            => '0.94',
 	'Params::Validate'       => '0.77',
 	'Proc::ProcessTable'     => '0.43',
+        'Proc::SafeExec'         => '1.4',
 	'Regexp::Common'         => 2,
         'Sys::SigAction'         => '0.06',
         'Template'               => '2.15',
diff --git a/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/create_cert.pm b/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/create_cert.pm
index 46d5f97..166821d 100644
--- a/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/create_cert.pm
+++ b/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/create_cert.pm
@@ -27,8 +27,6 @@ sub get_command
     }
     $self->{CONFIG}->set_profile($self->{PROFILE});
 
-    my @result = ();
-
     $self->get_tmpfile ('CSR');
     $self->get_tmpfile ('DUMMYCA');
 
@@ -121,7 +119,7 @@ sub get_command
 
     my @subject = ();
     if ($subject) {
-	push(@subject, '-subj', qq("$subject"));
+	push(@subject, '-subj', $subject);
 
 	if ($subject =~ /[^\\](\\\\)*\+/) {
 	    push(@subject, '-multivalue-rdn');
@@ -130,12 +128,12 @@ sub get_command
 
     my @engine = ();
     if ($engine) {
-	push(@engine, '-engine', qq("$engine"));
+	push(@engine, '-engine', $engine);
     }
 
     my @keyform = ();
     if ($keyform) {
-	push(@keyform, '-keyform', qq("$keyform"));
+	push(@keyform, '-keyform', $keyform);
     }
     
     my @password = ();
@@ -144,27 +142,21 @@ sub get_command
         $self->set_env ("pwd" => $passwd);
     }
 
-    my @cmd;
-    @cmd = (
+    my @cmd1 = (
 	'req',     '-x509',
         # done by CLI
 	# '-config', $config,
 	@subject,
 	@engine,
 	@keyform,
-	'-key',    qq("$self->{KEYFILE}"),
-	'-out',    qq("$self->{DUMMYCAFILE}"),
-	'-in',     qq("$self->{CSRFILE}"),
+	'-key',    $self->{KEYFILE},
+	'-out',    $self->{DUMMYCAFILE},
+	'-in',     $self->{CSRFILE},
 	'-set_serial', $self->{PROFILE}->get_serial(),
 	'-days',   '1',
 	@password,
 	);
 
-
-    ##! 2: "command: " . join(' ', @cmd)
-    push @result, join(' ', @cmd);
-
-
     # STEP 1b: restore serial number (serial file content is incremented
     # by previous OpenSSL command)
     # NOTE:
@@ -178,7 +170,7 @@ sub get_command
 #     };
 
     # STEP 2: Using the Dummy CA created above issue the actual CA certificate
-    @cmd = (
+    my @cmd2 = (
 	'ca',
 	'-batch',
 	#done by CLI
@@ -186,17 +178,15 @@ sub get_command
 	@subject,
 	@engine,
 	@keyform,
-	'-keyfile', qq("$self->{KEYFILE}"),
-	'-cert',    qq("$self->{DUMMYCAFILE}"),
-	'-out',     qq("$self->{OUTFILE}"),
-	'-ss_cert', qq("$self->{DUMMYCAFILE}"),
+	'-keyfile', $self->{KEYFILE},
+	'-cert',    $self->{DUMMYCAFILE},
+	'-out',     $self->{OUTFILE},
+	'-ss_cert', $self->{DUMMYCAFILE},
 	@password,
 	);
 
     ##! 2: "command: " . join(' ', @cmd)
-    push @result, join(' ', @cmd);
-
-    return \@result;
+    return [ \@cmd1, \@cmd2 ];
 }
 
 sub hide_output
diff --git a/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/create_pkcs10.pm b/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/create_pkcs10.pm
index c6155e1..3789ad5 100644
--- a/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/create_pkcs10.pm
+++ b/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/create_pkcs10.pm
@@ -88,23 +88,21 @@ sub get_command
 
     ## build the command
 
-    my $command  = "req -new";
-    #done by CLI
-    #$command .= " -config $config";
-    $command .= " -subj \"$subject\"";
-    $command .= " -multivalue-rdn" if ($subject =~ /[^\\](\\\\)*\+/);
-    $command .= " -engine $engine" if ($engine);
-    $command .= " -keyform $keyform" if ($keyform);
-    $command .= " -key ".$self->{KEYFILE};
-    $command .= " -out ".$self->{OUTFILE};
+    my @command = qw( req -new );
+    push @command, ('-subj', $subject);
+    push @command, '-multivalue-rdn' if ($subject =~ /[^\\](\\\\)*\+/);
+    push @command, ('-engine', $engine) if ($engine);
+    push @command, ('-keyform', $keyform) if ($keyform);
+    push @command, ('-key', $self->{KEYFILE});
+    push @command, ('-out', $self->{OUTFILE});
 
     if (defined $passwd)
     {
-        $command .= " -passin env:pwd";
+        push @command, ('-passin', 'env:pwd');
         $self->set_env ("pwd" => $passwd);
     }
 
-    return [ $command ];
+    return [ \@command ];
 }
 
 sub __get_used_engine 
diff --git a/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/issue_cert.pm b/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/issue_cert.pm
index cf698a0..4fb968b 100644
--- a/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/issue_cert.pm
+++ b/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/Backend/OpenSSL/Command/issue_cert.pm
@@ -81,26 +81,29 @@ sub get_command
 
     ## build the command
 
-    my $command  = "ca -batch";
-    $command .= ' -subj "'.$self->get_openssl_dn($profile->get_subject()).'"';
-    $command .= " -multivalue-rdn" if ($profile->get_subject() =~ /[^\\](\\\\)*\+/);
-    $command .= " -engine $engine" if ($engine);
-    $command .= " -keyform $keyform" if ($keyform);
-    $command .= " -out ".$self->{OUTFILE};
+    my @command = qw( ca -batch );
+    push @command, (
+        '-subj',
+        $self->get_openssl_dn($profile->get_subject()),
+    );
+    push @command, '-multivalue-rdn' if ($profile->get_subject() =~ /[^\\](\\\\)*\+/);
+    push @command, ('-engine', $engine) if ($engine);
+    push @command, ('-keyform', $keyform) if ($keyform);
+    push @command, ('-out', $self->{OUTFILE});
     if ($spkac)
     {
-        $command .= " -spkac ".$self->{CSRFILE};
+        push @command, ('-spkac', $self->{CSRFILE});
     } else {
-        $command .= " -in ".$self->{CSRFILE};
+        push @command, ('-in', $self->{CSRFILE});
     }
 
     if (defined $passwd)
     {
-        $command .= " -passin env:pwd";
+        push @command, ('-passin', 'env:pwd');
         $self->set_env ("pwd" => $passwd);
     }
 
-    return [ $command ];
+    return [ \@command ];
 }
 
 sub hide_output
diff --git a/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/CLI.pm b/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/CLI.pm
index 45a6a32..3a5237b 100644
--- a/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/CLI.pm
+++ b/trunk/perl-modules/core/trunk/OpenXPKI/Crypto/CLI.pm
@@ -14,7 +14,9 @@ use OpenXPKI::Debug;
 #use OpenXPKI qw (read_file get_safe_tmpfile);
 use OpenXPKI::FileUtils;
 use OpenXPKI::Exception;
+use OpenXPKI::Server::Context;
 use Data::Dumper;
+use Proc::SafeExec;
 
 my %tmp_of    :ATTR( :init_arg<TMP>    ); # the tmp directory
 my %shell_of  :ATTR( :init_arg<SHELL>  ); # the shell to be used
@@ -23,6 +25,7 @@ my %stdin_file_of  :ATTR; # STDIN  file (redirected input to command)
 my %stdout_file_of :ATTR; # STDOUT file (redirected output from command)
 my %stderr_file_of :ATTR; # STDERR file (redirected output from command)
 my %command_of     :ATTR; # the command used
+my %logger_of      :ATTR; # OpenXPKI logger
 
 sub START {
     my ($self, $ident, $arg_ref) = @_;
@@ -56,6 +59,10 @@ sub START {
             message => "I18N_OPENXPKI_CRYPTO_CLI_MISSING_ENGINE");
     }
 
+    eval {
+	$logger_of{$ident} = OpenXPKI::Server::Context::CTX('log');
+    };
+
     ##! 2: "create output and stderr files in $arg_ref->{TMP}"
     my $fu = OpenXPKI::FileUtils->new();
     $stdin_file_of{$ident} = $fu->get_safe_tmpfile({
@@ -85,13 +92,6 @@ sub prepare {
     else {
         @{$command_of{$ident}} = ( $arg_ref->{COMMAND} );
     }
-    for (my $i=0; $i < scalar @{$command_of{$ident}}; $i++) {
-        $command_of{$ident}->[$i] = $shell_of{$ident} . " "
-                                    . $command_of{$ident}->[$i]
-                                    . " 1>>" . $stdout_file_of{$ident}
-                                    . " 2>>" . $stderr_file_of{$ident};
-        ##! 4: "prepared command: " . $command_of{$ident}->[$i]
-    }
     ##! 1: "end"
 }
 
@@ -124,7 +124,7 @@ sub execute {
     ##! 2: "execute commands"
     for (my $i=0; $i < scalar @{$command_of{$ident}}; $i++) {
         my $cmd = $command_of{$ident}->[$i];
-        ##! 4: "command: $cmd"
+        ##! 4: "command: " . Dumper $cmd
         if (defined $params and
             exists $params->[$i] and
             ref $params->[$i] eq 'HASH' and
@@ -132,65 +132,149 @@ sub execute {
              $params->[$i]->{TYPE} eq 'STDOUT')
            ) {
             if ($params->[$i]->{TYPE} eq 'STDIN') {
-                ## read data from STDIN
+                ##! 16: 'read data from STDIN'
                 
-                if (open my $FD, "|$cmd") {
-                    print $FD $params->[$i]->{DATA};
-                    close $FD;
-                }
-                else {
+                my @cmd = split /\s/, $cmd;
+                open my $STDOUT, '>', $stdout_file_of{$ident};
+                open my $STDERR, '>', $stderr_file_of{$ident};
+                ##! 16: 'split command: ' . Dumper \@cmd
+                my ($shell, @wrapper_cmd) = 
+                    __deal_with_wrapper($shell_of{$ident}, @cmd);
+                my $command = Proc::SafeExec->new({
+                    exec   => [ $shell, @wrapper_cmd ],
+                    stdin  => 'new',
+                    stdout => $STDOUT,
+                    stderr => $STDERR,
+                });
+                print {$command->stdin()} $params->[$i]->{DATA};
+                $command->wait();
+                close $STDOUT;
+                close $STDERR;
+
+                if ($command->exit_status()) {
+		    $self->get_result(); # discard output but purge temp file
+		    my $stderr = $self->get_stderr();
+		    
+		    $self->log('OpenSSL error: ' . $stderr, 
+			       {
+				   PRIORITY => 'error',
+			       });
+
                     OpenXPKI::Exception->throw(
                         message => 'I18N_OPENXPKI_CRYPTO_CLI_EXECUTE_PIPED_STDIN_FAILED',
-                        params  => { 'ERRVAL' => $EVAL_ERROR,
-                                   },
+                        params  => {
+                            'EXIT_STATUS' => $command->exit_status(),
+#			    'ERROR' => $stderr,
+                        },
                     );
                 }
             }
             else {
-                ## capture STDOUT
-                if (open my $FD, "$cmd|") {
-                    $params->[$i]->{STDOUT} = '';
-                    while (<$FD>) { # TODO: slurp, see #
-                        $params->[$i]->{STDOUT} .= $_;
-                    }
-                    $return .= $params->[$i]->{STDOUT};
-                    close $FD;
-                }
-                else {
+                ##! 16: 'capture STDOUT'
+                my @cmd = split /\s/, $cmd;
+                open my $STDOUT, '>', $stdout_file_of{$ident};
+                open my $STDERR, '>', $stderr_file_of{$ident};
+                my ($shell, @wrapper_cmd) = 
+                    __deal_with_wrapper($shell_of{$ident}, @cmd);
+                my $command = Proc::SafeExec->new({
+                    exec   => [ $shell, @wrapper_cmd ],
+                    stdin  => 'new',
+                    stdout => $STDOUT,
+                    stderr => $STDERR,
+                });
+                $command->wait();
+                my $command_stdout = $command->stdout();
+                my $stdout = do {
+                    local $/;
+                    <$command_stdout>;
+                };
+                close $STDOUT;
+                close $STDERR;
+                $params->[$i]->{STDOUT} = $stdout;
+                $return .= $stdout;
+                if ($command->exit_status()) {
+		    $self->get_result();
+		    my $stderr = $self->get_stderr();
+
+		    $self->log('OpenSSL error: ' . $stderr, 
+			       {
+				   PRIORITY => 'error',
+			       });
+
                     OpenXPKI::Exception->throw(
                         message => 'I18N_OPENXPKI_CRYPTO_CLI_EXECUTE_PIPED_STDOUT_FAILED',
                         params  => {
-                            'ERRVAL' => $EVAL_ERROR,
+                            'EXIT_STATUS' => $command->exit_status(),
+#			    'ERROR' => $stderr,
                         },
                     );
                 }
-	    }
+	        }
         } else {
-            ## simply execute the command
-            `$cmd`;
-        }
-        if ($EVAL_ERROR)
-        {
-            OpenXPKI::Exception->throw(
-                message => 'I18N_OPENXPKI_CRYPTO_CLI_EXECUTE_FAILED',
-                params  => { 'ERRVAL' => $EVAL_ERROR,
-                           },
-            );
+            my @cmd;
+            if (ref $cmd eq 'ARRAY') {
+                @cmd = @{ $cmd };
+            }
+            else {
+                @cmd = split q{ }, $cmd;
+            }
+            ##! 16: 'split cmd (was backticks): ' . Dumper \@cmd
+
+            open my $STDOUT, '>', $stdout_file_of{$ident};
+            open my $STDERR, '>', $stderr_file_of{$ident};
+            my ($shell, @wrapper_cmd) = 
+                __deal_with_wrapper($shell_of{$ident}, @cmd);
+            my $command = Proc::SafeExec->new({
+                exec   => [ $shell, @wrapper_cmd ],
+                stdin  => 'new',
+                stdout => $STDOUT,
+                stderr => $STDERR,
+            });
+            eval {
+                $command->wait();
+            };
+            if ($EVAL_ERROR && $EVAL_ERROR ne "Child was already waited on without calling the wait method\n") {
+                # the above may fail if the child has already exited,
+                # we ignore that
+		$self->get_result();
+		my $stderr = $self->get_stderr();
+
+		$self->log('OpenSSL error: ' . $stderr, 
+			   {
+			       PRIORITY => 'error',
+			   });
+
+                OpenXPKI::Exception->throw(
+                    message => 'I18N_OPENXPKI_CRYPTO_CLI_EXECUTE_WAIT_FAILED',
+                    params  => {
+                        EVAL_ERROR => $EVAL_ERROR,
+#			'ERROR' => $stderr,
+                    },
+                );
+            }
+            ##! 16: 'stdout_file: ' . $stdout_file_of{$ident}
+            ##! 16: 'stderr_file: ' . $stderr_file_of{$ident}
+            close($STDOUT);
+            close($STDERR);
+            if ($command->exit_status()) {
+		$self->get_result();
+		my $stderr = $self->get_stderr();
+
+		$self->log('OpenSSL error: ' . $stderr, 
+			   {
+			       PRIORITY => 'error',
+			   });
+
+                OpenXPKI::Exception->throw(
+                    message => 'I18N_OPENXPKI_CRYPTO_CLI_EXECUTE_FAILED',
+                    params  => {
+                        'EXIT_STATUS' => $command->exit_status(),
+#			'ERROR' => $stderr,
+                    },
+                );
+            }
         }
     }
-    ##! 64: 'CHILD_ERROR: ' . $CHILD_ERROR
-    if ($CHILD_ERROR != 0 && $CHILD_ERROR != -1) {
-        # child error -1 has to be ignored because it will most likely be
-        # caused by the waitpid in the SIG{'CHLD'} handler :-/
-        OpenXPKI::Exception->throw(
-            message => 'I18N_OPENXPKI_CRYPTO_CLI_EXECUTE_CHILD_ERROR',
-            params  => {
-                'EXIT_CODE' => ($? >> 8),
-                'SIGNAL'    => ($? & 127),
-            },
-        );
-    }
-
     ##! 2: "try to detect other errors"
     $self->__find_error();
 
@@ -231,6 +315,12 @@ sub __find_error : PRIVATE {
     if ($self->error_ispresent($ret)) {
         ##! 8: "error detected - firing exception"
         unlink ($stdout_file_of{$ident});
+
+	$self->log('OpenSSL error: ' . $ret, 
+		   {
+		       PRIORITY => 'error',
+		   });
+	
         OpenXPKI::Exception->throw(
             message => 'I18N_OPENXPKI_CRYPTO_CLI_ERROR',
             params  => { 'ERRVAL' => $ret,
@@ -242,6 +332,27 @@ sub __find_error : PRIVATE {
     return 0;
 }
 
+sub __deal_with_wrapper {
+    # deals with a possible wrapper being included in the shell parameter
+    # reduces the shell to the first argument, pushes the options of
+    # the wrapper to the @options array and returns the pair
+    ##! 1: 'start'
+    my $shell = shift;
+    my @cmd   = @_;
+
+    ##! 64: 'shell: ' . $shell
+    ##! 64: 'cmd: ' . Dumper \@cmd
+
+    my @wrapper = split q{ }, $shell;
+    my $new_shell = shift @wrapper;
+    push @wrapper, @cmd;
+
+    ##! 64: 'new_shell: ' . $new_shell
+    ##! 64: 'wrapper: ' . Dumper \@wrapper;
+    
+    return ($new_shell, @wrapper);
+}
+
 sub get_result {
     my $self = shift;
     my $ident = ident $self;
@@ -266,6 +377,27 @@ sub get_result {
     return $ret;
 }
 
+sub get_stderr {
+    my $self = shift;
+    my $ident = ident $self;
+    ##! 1: "start"
+
+    my $ret = 1;
+    if (-e $stderr_file_of{$ident}) {
+        ## there was an output
+        my $fu = OpenXPKI::FileUtils->new();
+        $ret = $fu->read_file($stderr_file_of{$ident});
+        $ret = $engine_of{$ident}->filter_stderr($ret);
+        if ($ret eq '') {
+            $ret = 1;
+        }
+    }
+    unlink ($stderr_file_of{$ident});
+
+    ##! 1: "end"
+    return $ret;
+}
+
 sub cleanup {
     ##! 1: "start"
     my $self = shift;
@@ -283,6 +415,29 @@ sub cleanup {
     ##! 1: "end"
 }
 
+sub log {
+    my $self = shift;
+    my $ident = ident $self;
+    
+    my $message = shift;
+    my $args = shift;
+    
+    my %logger_args = (
+	FACILITY => 'system',
+	PRIORITY => 'info',
+	%{$args},
+	);
+    
+    if (! defined $logger_of{$ident}) {
+	return;
+    }
+    
+    return $logger_of{$ident}->log(
+	%logger_args,
+	MESSAGE => $message,
+	);
+}
+
 sub DEMOLISH {
     ##! 1: "start"
     my $self = shift;
