File Coverage

blib/lib/Connector/Proxy/Proc/SafeExec.pm
Criterion Covered Total %
statement 104 109 95.4
branch 21 30 70.0
condition n/a
subroutine 16 17 94.1
pod 3 3 100.0
total 144 159 90.5


line stmt bran cond sub pod time code
1             # Connector::Proxy::Proc::SafeExec
2             #
3             # Connector class for running system commands
4             #
5             # Written by Martin Bartosch for the OpenXPKI project 2012
6             #
7              
8             use strict;
9 1     1   2975 use warnings;
  1         2  
  1         26  
10 1     1   4 use English;
  1         2  
  1         20  
11 1     1   3 use Proc::SafeExec;
  1         2  
  1         6  
12 1     1   347 use File::Temp;
  1         3  
  1         24  
13 1     1   5 use Try::Tiny;
  1         1  
  1         75  
14 1     1   5 use Template;
  1         2  
  1         58  
15 1     1   407  
  1         16324  
  1         27  
16             use Data::Dumper;
17 1     1   490  
  1         5216  
  1         51  
18             use Moose;
19 1     1   430 extends 'Connector::Proxy';
  1         382726  
  1         6  
20              
21             has args => (
22             is => 'rw',
23             isa => 'ArrayRef[Str]',
24             default => sub { [] },
25             );
26              
27             has timeout => (
28             is => 'rw',
29             isa => 'Int',
30             default => 5,
31             );
32              
33             has chomp_output => (
34             is => 'rw',
35             isa => 'Bool',
36             default => 1,
37             );
38              
39             has stdin => (
40             is => 'rw',
41             isa => 'Str|ArrayRef[Str]|Undef',
42             );
43              
44             has env => (
45             is => 'rw',
46             isa => 'HashRef[Str]',
47             );
48              
49             my $self = shift;
50              
51 0     0   0 if (! -x $self->LOCATION()) {
52             die("Specified system command is not executable: " . $self->LOCATION());
53 0 0       0 }
54 0         0  
55             return 1;
56             }
57 0         0  
58             # this method always returns the file contents, regardless of the specified
59             # key
60             my $self = shift;
61              
62             my @args = $self->_build_path( shift );
63 17     17 1 4128 my $template = Template->new(
64             {
65 17         205 });
66 17         358  
67             # compose a list of command arguments
68             my $template_vars = {
69             ARGS => \@args,
70             };
71 17         31425  
72             # process configured system command arguments and replace templates
73             # in it with the passed arguments, accessible via [% ARGS.0 %]
74             my @cmd_args;
75             foreach my $item (@{$self->args()}) {
76             my $value;
77 17         38 $template->process(\$item, $template_vars, \$value) || die "Error processing argument template.";
78 17         21 push @cmd_args, $value;
  17         644  
79 28         43 }
80 28 50       185  
81 28         58678 my %filehandles;
82              
83             my @feed_to_stdin;
84 17         33 if (defined $self->stdin()) {
85             my @raw_stdin_data;
86             if (ref $self->stdin() eq '') {
87 17 100       621 push @raw_stdin_data, $self->stdin();
88 6         33 } elsif (ref $self->stdin() eq 'ARRAY') {
89 6 100       173 push @raw_stdin_data, @{$self->stdin()};
    50          
90 3         74 }
91             foreach my $line (@raw_stdin_data) {
92 3         7 my $value;
  3         78  
93             $template->process(\$line, $template_vars, \$value) || die "Error processing stdin template.";
94 6         24 push @feed_to_stdin, $value;
95 9         12 }
96 9 50       32  
97 9         11542 # we have data to pipe to stdin, create a filehandle
98             $filehandles{stdin} = 'new';
99             }
100              
101 6         19 if (defined $self->env()) {
102             if (ref $self->env() eq 'HASH') {
103             foreach my $key (keys %{$self->env()}) {
104 17 100       472 my $value;
105 8 50       199 $template->process(\$self->env()->{$key}, $template_vars, \$value) || die "Error processing environment template.";
106 8         13 $ENV{$key} = $value;
  8         195  
107 8         21 }
108 8 50       213 }
109 8         10164 }
110              
111             my $stdout = File::Temp->new();
112             $filehandles{stdout} = \*$stdout;
113              
114 17         209 my $stderr = File::Temp->new();
115 17         8773 $filehandles{stderr} = \*$stderr;
116              
117 17         47  
118 17         5047 # compose the system command to execute
119             my @cmd;
120             push @cmd, $self->{LOCATION};
121             push @cmd, @cmd_args;
122 17         28  
123 17         64 my $command = Proc::SafeExec->new(
124 17         36 {
125             exec => \@cmd,
126 17         152 %filehandles,
127             });
128             try {
129             local $SIG{ALRM} = sub { die "alarm\n" };
130             if (scalar @feed_to_stdin) {
131             my $stdin = $command->stdin();
132 17     17   3754 print $stdin join("\n", @feed_to_stdin);
  1         2000283  
133 17 100       96 }
134 6         149 alarm $self->timeout();
135 6         61 $command->wait();
136             } catch {
137 17         1616 if ($_ eq "alarm\n") {
138 17         177 die "System command timed out after " . $self->timeout() . " seconds";
139             }
140 1 50   1   58 die $_;
141 1         115 } finally {
142             alarm 0;
143 0         0 };
144              
145 17     17   1046344 my $stderr_content = do {
146 17         63272 open my $fh, '<', $stderr->filename;
147             local $INPUT_RECORD_SEPARATOR;
148 16         291 <$fh>;
149 16         334 };
150 16         1091  
151 16         781 if ($command->exit_status() != 0) {
152             die "System command exited with return code " . ($command->exit_status() >> 8) . ". STDERR: $stderr_content";
153             }
154 16 100       128  
155 1         46 my $stdout_content = do {
156             open my $fh, '<', $stdout->filename;
157             local $INPUT_RECORD_SEPARATOR;
158 15         233 <$fh>;
159 15         90 };
160 15         564  
161 15         505 if ($self->chomp_output()) {
162             chomp $stdout_content;
163             }
164 15 50       762  
165 15         48 return $stdout_content;
166             }
167              
168 15         118 my $self = shift;
169              
170             # If we have no path, we tell the caller that we are a connector
171             my @path = $self->_build_path( shift );
172 2     2 1 1829 if (scalar @path == 0) {
173             return { TYPE => "connector" };
174             }
175 2         22  
176 2 100       14 return {TYPE => "scalar" };
177 1         18 }
178              
179              
180 1         17 my $self = shift;
181              
182             # No path = connector root which always exists
183             my @path = $self->_build_path( shift );
184             if (scalar @path == 0) {
185 3     3 1 13 return 1;
186             }
187             my $val;
188 3         23 eval {
189 3 100       17 $val = $self->get( \@path );
190 1         7 };
191             return defined $val;
192 2         7  
193 2         6 }
194 2         14  
195             no Moose;
196 2         1358 __PACKAGE__->meta->make_immutable;
197              
198             1;
199              
200 1     1   7154 =head1 Name
  1         2  
  1         5  
201              
202             Connector::Builtin::System::Exec
203              
204             =head1 Description
205