File Coverage

blib/lib/HPCI/Env.pm
Criterion Covered Total %
statement 46 53 86.7
branch 14 22 63.6
condition 8 12 66.6
subroutine 7 8 87.5
pod 0 1 0.0
total 75 96 78.1


line stmt bran cond sub pod time code
1             package HPCI::Env;
2              
3 1     1   934 use autodie;
  1         10945  
  1         5  
4 1     1   6128 use Carp;
  1         2  
  1         61  
5              
6 1     1   485 use Moose::Role;
  1         4515  
  1         5  
7 1     1   5504 use MooseX::Params::Validate ':all';
  1         70866  
  1         6  
8              
9             =head1 NAME
10              
11             HPCI::Env - Role for controlled copying of the %ENV hash for child processes to use
12              
13             =head1 DESCRIPTION
14              
15             Makes a copy of %ENV (possibly from a previous copy).
16              
17             Provides choice of whitelist (retaining only specified values),
18             blacklist (removing specified values), and augmenting with a list
19             of key value pairs that are determined by the user program.
20              
21             Typically, only a whitelist or a blacklist would be used - not both
22             at once (although some special circumstances might use both where
23             patterns rather than explicit lists are used for one category).
24             Augmenting can be useful in conjunction with either whitelist
25             or blacklist.
26              
27             This module provides both mechanisms, so that the caller can decide
28             on policy. Choosing to whitelist has the danger of possibly
29             removing something that is needed. Choosing to blacklist has
30             the danger of possibly failing to remove something that permits
31             a security failure). Your business context will determine which
32             choice is right.
33              
34             The method B<print_env_settings> takes a filehandle and writes a series
35             of bash export command lines for all specified env items (if any was
36             specified).
37              
38             The B<has_any_env> attribute can be used to limit accessing the
39             computed env to only be dome if there was at least one env control
40             parameter provided:
41              
42             # only use the env is there was something explicitly put there
43             if ($object->has_any_env) {
44             use_env( $object->env );
45             }
46              
47             # always use the env (default to %ENV if nothing explicit)
48             use_env( $object->env );
49              
50             HPCI uses multiple HPCI::Env objects that are cascaded. The Group's
51             env object (if any) is copied and modified for each Stage's own
52             env object.
53              
54             =head1 ATTRIBUTES
55              
56             =over 4
57              
58             =item * env_source
59              
60             A hash to be used as the basis of the copy.
61              
62             If env_source is not provided but any other env_* parameters
63             are provided, then B<$self->default_env_source> is called to get
64             the soruce. If this method is not over-ridden, it uses B<%ENV>
65             as the basis.
66              
67             As well as for cascading envs (as is done for Stage from Group)
68             providing a value to B<env_source> allows giving the entire desired
69             env hash at once, rather than as a set of modifications from B<%ENV>.
70              
71             =cut
72              
73             has 'env_source' => (
74             is => 'ro',
75             isa => 'HashRef[Str]',
76             lazy => 1,
77             predicate => '_has_env_source',
78             builder => '_default_env_source',
79             );
80              
81             sub _default_env_source {
82 7     7   13 my $self = shift;
83 7 50       173 return $self->_has_env_cascade ? $self->env_cascade->env_source : \%ENV;
84             }
85              
86             =item * env_cascade Maybe[Object]
87              
88             If this attribute is provided, then it will be used as an object
89             that does the Env role that provides the default env_source value.
90             The HPCI::Stage object specifies its Group object for this parameter
91             so that if any Group env parameters were set, they will get used
92             as a basis for the Stage.
93              
94             =cut
95              
96             has 'env_cascade' => (
97             is => 'ro',
98             isa => 'Maybe[Object]',
99             lazy => 1,
100             predicate => '_has_env_cascade',
101             default => undef,
102             );
103              
104             =item * env_retain ArrayRef[Str]
105              
106             =item * env_retain_pat RegexpRef
107              
108             If either of these is provided, then only keys that are explicitly
109             listed in env_retain, or which match the pattern in env_retain_pat will be
110             kept. All other keys will be filtered out.
111              
112             This is done before processing env_remove, env_remove_pat, or env_set
113             parameters, so additional keys might be filtered out, and some filtered
114             keys might still be reinserted in the final resulting environment hash
115             (but only with a new value that does not depend upon the previous one).
116              
117             =cut
118              
119             has 'env_retain' => (
120             is => 'ro',
121             isa => 'ArrayRef[Str]',
122             predicate => '_has_env_retain',
123             );
124              
125             has 'env_retain_pat' => (
126             is => 'ro',
127             isa => 'RegexpRef',
128             predicate => '_has_env_retain_pat',
129             );
130              
131             =item * env_remove ArrayRef[Str]
132              
133             =item * env_remove_pat RegExp
134              
135             If either of these is provided, then any keys that are explicitly
136             listed in env_remove, or which match the pattern in env_remove_pat will be
137             deleted.
138              
139             This is done before processing the env_set parameter, so some filtered keys
140             could still be reinserted in the final resulting environment hash (but only
141             with a new value that does not depend upon the previous one).
142              
143             =cut
144              
145             has 'env_remove' => (
146             is => 'ro',
147             isa => 'ArrayRef[Str]',
148             predicate => '_has_env_remove',
149             );
150              
151             has 'env_remove_pat' => (
152             is => 'ro',
153             isa => 'RegexpRef',
154             predicate => '_has_env_remove_pat',
155             );
156              
157             =item * env_set HashRef[Str|CodeRef]
158              
159             If provided, the env hash that results from applying the env_retain and
160             env_remove filtering is augmented by adding additional values for each
161             key in this hash.
162              
163             If the value is not a CodeRef, it is used (completely replacing the
164             previous value for that key, if any).
165              
166             If the value in this hash is a CodeRef, then that function is called to
167             compute the value to be stored. The function will be passed one or two
168             arguments - the first is always the key name, and the second is the value
169             for that key in the filtered source hash if it exists (or no second
170             argument is provided if it does not exists).
171              
172             The function can then either modify the original value (if any was
173             originally present and has not been filtered out by the previous steps)
174             or replace it completely (regardless of whether it was present). A
175             typical example of modifying would be to prepend a directory to PATH.
176              
177             ... env_set => { DIRS =>
178             sub {
179             shift; # throw away 'DIRS' argument
180             # prepend DIRS, if present, create it if not present
181             return join( ':', "home/joe/lib", @_ );
182             }
183              
184             =cut
185              
186             has 'env_set' => (
187             is => 'ro',
188             isa => 'HashRef[Str|CodeRef]',
189             predicate => '_has_env_set',
190             );
191              
192             =item * has_any_env Bool (not settable)
193              
194             This attribute is true if any attributes were initialized that
195             determine (potential) filtering of %ENV. (It is potential because
196             if the values provided could end up "filtering" to a result that is
197             identical to the original %ENV.) (The "filtering" attributes are
198             env_source, env_retain, env_retain_pat, env_deletem env_delete_pat,
199             and env_set._
200              
201             It is also true if there was an env_cascade object provided and it
202             had any filtering attributes initialized.
203              
204             =cut
205              
206             has 'has_any_env' => (
207             is => 'ro',
208             isa => 'Bool',
209             init_arg => undef,
210             lazy => 1,
211             builder => '_build_has_any_env',
212             );
213              
214             sub _build_has_any_env {
215 9     9   15 my $self = shift;
216 9   66     215 return $self->_has_env_source
217             || $self->_has_env_retain
218             || $self->_has_env_retain_pat
219             || $self->_has_env_remove
220             || $self->_has_env_remove_pat
221             || $self->_has_env_set
222             || ($self->_has_env_cascade && $self->env_cascade->has_any_env);
223             }
224              
225             =item * env HashRef[Str]
226              
227             This is the hash resulting from the specified filtering and augmentation.
228              
229             =back
230              
231             =cut
232              
233             has 'env' => (
234             is => 'ro',
235             isa => 'HashRef[Str]',
236             lazy => 1,
237             builder => '_build_env',
238             );
239              
240             sub _build_env {
241 8     8   16 my $self = shift;
242              
243             # make sure that has_any_env has been initialized before we possibly
244             # cause forced use of default values, which would lead us to forget
245             # that they were all uninitialized
246 8         182 $self->has_any_env;
247              
248 8         46 my $fail_pat = qr(^(?<=.)); # pattern that always fails
249 8         174 my $source = $self->env_source;
250 8         52 my @keepers = keys %$source;
251 8 100 66     214 if ($self->_has_env_retain || $self->_has_env_retain_pat) {
252 5         9 my %ret_keys;
253 5 50       122 %ret_keys = map { $_ => 1 } @{ $self->env_retain } if $self->_has_env_retain;
  7         25  
  5         143  
254 5         12 my $ret_pat = $fail_pat;
255 5 50       138 $ret_pat = $self->env_retain_pat if $self->_has_env_retain_pat;
256 5 50       11 @keepers = grep { $_ =~ $ret_pat || $ret_keys{$_} } @keepers;
  102         455  
257             }
258 8 100 66     202 if ($self->_has_env_remove || $self->_has_env_remove_pat) {
259             # a missing parameter should not remove anything
260 2         3 my %rem_keys;
261 2 50       43 %rem_keys = map { $_ => 1 } @{ $self->env_remove } if $self->_has_env_remove;
  2         8  
  2         38  
262 2         5 my $rem_pat = $fail_pat;
263 2 50       45 $rem_pat = $self->env_remove_pat if $self->_has_env_remove_pat;
264             @keepers =
265 2   66     5 grep { not( $_ =~ $rem_pat || exists $rem_keys{$_} ) } @keepers;
  50         201  
266             }
267 8         19 $source = { map { $_ => $source->{$_} } @keepers }; # a new hash with only the chosen keys
  78         164  
268 8 100       228 if ($self->_has_env_set) {
269 4         6 while (my ( $key, $value ) = each %{ $self->env_set }) {
  8         144  
270             $source->{$key} =
271             ref($value) eq 'CODE'
272 4 100       18 ? $value->( $key, $source->{$key} )
273             : $value;
274             }
275             }
276 8         221 return $source;
277             }
278              
279             =head1 ATTRIBUTES
280              
281             =over 4
282              
283             =item * print_env_setting
284              
285             Prints a series of (Bourne-compatible) shel export command lines
286             tp the provided file handle that will set the computed environment
287             values.
288              
289             Prints nothing if no values have been set.
290              
291             (If you really want to have the entire B<%ENV> hash expanded, you
292             have a number of ways to do it:
293              
294             ... env_source => \%ENV, ... # pull in %ENV explicitly
295              
296             ... env_retain_pat => qr/^/, ... # retain everything
297              
298             ... env_delete_pat => qr/\0/, ... # delete nothing (NULL can't be in an env name
299              
300             ... env_set => { }. ... # add nothing
301              
302             All of those would work, you can probably thing of others if your
303             mind if sufficiently warped in the appropriate direction.)
304              
305             =back
306              
307             =cut
308              
309             sub print_env_settings {
310 0     0 0   my $self = shift;
311 0           my $fh = shift;
312 0 0         if ($self->has_any_env) {
313 0           while (my ( $k, $v ) = each %{ $self->env }) {
  0            
314 0           $v =~ s{([\"\$\`\\])} {\\$1}g;
315 0           print $fh qq{export $k="$v"\n};
316             }
317             }
318             }
319              
320             =item * has_any_env
321              
322             Returns true if any attribute was explicitly set.
323              
324             This allows the user to follow the convention (also used internally)
325             that if no attributes were set, then no env is to be provided.
326              
327             This method can be wrapped with an B<around>. That is done by a
328             Stage object to have this attribute return true if either the Stage
329             or the parent Group had an attribute set.
330              
331             =item * default_env_source
332              
333             Selects the default has to be used. The provided method selects
334             B<%ENV> but since this is a role, this method can be wrapped with
335             an B<around> that modifies that choice. This method gets called
336             internally, and only if the env attribute is actually being set up.
337             The env used in a Stage is wrapped to use the Group's env (if it
338             was set up) as the default source.
339              
340             =cut
341              
342             1;