line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Shell::Cmd; |
2
|
|
|
|
|
|
|
# Copyright (c) 2013-2021 Sullivan Beck. All rights reserved. |
3
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify it |
4
|
|
|
|
|
|
|
# under the same terms as Perl itself. |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
# Variables used in scripts |
7
|
|
|
|
|
|
|
# SC_ORIG_DIRE : the directory you were in when the script ran |
8
|
|
|
|
|
|
|
# SC_DIRE : the working directory of the script |
9
|
|
|
|
|
|
|
# SC_DIRE_n : the working directory going into command n |
10
|
|
|
|
|
|
|
# SC_FAILED = N : the command which failed |
11
|
|
|
|
|
|
|
# SC_CURR_EXIT : the exit code for the current command |
12
|
|
|
|
|
|
|
# SC_CURR_SUCC : 1 if the current command (any alternate) succeeded |
13
|
|
|
|
|
|
|
# SC_RETRIES = N : this command will run up to N times |
14
|
|
|
|
|
|
|
# SC_TRY = N : we're currently on the Nth try |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
############################################################################### |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
require 5.008; |
19
|
93
|
|
|
93
|
|
268812
|
use warnings 'all'; |
|
93
|
|
|
|
|
213
|
|
|
93
|
|
|
|
|
4190
|
|
20
|
93
|
|
|
93
|
|
486
|
use strict; |
|
93
|
|
|
|
|
170
|
|
|
93
|
|
|
|
|
2488
|
|
21
|
93
|
|
|
93
|
|
50957
|
use Capture::Tiny qw(capture capture_stdout capture_stderr); |
|
93
|
|
|
|
|
1651511
|
|
|
93
|
|
|
|
|
6955
|
|
22
|
93
|
|
|
93
|
|
99213
|
use Net::OpenSSH; |
|
93
|
|
|
|
|
3450327
|
|
|
93
|
|
|
|
|
5316
|
|
23
|
93
|
|
|
93
|
|
64680
|
use Parallel::ForkManager 0.7.6; |
|
93
|
|
|
|
|
5196284
|
|
|
93
|
|
|
|
|
4433
|
|
24
|
93
|
|
|
93
|
|
873
|
use IO::File; |
|
93
|
|
|
|
|
208
|
|
|
93
|
|
|
|
|
17256
|
|
25
|
93
|
|
|
93
|
|
730
|
use Cwd; |
|
93
|
|
|
|
|
196
|
|
|
93
|
|
|
|
|
835123
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our($VERSION); |
28
|
|
|
|
|
|
|
$VERSION = "3.04"; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
$| = 1; |
31
|
|
|
|
|
|
|
$Data::Dumper::Sortkeys = 1; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
############################################################################### |
34
|
|
|
|
|
|
|
# METHODS TO CREATE OBJECT |
35
|
|
|
|
|
|
|
############################################################################### |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub version { |
38
|
|
|
|
|
|
|
# uncoverable subroutine |
39
|
|
|
|
|
|
|
# uncoverable statement |
40
|
0
|
|
|
0
|
1
|
0
|
my($self) = @_; |
41
|
|
|
|
|
|
|
# uncoverable statement |
42
|
0
|
|
|
|
|
0
|
return $VERSION; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub new { |
46
|
79
|
|
|
79
|
1
|
828872
|
my($class,%options) = @_; |
47
|
|
|
|
|
|
|
|
48
|
79
|
|
|
|
|
1173
|
my $self = {}; |
49
|
|
|
|
|
|
|
|
50
|
79
|
|
|
|
|
1222
|
bless $self,$class; |
51
|
79
|
|
|
|
|
1668
|
$self->flush(); |
52
|
|
|
|
|
|
|
|
53
|
79
|
|
|
|
|
345
|
return $self; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub flush { |
57
|
89
|
|
|
89
|
1
|
2321
|
my($self, @opts) = @_; |
58
|
|
|
|
|
|
|
|
59
|
89
|
100
|
|
|
|
1811
|
my $all = 1 if (! @opts); |
60
|
89
|
|
|
|
|
725
|
my %opts = map { $_,1 } @opts; |
|
4
|
|
|
|
|
16
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# $self = { |
63
|
|
|
|
|
|
|
# 'g' => { VAR => VAL } global options |
64
|
|
|
|
|
|
|
# 'c' => { VAR => VAL } per-command options |
65
|
|
|
|
|
|
|
# 'e' => [ VAR, VAL ] environment |
66
|
|
|
|
|
|
|
# 'o' => { out => STDOUT, output from script mode |
67
|
|
|
|
|
|
|
# err => STDERR, |
68
|
|
|
|
|
|
|
# exit => EXIT } |
69
|
|
|
|
|
|
|
# 's' => { HOST => { out => STDOUT, output from ssh script mode |
70
|
|
|
|
|
|
|
# err => STDERR, |
71
|
|
|
|
|
|
|
# exit => EXIT } } |
72
|
|
|
|
|
|
|
# 'curr' => NUM, the current command in |
73
|
|
|
|
|
|
|
# the output method |
74
|
|
|
|
|
|
|
# 'err' => ERROR, |
75
|
|
|
|
|
|
|
# 'cmd' => { CMD_NUM => CMD_DESC } command descriptions |
76
|
|
|
|
|
|
|
# 'cmd_num' => NUM |
77
|
|
|
|
|
|
|
# 'max_alt' => NUM the greatest number of |
78
|
|
|
|
|
|
|
# alternates |
79
|
|
|
|
|
|
|
# 'scr' => [] the current script |
80
|
|
|
|
|
|
|
|
81
|
89
|
|
|
|
|
2159
|
$$self{'err'} = ''; |
82
|
89
|
|
|
|
|
1247
|
$$self{'scr'} = []; |
83
|
|
|
|
|
|
|
|
84
|
89
|
100
|
100
|
|
|
6232
|
if ($all || $opts{'opts'}) { |
85
|
86
|
|
|
|
|
11022
|
$$self{'g'} = |
86
|
|
|
|
|
|
|
{ |
87
|
|
|
|
|
|
|
# |
88
|
|
|
|
|
|
|
# Options set with the options method. |
89
|
|
|
|
|
|
|
# |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
'mode' => 'run', |
92
|
|
|
|
|
|
|
'dire' => '', |
93
|
|
|
|
|
|
|
'output' => 'both', |
94
|
|
|
|
|
|
|
'script' => '', |
95
|
|
|
|
|
|
|
'echo' => 'noecho', |
96
|
|
|
|
|
|
|
'failure' => 'exit', |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
'tmp_script' => "/tmp/.cmd.shell.$$", |
99
|
|
|
|
|
|
|
'tmp_script_keep' => 0, |
100
|
|
|
|
|
|
|
'ssh_script' => '', |
101
|
|
|
|
|
|
|
'ssh_script_keep' => 0, |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
'ssh_opts' => {}, |
104
|
|
|
|
|
|
|
'ssh_num' => 1, |
105
|
|
|
|
|
|
|
'ssh_sleep' => 0, |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# |
108
|
|
|
|
|
|
|
# A description of the script (calulated |
109
|
|
|
|
|
|
|
# from some of the obove options in _script_options). |
110
|
|
|
|
|
|
|
# |
111
|
|
|
|
|
|
|
# s_type : Type of script currently being |
112
|
|
|
|
|
|
|
# created. |
113
|
|
|
|
|
|
|
# run, simple, script |
114
|
|
|
|
|
|
|
# simple : Type of simple script currently being |
115
|
|
|
|
|
|
|
# created. |
116
|
|
|
|
|
|
|
# script : s_type = script |
117
|
|
|
|
|
|
|
# failure : s_type = run, failure = display |
118
|
|
|
|
|
|
|
# c_echo : mode=run: echo,noecho,failed |
119
|
|
|
|
|
|
|
# otherwise: '' |
120
|
|
|
|
|
|
|
# c_fail : How to treat command failure |
121
|
|
|
|
|
|
|
# in the calculated environment. |
122
|
|
|
|
|
|
|
# simple: '' |
123
|
|
|
|
|
|
|
# otherwise: exit,display,continue |
124
|
|
|
|
|
|
|
# out : 1 if STDOUT captured |
125
|
|
|
|
|
|
|
# err : 1 if STDERR captured |
126
|
|
|
|
|
|
|
# redir : String to redirect output |
127
|
|
|
|
|
|
|
# |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
's_type' => '', |
130
|
|
|
|
|
|
|
'simple' => '', |
131
|
|
|
|
|
|
|
'out' => 0, |
132
|
|
|
|
|
|
|
'err' => 0, |
133
|
|
|
|
|
|
|
'redir' => '', |
134
|
|
|
|
|
|
|
'c_echo' => '', |
135
|
|
|
|
|
|
|
'c_fail' => '', |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# |
138
|
|
|
|
|
|
|
# Script indentation (used to keep track of |
139
|
|
|
|
|
|
|
# all indentation) |
140
|
|
|
|
|
|
|
# |
141
|
|
|
|
|
|
|
'ind_per_lev' => 3, |
142
|
|
|
|
|
|
|
'ind_cur_lev' => 0, |
143
|
|
|
|
|
|
|
'curr_ind' => "", |
144
|
|
|
|
|
|
|
'next_ind' => "", |
145
|
|
|
|
|
|
|
'prev_ind' => "", |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# |
148
|
|
|
|
|
|
|
# Keep track of current flow structure |
149
|
|
|
|
|
|
|
# as commands are added (not used once |
150
|
|
|
|
|
|
|
# they are done). |
151
|
|
|
|
|
|
|
# |
152
|
|
|
|
|
|
|
# ( [ FLOW, CMD_NUM ], |
153
|
|
|
|
|
|
|
# [ FLOW, CMD_NUM ], ... ) |
154
|
|
|
|
|
|
|
# where: |
155
|
|
|
|
|
|
|
# FLOW : type of flow |
156
|
|
|
|
|
|
|
# CMD_NUM : command where it opened |
157
|
|
|
|
|
|
|
# |
158
|
|
|
|
|
|
|
'flow' => [], |
159
|
|
|
|
|
|
|
}; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
89
|
100
|
100
|
|
|
1313
|
if ($all || $opts{'commands'}) { |
163
|
|
|
|
|
|
|
# cmd => { CMD_NUM => { 'meta' => VAL, (0 or a string) |
164
|
|
|
|
|
|
|
# 'label' => LABEL, |
165
|
|
|
|
|
|
|
# 'cmd' => [ CMD ], |
166
|
|
|
|
|
|
|
# 'dire' => DIRE, |
167
|
|
|
|
|
|
|
# 'noredir' => 0/1, |
168
|
|
|
|
|
|
|
# 'retry' => NUM, |
169
|
|
|
|
|
|
|
# 'sleep' => NUM, |
170
|
|
|
|
|
|
|
# 'check' => CMD, |
171
|
|
|
|
|
|
|
# 'flow' => if/loop/... |
172
|
|
|
|
|
|
|
# 'flow_type' => open/cont/close |
173
|
|
|
|
|
|
|
# } |
174
|
86
|
|
|
|
|
431
|
$$self{'cmd'} = {}; |
175
|
86
|
|
|
|
|
351
|
$$self{'cmd_num'} = 1; |
176
|
86
|
|
|
|
|
333
|
$$self{'max_alt'} = 0; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# Command options |
180
|
|
|
|
|
|
|
# c_flow 1 if this is a flow command |
181
|
|
|
|
|
|
|
# c_num The number of the current command |
182
|
|
|
|
|
|
|
# f_num The failure code (c_num if <=200, 201 otherwise) |
183
|
|
|
|
|
|
|
# alts 1 if alternates are available |
184
|
|
|
|
|
|
|
# a_num The number of the alternate |
185
|
|
|
|
|
|
|
# c_label The label for the command |
186
|
|
|
|
|
|
|
# |
187
|
|
|
|
|
|
|
# c_retries The number of retries |
188
|
|
|
|
|
|
|
# c_sleep How long to sleep between retries |
189
|
|
|
|
|
|
|
# c_redir Redirect string for this command (takes into account |
190
|
|
|
|
|
|
|
# noredir) |
191
|
|
|
|
|
|
|
# c_check The command to check success |
192
|
|
|
|
|
|
|
# c_check_q The quoted check command |
193
|
|
|
|
|
|
|
# simp If the current command is in a simple script |
194
|
|
|
|
|
|
|
# |
195
|
|
|
|
|
|
|
# cmd_str The current command string |
196
|
|
|
|
|
|
|
# e.g. '/bin/ls /tmp' |
197
|
|
|
|
|
|
|
# cmd_str_q The quoted command string |
198
|
|
|
|
|
|
|
# cmd_label A label describing the command (command number and |
199
|
|
|
|
|
|
|
# command label if available): |
200
|
|
|
|
|
|
|
# '1' |
201
|
|
|
|
|
|
|
# '1 [LABEL]' |
202
|
|
|
|
|
|
|
# alt_label A label describing the alternate |
203
|
|
|
|
|
|
|
# '1.1' |
204
|
|
|
|
|
|
|
# '1.1 [LABEL]' |
205
|
|
|
|
|
|
|
# '1.0' (if no alternates) |
206
|
|
|
|
|
|
|
|
207
|
89
|
|
|
|
|
319
|
$$self{'c'} = {}; |
208
|
|
|
|
|
|
|
|
209
|
89
|
100
|
100
|
|
|
1151
|
$$self{'e'} = [] if ($all || $opts{'env'}); |
210
|
|
|
|
|
|
|
|
211
|
89
|
100
|
100
|
|
|
724
|
if ($all || $opts{'out'}) { |
212
|
86
|
|
|
|
|
346
|
$$self{'o'} = {}; |
213
|
86
|
|
|
|
|
658
|
$$self{'s'} = {}; |
214
|
86
|
|
|
|
|
375
|
$$self{'curr'} = 0; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
89
|
|
|
|
|
391
|
return; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
############################################################################### |
221
|
|
|
|
|
|
|
# METHODS TO SET OPTIONS |
222
|
|
|
|
|
|
|
############################################################################### |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub dire { |
225
|
6
|
|
|
6
|
1
|
38923
|
my($self,$dire) = @_; |
226
|
6
|
100
|
|
|
|
24
|
return $$self{'g'}{'dire'} if (! defined($dire)); |
227
|
|
|
|
|
|
|
|
228
|
2
|
|
|
|
|
8
|
return $self->options("dire",$dire); |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub mode { |
232
|
75
|
|
|
75
|
1
|
1119
|
my($self,$mode) = @_; |
233
|
75
|
100
|
|
|
|
593
|
return $$self{'g'}{'mode'} if (! defined($mode)); |
234
|
|
|
|
|
|
|
|
235
|
2
|
|
|
|
|
7
|
return $self->options("mode",$mode); |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub env { |
239
|
21
|
|
|
21
|
1
|
1366
|
my($self,@tmp) = @_; |
240
|
21
|
100
|
|
|
|
91
|
return @{ $$self{'e'} } if (! @tmp); |
|
4
|
|
|
|
|
13
|
|
241
|
|
|
|
|
|
|
|
242
|
17
|
|
|
|
|
70
|
while (@tmp) { |
243
|
36
|
|
|
|
|
67
|
my $var = shift(@tmp); |
244
|
36
|
|
|
|
|
121
|
my $val = $self->_quote(shift(@tmp)); |
245
|
36
|
|
|
|
|
63
|
push @{ $$self{'e'} },($var,$val); |
|
36
|
|
|
|
|
153
|
|
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
17
|
|
|
|
|
53
|
return; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub options { |
252
|
233
|
|
|
233
|
1
|
11560
|
my($self,%opts) = @_; |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
OPT: |
255
|
233
|
|
|
|
|
1376
|
foreach my $opt (keys %opts) { |
256
|
|
|
|
|
|
|
|
257
|
312
|
|
|
|
|
1111
|
my $val = $opts{$opt}; |
258
|
312
|
|
|
|
|
1086
|
$opt = lc($opt); |
259
|
|
|
|
|
|
|
|
260
|
312
|
100
|
100
|
|
|
5312
|
if ($opt eq 'mode') { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
261
|
|
|
|
|
|
|
|
262
|
75
|
100
|
|
|
|
1616
|
if (lc($val) =~ /^(run|dry-run|script)$/) { |
263
|
74
|
|
|
|
|
479
|
$$self{'g'}{$opt} = lc($val); |
264
|
74
|
|
|
|
|
388
|
next OPT; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
} elsif ($opt eq 'dire') { |
268
|
18
|
|
|
|
|
214
|
$$self{'g'}{$opt} = $self->_quote($val); |
269
|
18
|
|
|
|
|
62
|
next OPT; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
} elsif ($opt eq 'output') { |
272
|
|
|
|
|
|
|
|
273
|
11
|
100
|
|
|
|
143
|
if (lc($val) =~ /^(both|merged|stdout|stderr|quiet)$/) { |
274
|
10
|
|
|
|
|
51
|
$$self{'g'}{$opt} = lc($val); |
275
|
10
|
|
|
|
|
63
|
next OPT; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
} elsif ($opt eq 'script') { |
279
|
|
|
|
|
|
|
|
280
|
27
|
100
|
|
|
|
406
|
if (lc($val) =~ /^(run|script|simple)$/) { |
281
|
26
|
|
|
|
|
175
|
$$self{'g'}{$opt} = lc($val); |
282
|
26
|
|
|
|
|
111
|
next OPT; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
} elsif ($opt eq 'echo') { |
286
|
|
|
|
|
|
|
|
287
|
4
|
100
|
|
|
|
34
|
if (lc($val) =~ /^(echo|noecho|failed)$/) { |
288
|
3
|
|
|
|
|
15
|
$$self{'g'}{$opt} = lc($val); |
289
|
3
|
|
|
|
|
8
|
next OPT; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
} elsif ($opt eq 'failure') { |
293
|
|
|
|
|
|
|
|
294
|
13
|
100
|
|
|
|
146
|
if (lc($val) =~ /^(exit|display|continue)$/) { |
295
|
12
|
|
|
|
|
55
|
$$self{'g'}{$opt} = lc($val); |
296
|
12
|
|
|
|
|
36
|
next OPT; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
} elsif ($opt =~ s/^ssh://) { |
300
|
1
|
|
|
|
|
4
|
$$self{'g'}{'ssh_opts'}{$opt} = $val; |
301
|
1
|
|
|
|
|
4
|
next OPT; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
} elsif ($opt eq 'ssh_num' || |
304
|
|
|
|
|
|
|
$opt eq 'ssh_sleep' |
305
|
|
|
|
|
|
|
) { |
306
|
2
|
|
|
|
|
21
|
$$self{'g'}{$opt} = $val; |
307
|
2
|
|
|
|
|
8
|
next OPT; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
} elsif ($opt eq 'tmp_script' || |
310
|
|
|
|
|
|
|
$opt eq 'tmp_script_keep' || |
311
|
|
|
|
|
|
|
$opt eq 'ssh_script' || |
312
|
|
|
|
|
|
|
$opt eq 'ssh_script_keep' |
313
|
|
|
|
|
|
|
) { |
314
|
160
|
|
|
|
|
591
|
$$self{'g'}{$opt} = $val; |
315
|
160
|
|
|
|
|
506
|
next OPT; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
} else { |
318
|
1
|
|
|
|
|
6
|
$self->_err("Invalid option: $opt"); |
319
|
1
|
|
|
|
|
4
|
return 1; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
5
|
|
|
|
|
22
|
$self->_err("Invalid value: $opt [ $val ]"); |
323
|
5
|
|
|
|
|
19
|
return 1; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
227
|
|
|
|
|
970
|
return 0; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
############################################################################### |
330
|
|
|
|
|
|
|
# ADDING COMMANDS |
331
|
|
|
|
|
|
|
############################################################################### |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub cmd { |
334
|
489
|
|
|
489
|
1
|
8335
|
my($self,@args) = @_; |
335
|
|
|
|
|
|
|
|
336
|
489
|
|
|
|
|
1224
|
while (@args) { |
337
|
490
|
|
|
|
|
969
|
my $cmd = shift(@args); |
338
|
490
|
|
|
|
|
959
|
my $cmd_num = $$self{'cmd_num'}++; |
339
|
|
|
|
|
|
|
|
340
|
490
|
100
|
100
|
|
|
1593
|
if (ref($cmd) ne '' && |
341
|
|
|
|
|
|
|
ref($cmd) ne 'ARRAY') { |
342
|
1
|
|
|
|
|
3
|
$$self{'err'} = "cmd must be a string or listref"; |
343
|
1
|
|
|
|
|
4
|
$self->_err($$self{'err'}); |
344
|
1
|
|
|
|
|
2
|
return 1; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
489
|
|
|
|
|
784
|
my %options; |
348
|
489
|
100
|
100
|
|
|
1868
|
if (@args && ref($args[0]) eq 'HASH') { |
349
|
106
|
|
|
|
|
226
|
%options = %{ shift(@args) }; |
|
106
|
|
|
|
|
448
|
|
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
489
|
|
|
|
|
1284
|
foreach my $opt (keys %options) { |
353
|
114
|
100
|
|
|
|
954
|
if ($opt !~ /^(dire|noredir|retry|sleep|check|label)$/) { |
354
|
2
|
|
|
|
|
7
|
$$self{'err'} = "Invalid cmd option: $opt"; |
355
|
2
|
|
|
|
|
20
|
$self->_err($$self{'err'}); |
356
|
2
|
|
|
|
|
9
|
return 1; |
357
|
|
|
|
|
|
|
} |
358
|
112
|
100
|
|
|
|
389
|
if ($opt eq 'dire') { |
359
|
3
|
|
|
|
|
19
|
$$self{'cmd'}{$cmd_num}{$opt} = $self->_quote($options{$opt}); |
360
|
|
|
|
|
|
|
} else { |
361
|
109
|
|
|
|
|
1132
|
$$self{'cmd'}{$cmd_num}{$opt} = $options{$opt}; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# Check if it is a flow command. Also, make sure that flow |
366
|
|
|
|
|
|
|
# commands are properly opened, closed, and nested. |
367
|
|
|
|
|
|
|
|
368
|
487
|
|
|
|
|
1455
|
my $err = $self->_cmd_flow($cmd,$cmd_num); |
369
|
487
|
100
|
|
|
|
1104
|
return 1 if ($err); |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
# If the command has alternates, update the max_alt value |
372
|
|
|
|
|
|
|
# as necessary. |
373
|
|
|
|
|
|
|
|
374
|
481
|
100
|
|
|
|
1043
|
if (ref($cmd) eq 'ARRAY') { |
375
|
10
|
|
|
|
|
17
|
my $n = $#{ $cmd } + 1; |
|
10
|
|
|
|
|
31
|
|
376
|
10
|
100
|
|
|
|
55
|
if ($n > $$self{'max_alt'}) { |
377
|
9
|
|
|
|
|
27
|
$$self{'max_alt'} = $n; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
10
|
|
|
|
|
79
|
$$self{'cmd'}{$cmd_num}{'cmd'} = $cmd; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
} else { |
383
|
471
|
|
|
|
|
3282
|
$$self{'cmd'}{$cmd_num}{'cmd'} = [ $cmd ]; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
} |
387
|
480
|
|
|
|
|
1376
|
return 0; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
##################### |
391
|
|
|
|
|
|
|
# Check whether a command is a flow command |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub _cmd_flow { |
394
|
487
|
|
|
487
|
|
1108
|
my($self,$cmd,$cmd_num) = @_; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# A flow command may not have alternatives, so it must be a single command. |
397
|
487
|
100
|
|
|
|
1119
|
return if (ref($cmd)); |
398
|
|
|
|
|
|
|
|
399
|
477
|
|
|
|
|
677
|
my($flow,$type,$err); |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# |
402
|
|
|
|
|
|
|
# Check to see if it is a flow command |
403
|
|
|
|
|
|
|
# |
404
|
|
|
|
|
|
|
|
405
|
477
|
100
|
100
|
|
|
8487
|
if ($cmd =~ /^\s*(if)\s+.*?;\s*then\s*$/ || |
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
406
|
|
|
|
|
|
|
$cmd =~ /^\s*(elif)\s+.*?;\s*then\s*$/ || |
407
|
|
|
|
|
|
|
$cmd =~ /^\s*(else)\s*$/ || |
408
|
|
|
|
|
|
|
$cmd =~ /^\s*(fi)\s*$/) { |
409
|
17
|
|
|
|
|
107
|
$flow = $1; |
410
|
|
|
|
|
|
|
|
411
|
17
|
100
|
|
|
|
115
|
if ($flow eq 'if') { |
|
|
100
|
|
|
|
|
|
412
|
7
|
|
|
|
|
68
|
$err = $self->_cmd_open_flow($cmd_num,'if'); |
413
|
7
|
|
|
|
|
61
|
$$self{'cmd'}{$cmd_num}{'flow_type'} = 'open'; |
414
|
|
|
|
|
|
|
} elsif ($flow eq 'fi') { |
415
|
3
|
|
|
|
|
20
|
$err = $self->_cmd_close_flow($cmd_num,'if','fi'); |
416
|
3
|
|
|
|
|
16
|
$$self{'cmd'}{$cmd_num}{'flow_type'} = 'close'; |
417
|
|
|
|
|
|
|
} else { |
418
|
7
|
|
|
|
|
33
|
$err = $self->_cmd_cont_flow($cmd_num,'if',$flow); |
419
|
7
|
|
|
|
|
39
|
$$self{'cmd'}{$cmd_num}{'flow_type'} = 'cont'; |
420
|
|
|
|
|
|
|
} |
421
|
17
|
|
|
|
|
67
|
$$self{'cmd'}{$cmd_num}{'flow'} = 'if'; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
} elsif ($cmd =~ /^\s*(while)\s+.*?;\s*do\s*$/ || |
424
|
|
|
|
|
|
|
$cmd =~ /^\s*(until)\s+.*?;\s*do\s*$/ || |
425
|
|
|
|
|
|
|
$cmd =~ /^\s*(for)\s+.*?;\s*do\s*$/ || |
426
|
|
|
|
|
|
|
$cmd =~ /^\s*(done)\s*$/) { |
427
|
24
|
|
|
|
|
270
|
$flow = $1; |
428
|
|
|
|
|
|
|
|
429
|
24
|
100
|
100
|
|
|
255
|
if ($flow eq 'while' || $flow eq 'until' || $flow eq 'for') { |
|
|
|
100
|
|
|
|
|
430
|
13
|
|
|
|
|
156
|
$err = $self->_cmd_open_flow($cmd_num,'loop [while|until|for]'); |
431
|
13
|
|
|
|
|
146
|
$$self{'cmd'}{$cmd_num}{'flow_type'} = 'open'; |
432
|
|
|
|
|
|
|
} else { |
433
|
11
|
|
|
|
|
104
|
$err = $self->_cmd_close_flow($cmd_num,'loop [while|until|for]','done'); |
434
|
11
|
|
|
|
|
80
|
$$self{'cmd'}{$cmd_num}{'flow_type'} = 'close'; |
435
|
|
|
|
|
|
|
} |
436
|
24
|
|
|
|
|
76
|
$$self{'cmd'}{$cmd_num}{'flow'} = 'loop'; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
} else { |
439
|
436
|
|
|
|
|
1198
|
return 0; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# |
443
|
|
|
|
|
|
|
# Flow commands may not have the following options: |
444
|
|
|
|
|
|
|
# dire, noredir, retry, check |
445
|
|
|
|
|
|
|
# |
446
|
|
|
|
|
|
|
|
447
|
41
|
|
|
|
|
116
|
foreach my $opt ('dire','noredir','retry','check') { |
448
|
158
|
100
|
|
|
|
413
|
if (exists $$self{'cmd'}{$cmd_num}{$opt}) { |
449
|
4
|
|
|
|
|
22
|
$$self{'err'} = "$opt option not allowed with flow command: $cmd_num"; |
450
|
4
|
|
|
|
|
15
|
return 1; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
37
|
100
|
|
|
|
98
|
return 1 if ($err); |
455
|
35
|
|
|
|
|
108
|
return 0; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub _cmd_curr_flow { |
459
|
91
|
|
|
91
|
|
226
|
my($self) = @_; |
460
|
91
|
|
|
|
|
168
|
my @flow = @{ $$self{'g'}{'flow'} }; |
|
91
|
|
|
|
|
330
|
|
461
|
91
|
100
|
|
|
|
473
|
return '' if (! @flow); |
462
|
22
|
|
|
|
|
86
|
return $flow[$#flow]->[0]; |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
sub _cmd_open_flow { |
465
|
20
|
|
|
20
|
|
108
|
my($self,$cmd_num,$flow) = @_; |
466
|
|
|
|
|
|
|
|
467
|
20
|
|
|
|
|
68
|
push(@{ $$self{'g'}{'flow'} }, |
|
20
|
|
|
|
|
130
|
|
468
|
|
|
|
|
|
|
[$flow,$cmd_num]); |
469
|
|
|
|
|
|
|
|
470
|
20
|
|
|
|
|
66
|
return 0; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
sub _cmd_close_flow { |
473
|
14
|
|
|
14
|
|
110
|
my($self,$cmd_num,$flow,$close) = @_; |
474
|
|
|
|
|
|
|
|
475
|
14
|
|
|
|
|
71
|
my $curr_flow = $self->_cmd_curr_flow(); |
476
|
14
|
100
|
|
|
|
58
|
if ($flow ne $curr_flow) { |
477
|
1
|
|
|
|
|
5
|
$$self{'err'} = "Broken flow: '$close' found, but no '$flow': $cmd_num"; |
478
|
1
|
|
|
|
|
2
|
return 1; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
13
|
|
|
|
|
27
|
pop(@{ $$self{'g'}{'flow'} }); |
|
13
|
|
|
|
|
35
|
|
482
|
13
|
|
|
|
|
38
|
return 0; |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
sub _cmd_cont_flow { |
485
|
7
|
|
|
7
|
|
38
|
my($self,$cmd_num,$flow,$cont) = @_; |
486
|
|
|
|
|
|
|
|
487
|
7
|
|
|
|
|
38
|
my $curr_flow = $self->_cmd_curr_flow(); |
488
|
7
|
100
|
|
|
|
20
|
if ($flow ne $curr_flow) { |
489
|
1
|
|
|
|
|
4
|
$$self{'err'} = "Broken flow: '$cont' found, but no '$flow': $cmd_num"; |
490
|
1
|
|
|
|
|
3
|
return 1; |
491
|
|
|
|
|
|
|
} |
492
|
6
|
|
|
|
|
12
|
return 0; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
sub _cmd_valid_script { |
495
|
71
|
|
|
71
|
|
217
|
my($self) = @_; |
496
|
|
|
|
|
|
|
|
497
|
71
|
100
|
|
|
|
359
|
return 1 if ($$self{'err'}); |
498
|
70
|
|
|
|
|
346
|
my $curr_flow = $self->_cmd_curr_flow(); |
499
|
70
|
100
|
|
|
|
271
|
if ($curr_flow) { |
500
|
1
|
|
|
|
|
5
|
$$self{'err'} = "Broken flow: '$curr_flow' opened, but not closed"; |
501
|
1
|
|
|
|
|
4
|
return 1; |
502
|
|
|
|
|
|
|
} |
503
|
69
|
|
|
|
|
226
|
return 0; |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
############################################################################### |
507
|
|
|
|
|
|
|
# RUN THE COMMANDS |
508
|
|
|
|
|
|
|
############################################################################### |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
sub run { |
511
|
71
|
|
|
71
|
1
|
148634
|
my($self) = @_; |
512
|
71
|
100
|
|
|
|
445
|
if ($self->_cmd_valid_script()) { |
513
|
2
|
|
|
|
|
13
|
$self->_err($$self{'err'}); |
514
|
2
|
|
|
|
|
11
|
return 252; |
515
|
|
|
|
|
|
|
} |
516
|
69
|
|
|
|
|
592
|
$self->_script(); |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
# |
519
|
|
|
|
|
|
|
# Return the script if this is a dry run. |
520
|
|
|
|
|
|
|
# |
521
|
|
|
|
|
|
|
|
522
|
69
|
|
|
|
|
157
|
my $script = join("\n",@{ $$self{'scr'} }); |
|
69
|
|
|
|
|
2846
|
|
523
|
69
|
100
|
|
|
|
581
|
return $script if ($$self{'g'}{'mode'} eq 'dry-run'); |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# |
526
|
|
|
|
|
|
|
# If it's running in real-time, do so. |
527
|
|
|
|
|
|
|
# |
528
|
|
|
|
|
|
|
|
529
|
43
|
|
|
|
|
130
|
my $tmp_script = $$self{'g'}{'tmp_script'}; |
530
|
43
|
100
|
|
|
|
167
|
if (! $tmp_script) { |
531
|
1
|
|
|
|
|
5
|
$self->_err("tmp_script option must be set"); |
532
|
1
|
|
|
|
|
6
|
return 254; |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
42
|
|
|
|
|
719
|
my $out = new IO::File; |
536
|
|
|
|
|
|
|
|
537
|
42
|
100
|
|
|
|
2867
|
if ($out->open("> $tmp_script")) { |
538
|
41
|
|
|
|
|
20793
|
print $out $script; |
539
|
41
|
|
|
|
|
550
|
$out->close(); |
540
|
|
|
|
|
|
|
} else { |
541
|
1
|
|
|
|
|
95
|
$self->_err("tmp_script not writable"); |
542
|
1
|
|
|
|
|
8
|
return 254; |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
|
545
|
41
|
|
|
|
|
2429
|
my $err; |
546
|
41
|
100
|
|
|
|
275
|
if ($$self{'g'}{'mode'} eq 'run') { |
547
|
33
|
|
|
|
|
2440862
|
system(". $tmp_script"); |
548
|
33
|
|
|
|
|
1791
|
$err = $?; |
549
|
|
|
|
|
|
|
|
550
|
33
|
100
|
|
|
|
1242
|
if (! $$self{'g'}{'tmp_script_keep'}) { |
551
|
1
|
|
|
|
|
156
|
unlink($tmp_script); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
33
|
|
|
|
|
3664
|
return $err; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
# |
558
|
|
|
|
|
|
|
# If it's running in 'script' mode, capture the output so that |
559
|
|
|
|
|
|
|
# we can parse it. |
560
|
|
|
|
|
|
|
# |
561
|
|
|
|
|
|
|
|
562
|
8
|
|
|
|
|
22
|
my($stdout,$stderr,$exit); |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
# We will always keep at least one of STDOUT/STDERR because they contain the |
565
|
|
|
|
|
|
|
# information necessary to see what commands run. In 'quiet' mode, the |
566
|
|
|
|
|
|
|
# individual commands will discard all output, but the overall script will |
567
|
|
|
|
|
|
|
# still use STDOUT. |
568
|
8
|
100
|
100
|
|
|
101
|
if ($$self{'g'}{'out'} && |
|
|
100
|
|
|
|
|
|
569
|
|
|
|
|
|
|
$$self{'g'}{'err'}) { |
570
|
5
|
|
|
5
|
|
631
|
($stdout,$stderr,$exit) = capture { system( ". $tmp_script" ) }; |
|
5
|
|
|
|
|
97460
|
|
571
|
|
|
|
|
|
|
} elsif ($$self{'g'}{'err'}) { |
572
|
1
|
|
|
1
|
|
117
|
($stderr,$exit) = capture_stderr { system( ". $tmp_script" ) }; |
|
1
|
|
|
|
|
7958
|
|
573
|
|
|
|
|
|
|
} else { |
574
|
2
|
|
|
2
|
|
240
|
($stdout,$exit) = capture_stdout { system( ". $tmp_script" ) }; |
|
2
|
|
|
|
|
16490
|
|
575
|
|
|
|
|
|
|
} |
576
|
8
|
|
|
|
|
10787
|
$exit = $exit >> 8; |
577
|
|
|
|
|
|
|
|
578
|
8
|
100
|
|
|
|
167
|
if (! $$self{'g'}{'tmp_script_keep'}) { |
579
|
1
|
|
|
|
|
61
|
unlink($tmp_script); |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
8
|
100
|
|
|
|
222
|
$$self{'o'}{'out'} = $self->_script_output($stdout) if ($stdout); |
583
|
8
|
100
|
|
|
|
94
|
$$self{'o'}{'err'} = $self->_script_output($stderr) if ($stderr); |
584
|
8
|
|
|
|
|
77
|
$$self{'o'}{'exit'} = $exit; |
585
|
|
|
|
|
|
|
|
586
|
8
|
|
|
|
|
180
|
return $exit; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
############################################################################### |
590
|
|
|
|
|
|
|
# CREATE THE SCRIPT |
591
|
|
|
|
|
|
|
############################################################################### |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
sub _script { |
594
|
69
|
|
|
69
|
|
220
|
my($self) = @_; |
595
|
69
|
|
|
|
|
165
|
my(@ret); |
596
|
69
|
|
|
|
|
525
|
$self->_script_options(); |
597
|
69
|
|
|
|
|
728
|
$self->_ind_0(); |
598
|
|
|
|
|
|
|
|
599
|
69
|
|
|
|
|
177
|
while (1) { |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
############################## |
602
|
|
|
|
|
|
|
# If needed, we'll generate a simple script. |
603
|
|
|
|
|
|
|
# |
604
|
|
|
|
|
|
|
# The simple script is used in two ways: |
605
|
|
|
|
|
|
|
# o If a simple script is all that is needed, we'll use this |
606
|
|
|
|
|
|
|
# to print out the list of commands that would run without |
607
|
|
|
|
|
|
|
# all of the fancy error handling and I/O redirection. |
608
|
|
|
|
|
|
|
# o If the 'failure' option is set to 'display', we'll build |
609
|
|
|
|
|
|
|
# in a function to the script that will display the commands |
610
|
|
|
|
|
|
|
# that should have run. This function will be called in |
611
|
|
|
|
|
|
|
# the event of a failure. |
612
|
|
|
|
|
|
|
|
613
|
69
|
100
|
|
|
|
311
|
if ($$self{'g'}{'simple'}) { |
614
|
6
|
|
|
|
|
37
|
$self->_script_init('simple'); |
615
|
|
|
|
|
|
|
|
616
|
6
|
|
|
|
|
104
|
foreach my $cmd_num (1 .. $$self{'cmd_num'}-1) { |
617
|
18
|
|
|
|
|
120
|
$self->_cmd_options($cmd_num,'simple'); |
618
|
18
|
|
|
|
|
103
|
$self->_script_cmd($cmd_num) |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
6
|
|
|
|
|
63
|
$self->_script_term('simple'); |
622
|
|
|
|
|
|
|
|
623
|
6
|
100
|
|
|
|
30
|
last if ($$self{'g'}{'simple'} eq 'simple'); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
############################## |
627
|
|
|
|
|
|
|
# Now generate the full script |
628
|
|
|
|
|
|
|
|
629
|
67
|
|
|
|
|
458
|
$self->_script_init(); |
630
|
|
|
|
|
|
|
|
631
|
67
|
|
|
|
|
823
|
foreach my $cmd_num (1 .. $$self{'cmd_num'}-1) { |
632
|
460
|
|
|
|
|
1766
|
$self->_cmd_options($cmd_num); |
633
|
460
|
|
|
|
|
1255
|
$self->_script_cmd($cmd_num) |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
|
636
|
67
|
|
|
|
|
394
|
$self->_script_term(); |
637
|
|
|
|
|
|
|
|
638
|
67
|
|
|
|
|
210
|
last; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
sub _script_init { |
643
|
73
|
|
|
73
|
|
245
|
my($self,$simple) = @_; |
644
|
73
|
|
|
|
|
182
|
my($text,$env,$text2); |
645
|
|
|
|
|
|
|
|
646
|
73
|
100
|
|
|
|
240
|
if ($simple) { |
647
|
6
|
|
|
|
|
44
|
$$self{'c'}{'simp'} = $$self{'g'}{'simple'}; |
648
|
|
|
|
|
|
|
} else { |
649
|
67
|
|
|
|
|
616
|
$$self{'c'}{'simp'} = ''; |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
73
|
100
|
|
|
|
324
|
if ($simple) { |
653
|
|
|
|
|
|
|
|
654
|
6
|
|
|
|
|
43
|
$text = <<'EOT'; |
655
|
|
|
|
|
|
|
: simple () { |
656
|
|
|
|
|
|
|
: echo "" |
657
|
|
|
|
|
|
|
: echo "#****************************************" |
658
|
|
|
|
|
|
|
: if [ $SC_FAILED -eq 201 ]; then |
659
|
|
|
|
|
|
|
: echo "# The following script failed after command 200" |
660
|
|
|
|
|
|
|
: elif [ $SC_FAILED -gt 201 ]; then |
661
|
|
|
|
|
|
|
: echo "# The following script failed during initialization" |
662
|
|
|
|
|
|
|
: else |
663
|
|
|
|
|
|
|
: echo "# The following script failed at command $SC_FAILED" |
664
|
|
|
|
|
|
|
: fi |
665
|
|
|
|
|
|
|
: while read line ;do |
666
|
|
|
|
|
|
|
: echo "$line" |
667
|
|
|
|
|
|
|
: done << SC_SIMPLE_EOS |
668
|
|
|
|
|
|
|
: SC_ORIG_DIRE=`pwd`; |
669
|
|
|
|
|
|
|
EOT |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
} else { |
672
|
67
|
|
|
|
|
419
|
$text = <<'EOT'; |
673
|
|
|
|
|
|
|
: SC_FAILED=0; |
674
|
|
|
|
|
|
|
: echo "# SC_ORIG_DIRE=`pwd`"; |
675
|
|
|
|
|
|
|
: SC_ORIG_DIRE=`pwd`; |
676
|
|
|
|
|
|
|
: |
677
|
|
|
|
|
|
|
: main () { |
678
|
|
|
|
|
|
|
EOT |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
73
|
|
|
|
|
201
|
$env = <<'EOT'; |
682
|
|
|
|
|
|
|
: echo '# export =""'; |
683
|
|
|
|
|
|
|
: export =""; |
684
|
|
|
|
|
|
|
EOT |
685
|
|
|
|
|
|
|
|
686
|
73
|
|
|
|
|
205
|
$text2 = <<'EOT'; |
687
|
|
|
|
|
|
|
: echo '# SC_DIRE=""'; |
688
|
|
|
|
|
|
|
: SC_DIRE=""; |
689
|
|
|
|
|
|
|
: echo '# cd "$SC_DIRE"'; |
690
|
|
|
|
|
|
|
: cd "$SC_DIRE"; |
691
|
|
|
|
|
|
|
: cd "$SC_DIRE" 2>/dev/null; |
692
|
|
|
|
|
|
|
: if [ $? -ne 0 ]; then |
693
|
|
|
|
|
|
|
: SC_FAILED=255; |
694
|
|
|
|
|
|
|
: return; |
695
|
|
|
|
|
|
|
: fi |
696
|
|
|
|
|
|
|
: echo "# SC_DIRE=$SC_ORIG_DIRE"; |
697
|
|
|
|
|
|
|
: SC_DIRE=$SC_ORIG_DIRE; |
698
|
|
|
|
|
|
|
EOT |
699
|
|
|
|
|
|
|
|
700
|
73
|
|
|
|
|
574
|
$self->_text_to_script($text); |
701
|
73
|
100
|
|
|
|
575
|
$self->_ind_plus() if (! $simple); |
702
|
|
|
|
|
|
|
|
703
|
73
|
|
|
|
|
204
|
my(@tmp) = @{ $$self{'e'} }; |
|
73
|
|
|
|
|
296
|
|
704
|
73
|
|
|
|
|
328
|
while (@tmp) { |
705
|
32
|
|
|
|
|
64
|
my $var = shift(@tmp); |
706
|
32
|
|
|
|
|
64
|
my $val = shift(@tmp); |
707
|
32
|
|
|
|
|
63
|
my $str = $env; |
708
|
32
|
|
|
|
|
187
|
$str =~ s//$var/g; |
709
|
32
|
|
|
|
|
186
|
$str =~ s//$val/g; |
710
|
32
|
|
|
|
|
101
|
$self->_text_to_script($str); |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
|
713
|
73
|
|
|
|
|
348
|
$self->_text_to_script($text2); |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
sub _script_term { |
717
|
73
|
|
|
73
|
|
300
|
my($self,$simple) = @_; |
718
|
73
|
|
|
|
|
175
|
my($text); |
719
|
|
|
|
|
|
|
|
720
|
73
|
100
|
|
|
|
319
|
if ($simple) { |
721
|
6
|
|
|
|
|
45
|
$$self{'c'}{'simp'} = $$self{'g'}{'simple'}; |
722
|
6
|
|
|
|
|
45
|
$text = <<'EOT'; |
723
|
|
|
|
|
|
|
: cd "$SC_ORIG_DIRE"; |
724
|
|
|
|
|
|
|
: SC_SIMPLE_EOS |
725
|
|
|
|
|
|
|
: } |
726
|
|
|
|
|
|
|
: |
727
|
|
|
|
|
|
|
EOT |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
} else { |
730
|
67
|
|
|
|
|
260
|
$self->_ind_minus(); |
731
|
67
|
|
|
|
|
571
|
$text = <<'EOT'; |
732
|
|
|
|
|
|
|
: } |
733
|
|
|
|
|
|
|
: |
734
|
|
|
|
|
|
|
: main; |
735
|
|
|
|
|
|
|
: cd "$SC_ORIG_DIRE"; |
736
|
|
|
|
|
|
|
: if [ $SC_FAILED -ne 0 ]; then |
737
|
|
|
|
|
|
|
: simple; |
738
|
|
|
|
|
|
|
: fi |
739
|
|
|
|
|
|
|
: echo '# cd "$SC_ORIG_DIRE"'; |
740
|
|
|
|
|
|
|
: exit $SC_FAILED; |
741
|
|
|
|
|
|
|
: |
742
|
|
|
|
|
|
|
EOT |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
73
|
|
|
|
|
426
|
$self->_text_to_script($text); |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
##################### |
749
|
|
|
|
|
|
|
# This analyzes the options and sets some variables to determine |
750
|
|
|
|
|
|
|
# how the script behaves. |
751
|
|
|
|
|
|
|
# |
752
|
|
|
|
|
|
|
sub _script_options { |
753
|
69
|
|
|
69
|
|
208
|
my($self) = @_; |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
# |
756
|
|
|
|
|
|
|
# Calculate the type of script that we're creating. |
757
|
|
|
|
|
|
|
# |
758
|
|
|
|
|
|
|
# In dry-run mode, we may produce any of the script types: |
759
|
|
|
|
|
|
|
# simple, run, script |
760
|
|
|
|
|
|
|
# |
761
|
|
|
|
|
|
|
# In run/script mode, we will produce that type of script. |
762
|
|
|
|
|
|
|
# We'll also produce a simple script for failure in 'run' |
763
|
|
|
|
|
|
|
# mode if 'failure' is 'display'. |
764
|
|
|
|
|
|
|
# |
765
|
|
|
|
|
|
|
|
766
|
69
|
100
|
|
|
|
365
|
if ($$self{'g'}{'mode'} eq 'dry-run') { |
767
|
26
|
100
|
|
|
|
184
|
$$self{'g'}{'s_type'} = ($$self{'g'}{'script'} ? $$self{'g'}{'script'} : 'run'); |
768
|
26
|
100
|
100
|
|
|
286
|
if ($$self{'g'}{'script'} eq 'simple') { |
|
|
100
|
|
|
|
|
|
769
|
2
|
|
|
|
|
5
|
$$self{'g'}{'simple'} = 'simple'; |
770
|
|
|
|
|
|
|
} elsif ($$self{'g'}{'s_type'} eq 'run' && |
771
|
|
|
|
|
|
|
$$self{'g'}{'failure'} eq 'display') { |
772
|
2
|
|
|
|
|
7
|
$$self{'g'}{'simple'} = 'failure'; |
773
|
|
|
|
|
|
|
} else { |
774
|
22
|
|
|
|
|
71
|
$$self{'g'}{'simple'} = ''; |
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
} else { |
777
|
43
|
|
|
|
|
183
|
$$self{'g'}{'s_type'} = $$self{'g'}{'mode'}; |
778
|
43
|
100
|
100
|
|
|
549
|
if ($$self{'g'}{'s_type'} eq 'run' && |
779
|
|
|
|
|
|
|
$$self{'g'}{'failure'} eq 'display') { |
780
|
2
|
|
|
|
|
8
|
$$self{'g'}{'simple'} = 'failure'; |
781
|
|
|
|
|
|
|
} else { |
782
|
41
|
|
|
|
|
165
|
$$self{'g'}{'simple'} = ''; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
# |
787
|
|
|
|
|
|
|
# Echoing commands applies to run mode. In both dry-run and |
788
|
|
|
|
|
|
|
# script mode, it doesn't apply. |
789
|
|
|
|
|
|
|
# |
790
|
|
|
|
|
|
|
|
791
|
69
|
100
|
|
|
|
337
|
if ($$self{'g'}{'mode'} eq 'run') { |
792
|
35
|
|
|
|
|
132
|
$$self{'g'}{'c_echo'} = $$self{'g'}{'echo'}; |
793
|
|
|
|
|
|
|
} else { |
794
|
34
|
|
|
|
|
112
|
$$self{'g'}{'c_echo'} = ''; |
795
|
|
|
|
|
|
|
} |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# |
798
|
|
|
|
|
|
|
# When a command fails, we normally handle it using the 'failure' |
799
|
|
|
|
|
|
|
# option. In a simple script, we don't do failure handling. |
800
|
|
|
|
|
|
|
# |
801
|
|
|
|
|
|
|
|
802
|
69
|
100
|
|
|
|
263
|
if ($$self{'g'}{'s_type'} eq 'simple') { |
803
|
2
|
|
|
|
|
5
|
$$self{'g'}{'c_fail'} = ''; |
804
|
|
|
|
|
|
|
} else { |
805
|
67
|
|
|
|
|
207
|
$$self{'g'}{'c_fail'} = $$self{'g'}{'failure'}; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
# |
809
|
|
|
|
|
|
|
# Analyze the 'output' option to determine whether we are capturing |
810
|
|
|
|
|
|
|
# STDOUT and/or STDERR. Set the 'redir' flag to the appropriate |
811
|
|
|
|
|
|
|
# string for performing this capture. |
812
|
|
|
|
|
|
|
# |
813
|
|
|
|
|
|
|
# 'simple' scripts do no redirection. |
814
|
|
|
|
|
|
|
# |
815
|
|
|
|
|
|
|
# |
816
|
|
|
|
|
|
|
# If we ever want: |
817
|
|
|
|
|
|
|
# STDOUT -> /dev/null, STDERR -> STDOUT: |
818
|
|
|
|
|
|
|
# use: |
819
|
|
|
|
|
|
|
# $$self{'c'}{'g_redir'} = '2>&1 >/dev/null'; |
820
|
|
|
|
|
|
|
|
821
|
69
|
100
|
100
|
|
|
548
|
if ($$self{'g'}{'s_type'} eq 'run' || |
822
|
|
|
|
|
|
|
$$self{'g'}{'s_type'} eq 'script') { |
823
|
|
|
|
|
|
|
|
824
|
67
|
100
|
|
|
|
359
|
if ($$self{'g'}{'output'} eq 'both') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
825
|
|
|
|
|
|
|
# Capturing both so no redirection |
826
|
59
|
|
|
|
|
365
|
$$self{'g'}{'redir'} = ''; |
827
|
59
|
|
|
|
|
184
|
$$self{'g'}{'out'} = 1; |
828
|
59
|
|
|
|
|
146
|
$$self{'g'}{'err'} = 1; |
829
|
59
|
|
|
|
|
544
|
$$self{'g'}{'quiet'} = 0; |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
} elsif ($$self{'g'}{'output'} eq 'merged') { |
832
|
|
|
|
|
|
|
# Merged output |
833
|
1
|
|
|
|
|
3
|
$$self{'g'}{'redir'} = '2>&1'; |
834
|
1
|
|
|
|
|
3
|
$$self{'g'}{'out'} = 1; |
835
|
1
|
|
|
|
|
2
|
$$self{'g'}{'err'} = 0; |
836
|
1
|
|
|
|
|
10
|
$$self{'g'}{'quiet'} = 0; |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
} elsif ($$self{'g'}{'output'} eq 'stdout') { |
839
|
|
|
|
|
|
|
# Keep STDOUT, discard STDERR |
840
|
2
|
|
|
|
|
8
|
$$self{'g'}{'redir'} = '2>/dev/null'; |
841
|
2
|
|
|
|
|
7
|
$$self{'g'}{'out'} = 1; |
842
|
2
|
|
|
|
|
3
|
$$self{'g'}{'err'} = 0; |
843
|
2
|
|
|
|
|
17
|
$$self{'g'}{'quiet'} = 0; |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
} elsif ($$self{'g'}{'output'} eq 'stderr') { |
846
|
|
|
|
|
|
|
# Discard STDOUT, keep STDERR |
847
|
2
|
|
|
|
|
10
|
$$self{'g'}{'redir'} = '>/dev/null'; |
848
|
2
|
|
|
|
|
6
|
$$self{'g'}{'out'} = 0; |
849
|
2
|
|
|
|
|
4
|
$$self{'g'}{'err'} = 1; |
850
|
2
|
|
|
|
|
16
|
$$self{'g'}{'quiet'} = 0; |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
} else { |
853
|
|
|
|
|
|
|
# Discard everthing |
854
|
3
|
|
|
|
|
17
|
$$self{'g'}{'redir'} = '>/dev/null 2>&1'; |
855
|
3
|
|
|
|
|
18
|
$$self{'g'}{'out'} = 0; |
856
|
3
|
|
|
|
|
8
|
$$self{'g'}{'err'} = 0; |
857
|
3
|
|
|
|
|
25
|
$$self{'g'}{'quiet'} = 1; |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
} else { |
861
|
|
|
|
|
|
|
# s_type = simple |
862
|
|
|
|
|
|
|
|
863
|
2
|
|
|
|
|
15
|
$$self{'g'}{'redir'} = ''; |
864
|
2
|
|
|
|
|
5
|
$$self{'g'}{'out'} = 1; |
865
|
2
|
|
|
|
|
7
|
$$self{'g'}{'err'} = 1; |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
} |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
############################################################################### |
871
|
|
|
|
|
|
|
# ADD A COMMAND TO THE SCRIPT |
872
|
|
|
|
|
|
|
############################################################################### |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
sub _script_cmd { |
875
|
478
|
|
|
478
|
|
932
|
my($self,$cmd_num) = @_; |
876
|
|
|
|
|
|
|
|
877
|
478
|
100
|
|
|
|
1145
|
if ($$self{'cmd'}{$cmd_num}{'flow'}) { |
878
|
30
|
|
|
|
|
95
|
$self->_script_cmd_flow($cmd_num); |
879
|
|
|
|
|
|
|
} else { |
880
|
448
|
|
|
|
|
1262
|
$self->_script_cmd_nonflow($cmd_num); |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
sub _script_cmd_flow { |
885
|
30
|
|
|
30
|
|
67
|
my($self,$cmd_num) = @_; |
886
|
|
|
|
|
|
|
|
887
|
30
|
|
|
|
|
71
|
my $type = $$self{'cmd'}{$cmd_num}{'flow_type'}; |
888
|
|
|
|
|
|
|
|
889
|
30
|
100
|
|
|
|
141
|
if ($type eq 'open') { |
|
|
100
|
|
|
|
|
|
890
|
13
|
|
|
|
|
83
|
$self->_script_cmd_cmd(); |
891
|
13
|
|
|
|
|
48
|
$self->_ind_plus(); |
892
|
|
|
|
|
|
|
} elsif ($type eq 'cont') { |
893
|
4
|
|
|
|
|
10
|
$self->_ind_minus(); |
894
|
4
|
|
|
|
|
10
|
$self->_script_cmd_cmd(); |
895
|
4
|
|
|
|
|
11
|
$self->_ind_plus(); |
896
|
|
|
|
|
|
|
} else { |
897
|
13
|
|
|
|
|
49
|
$self->_ind_minus(); |
898
|
13
|
|
|
|
|
38
|
$self->_script_cmd_cmd(); |
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
sub _script_cmd_nonflow { |
903
|
448
|
|
|
448
|
|
862
|
my($self,$cmd_num) = @_; |
904
|
|
|
|
|
|
|
|
905
|
448
|
|
|
|
|
1294
|
$self->_script_cmd_init($cmd_num); |
906
|
448
|
|
|
|
|
716
|
my $n = @{ $$self{'cmd'}{$cmd_num}{'cmd'} }; |
|
448
|
|
|
|
|
1053
|
|
907
|
|
|
|
|
|
|
|
908
|
448
|
100
|
|
|
|
1031
|
if ($n > 1) { |
909
|
|
|
|
|
|
|
# Command with alternates |
910
|
|
|
|
|
|
|
|
911
|
9
|
|
|
|
|
55
|
for (my $a=1; $a<= $n; $a++) { |
912
|
24
|
|
|
|
|
79
|
$self->_alt_options($cmd_num,$a); |
913
|
24
|
|
|
|
|
49
|
$self->_script_cmd_cmd(); |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
} else { |
917
|
|
|
|
|
|
|
# Single command |
918
|
|
|
|
|
|
|
|
919
|
439
|
|
|
|
|
1245
|
$self->_script_cmd_cmd(); |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
|
922
|
448
|
|
|
|
|
1400
|
$self->_script_cmd_term($cmd_num); |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
sub _script_cmd_init { |
926
|
448
|
|
|
448
|
|
853
|
my($self,$cmd_num) = @_; |
927
|
|
|
|
|
|
|
|
928
|
448
|
|
|
|
|
843
|
my $text = <<'EOT'; |
929
|
|
|
|
|
|
|
: # |
930
|
|
|
|
|
|
|
: |
931
|
|
|
|
|
|
|
: # |
932
|
|
|
|
|
|
|
: # Command |
933
|
|
|
|
|
|
|
: # |
934
|
|
|
|
|
|
|
: |
935
|
|
|
|
|
|
|
: SC_CURR_EXIT=0; |
936
|
|
|
|
|
|
|
: SC_CURR_SUCC=0; |
937
|
|
|
|
|
|
|
: |
938
|
|
|
|
|
|
|
: echo '# SC_DIRE_=`pwd`'; |
939
|
|
|
|
|
|
|
: echo '# cd ""'; |
940
|
|
|
|
|
|
|
: SC_DIRE_=`pwd`; |
941
|
|
|
|
|
|
|
: cd ""; |
942
|
|
|
|
|
|
|
: cd "" 2>/dev/null; |
943
|
|
|
|
|
|
|
: if [ $? -eq 0 ]; then |
944
|
|
|
|
|
|
|
EOT |
945
|
|
|
|
|
|
|
|
946
|
448
|
|
|
|
|
1139
|
$self->_text_to_script($text); |
947
|
|
|
|
|
|
|
|
948
|
448
|
|
|
|
|
1024
|
$text = <<'EOT'; |
949
|
|
|
|
|
|
|
: |
950
|
|
|
|
|
|
|
: SC_RETRIES=; |
951
|
|
|
|
|
|
|
: SC_TRY=0; |
952
|
|
|
|
|
|
|
: while [ $SC_TRY -lt $SC_RETRIES ]; do |
953
|
|
|
|
|
|
|
EOT |
954
|
|
|
|
|
|
|
|
955
|
448
|
|
|
|
|
1118
|
$self->_text_to_script($text); |
956
|
448
|
100
|
100
|
|
|
1819
|
$self->_ind_plus() if ($$self{'c'}{'c_retries'} && ! $$self{'c'}{'simp'}); |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
sub _script_cmd_term { |
960
|
448
|
|
|
448
|
|
979
|
my($self,$cmd_num) = @_; |
961
|
|
|
|
|
|
|
|
962
|
448
|
|
|
|
|
1060
|
my $text = <<'EOT'; |
963
|
|
|
|
|
|
|
: |
964
|
|
|
|
|
|
|
: if [ $SC_CURR_EXIT -eq 0 ]; then |
965
|
|
|
|
|
|
|
: break; |
966
|
|
|
|
|
|
|
: fi |
967
|
|
|
|
|
|
|
: SC_TRY=`expr $SC_TRY + 1`; |
968
|
|
|
|
|
|
|
: if [ $SC_TRY -lt $SC_RETRIES ]; then |
969
|
|
|
|
|
|
|
: sleep ; |
970
|
|
|
|
|
|
|
: fi |
971
|
|
|
|
|
|
|
: done |
972
|
|
|
|
|
|
|
EOT |
973
|
|
|
|
|
|
|
|
974
|
448
|
|
|
|
|
1562
|
$self->_text_to_script($text); |
975
|
|
|
|
|
|
|
|
976
|
448
|
|
|
|
|
1061
|
$text = <<'EOT'; |
977
|
|
|
|
|
|
|
: |
978
|
|
|
|
|
|
|
: echo '# cd "$SC_DIRE_"'; |
979
|
|
|
|
|
|
|
: cd "$SC_DIRE_"; |
980
|
|
|
|
|
|
|
: else |
981
|
|
|
|
|
|
|
: SC_CURR_EXIT=; |
982
|
|
|
|
|
|
|
: fi |
983
|
|
|
|
|
|
|
EOT |
984
|
|
|
|
|
|
|
|
985
|
448
|
|
|
|
|
1211
|
$self->_text_to_script($text); |
986
|
|
|
|
|
|
|
|
987
|
448
|
|
|
|
|
714
|
$text = <<'EOT'; |
988
|
|
|
|
|
|
|
: |
989
|
|
|
|
|
|
|
: if [ $SC_FAILED -eq 0 -a $SC_CURR_EXIT -ne 0 ]; then |
990
|
|
|
|
|
|
|
: SC_FAILED=; |
991
|
|
|
|
|
|
|
: fi |
992
|
|
|
|
|
|
|
: |
993
|
|
|
|
|
|
|
: if [ $SC_FAILED -ne 0 ]; then |
994
|
|
|
|
|
|
|
: return; |
995
|
|
|
|
|
|
|
: fi |
996
|
|
|
|
|
|
|
EOT |
997
|
|
|
|
|
|
|
|
998
|
448
|
|
|
|
|
937
|
$self->_text_to_script($text); |
999
|
|
|
|
|
|
|
} |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
sub _script_cmd_cmd { |
1002
|
493
|
|
|
493
|
|
897
|
my($self) = @_; |
1003
|
493
|
|
|
|
|
730
|
my($text); |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
# Print out any header and echo the command as appropriate |
1006
|
|
|
|
|
|
|
|
1007
|
493
|
100
|
|
|
|
1356
|
if (! $$self{'c'}{'simp'}) { |
1008
|
475
|
100
|
|
|
|
1165
|
if (! $$self{'c'}{'c_flow'}) { |
1009
|
445
|
|
|
|
|
1029
|
$text = <<'EOT'; |
1010
|
|
|
|
|
|
|
: |
1011
|
|
|
|
|
|
|
: # |
1012
|
|
|
|
|
|
|
: # Command |
1013
|
|
|
|
|
|
|
: # |
1014
|
|
|
|
|
|
|
: |
1015
|
|
|
|
|
|
|
: if [ $SC_CURR_SUCC -eq 0 ]; then |
1016
|
|
|
|
|
|
|
: echo "#SC CMD ."; |
1017
|
|
|
|
|
|
|
: echo "#SC CMD ." >&2; |
1018
|
|
|
|
|
|
|
: echo "#SC CMD ."; |
1019
|
|
|
|
|
|
|
: echo "#SC TRY $SC_TRY"; |
1020
|
|
|
|
|
|
|
: echo "#SC TRY $SC_TRY" >&2; |
1021
|
|
|
|
|
|
|
: fi |
1022
|
|
|
|
|
|
|
: |
1023
|
|
|
|
|
|
|
: echo "# "; |
1024
|
|
|
|
|
|
|
: echo "# Check with: "; |
1025
|
|
|
|
|
|
|
: echo "# ALT: "; |
1026
|
|
|
|
|
|
|
: echo "# "; |
1027
|
|
|
|
|
|
|
: echo "# Check with: "; |
1028
|
|
|
|
|
|
|
EOT |
1029
|
|
|
|
|
|
|
|
1030
|
445
|
|
|
|
|
1050
|
$self->_text_to_script($text); |
1031
|
|
|
|
|
|
|
} |
1032
|
|
|
|
|
|
|
} |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
# We want to generate essentially the following script: |
1035
|
|
|
|
|
|
|
# |
1036
|
|
|
|
|
|
|
# CMD1 |
1037
|
|
|
|
|
|
|
# if [ "$?" != 0 ]; then |
1038
|
|
|
|
|
|
|
# CMD2 |
1039
|
|
|
|
|
|
|
# fi |
1040
|
|
|
|
|
|
|
# ... |
1041
|
|
|
|
|
|
|
# if [ "$?" != 0 ]; then |
1042
|
|
|
|
|
|
|
# CMDn |
1043
|
|
|
|
|
|
|
# fi |
1044
|
|
|
|
|
|
|
# if [ "$?" != 0 ]; then |
1045
|
|
|
|
|
|
|
# exit X |
1046
|
|
|
|
|
|
|
# fi |
1047
|
|
|
|
|
|
|
# |
1048
|
|
|
|
|
|
|
# where CMDn is the last alternate and X is the command number. |
1049
|
|
|
|
|
|
|
# |
1050
|
|
|
|
|
|
|
# If we have a 'check' option, we'll need to run that |
1051
|
|
|
|
|
|
|
# command immediately after every CMDi. |
1052
|
|
|
|
|
|
|
# |
1053
|
|
|
|
|
|
|
# if command succeeded |
1054
|
|
|
|
|
|
|
# SC_CURR_SUCC = 1 -> this will mean that no more alternates run |
1055
|
|
|
|
|
|
|
# SC_CURR_EXIT = 0 |
1056
|
|
|
|
|
|
|
# else if this is the first alternate to fail |
1057
|
|
|
|
|
|
|
# SC_CURR_EXIT = $? -> we'll use the first exit code if all alt. fail |
1058
|
|
|
|
|
|
|
# |
1059
|
|
|
|
|
|
|
# For script mode, make sure that both STDOUT and STDIN have a newline. |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
|
1062
|
493
|
100
|
|
|
|
1537
|
if ($$self{'c'}{'c_flow'}) { |
|
|
100
|
|
|
|
|
|
1063
|
30
|
|
|
|
|
82
|
$text = <<'EOT'; |
1064
|
|
|
|
|
|
|
: |
1065
|
|
|
|
|
|
|
: |
1066
|
|
|
|
|
|
|
EOT |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
} elsif ($$self{'c'}{'simp'}) { |
1069
|
18
|
|
|
|
|
85
|
$text = <<'EOT'; |
1070
|
|
|
|
|
|
|
: ; |
1071
|
|
|
|
|
|
|
EOT |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
} else { |
1074
|
445
|
|
|
|
|
803
|
$text = <<'EOT'; |
1075
|
|
|
|
|
|
|
: |
1076
|
|
|
|
|
|
|
: if [ $SC_CURR_SUCC -eq 0 ]; then |
1077
|
|
|
|
|
|
|
: ; |
1078
|
|
|
|
|
|
|
: # CHECK WITH |
1079
|
|
|
|
|
|
|
: ; |
1080
|
|
|
|
|
|
|
: CMD_EXIT=$?; |
1081
|
|
|
|
|
|
|
: echo ""; |
1082
|
|
|
|
|
|
|
: echo "" >&2; |
1083
|
|
|
|
|
|
|
: if [ $CMD_EXIT -eq 0 ]; then |
1084
|
|
|
|
|
|
|
: SC_CURR_SUCC=1; |
1085
|
|
|
|
|
|
|
: SC_CURR_EXIT=0; |
1086
|
|
|
|
|
|
|
: elif [ $SC_CURR_EXIT -eq 0 ]; then |
1087
|
|
|
|
|
|
|
: SC_CURR_EXIT=$CMD_EXIT; |
1088
|
|
|
|
|
|
|
: fi |
1089
|
|
|
|
|
|
|
: if [ $CMD_EXIT -ne 0 ]; then |
1090
|
|
|
|
|
|
|
: echo "#SC EXIT . $CMD_EXIT"; |
1091
|
|
|
|
|
|
|
: echo "#SC EXIT . $CMD_EXIT" >&2; |
1092
|
|
|
|
|
|
|
: echo "#SC EXIT . $CMD_EXIT"; |
1093
|
|
|
|
|
|
|
: fi |
1094
|
|
|
|
|
|
|
: fi |
1095
|
|
|
|
|
|
|
EOT |
1096
|
|
|
|
|
|
|
} |
1097
|
|
|
|
|
|
|
|
1098
|
493
|
|
|
|
|
1096
|
$self->_text_to_script($text); |
1099
|
|
|
|
|
|
|
} |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
################### |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
# Set cmd_str and cmd_pref for the current command. |
1104
|
|
|
|
|
|
|
# |
1105
|
|
|
|
|
|
|
sub _alt_options { |
1106
|
24
|
|
|
24
|
|
55
|
my($self,$cmd_num,$alt_num) = @_; |
1107
|
24
|
|
|
|
|
53
|
my $label = $$self{'c'}{'c_label'}; |
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
# |
1110
|
|
|
|
|
|
|
# Only called with a command with alternates. |
1111
|
|
|
|
|
|
|
# |
1112
|
|
|
|
|
|
|
|
1113
|
24
|
|
|
|
|
66
|
$$self{'c'}{'cmd_str'} = $$self{'cmd'}{$cmd_num}{'cmd'}[$alt_num-1]; |
1114
|
24
|
|
|
|
|
78
|
$$self{'c'}{'cmd_str_q'} = $self->_quote($$self{'c'}{'cmd_str'}); |
1115
|
24
|
100
|
|
|
|
140
|
$$self{'c'}{'cmd_label'} = "$cmd_num" . ($label ? " [$label]" : ''); |
1116
|
24
|
|
|
|
|
86
|
$$self{'c'}{'alt_label'} = "$cmd_num.$alt_num"; |
1117
|
24
|
|
|
|
|
42
|
$$self{'c'}{'alts'} = 1; |
1118
|
24
|
|
|
|
|
50
|
$$self{'c'}{'a_num'} = $alt_num; |
1119
|
|
|
|
|
|
|
} |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
sub _cmd_options { |
1122
|
478
|
|
|
478
|
|
1128
|
my($self,$cmd_num,$simple) = @_; |
1123
|
|
|
|
|
|
|
|
1124
|
478
|
|
|
|
|
1089
|
$$self{'c'}{'c_num'} = $cmd_num; |
1125
|
478
|
100
|
|
|
|
1314
|
$$self{'c'}{'f_num'} = ($cmd_num > 200 ? 201 : $cmd_num); |
1126
|
478
|
|
|
|
|
1709
|
$$self{'c'}{'c_label'} = $$self{'cmd'}{$cmd_num}{'label'}; |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
$$self{'c'}{'c_retries'} = ($$self{'cmd'}{$cmd_num}{'retry'} |
1129
|
478
|
100
|
|
|
|
1645
|
? $$self{'cmd'}{$cmd_num}{'retry'}+0 |
1130
|
|
|
|
|
|
|
: 0); |
1131
|
|
|
|
|
|
|
$$self{'c'}{'c_sleep'} = ($$self{'cmd'}{$cmd_num}{'sleep'} |
1132
|
478
|
100
|
|
|
|
1344
|
? $$self{'cmd'}{$cmd_num}{'sleep'}+0 |
1133
|
|
|
|
|
|
|
: 0); |
1134
|
|
|
|
|
|
|
$$self{'c'}{'c_redir'} = (($$self{'cmd'}{$cmd_num}{'noredir'} || |
1135
|
|
|
|
|
|
|
$simple || |
1136
|
|
|
|
|
|
|
! $$self{'g'}{'redir'}) |
1137
|
|
|
|
|
|
|
? '' |
1138
|
478
|
100
|
100
|
|
|
3771
|
: ' ' . $$self{'g'}{'redir'} ); |
1139
|
|
|
|
|
|
|
$$self{'c'}{'c_check'} = ($$self{'cmd'}{$cmd_num}{'check'} |
1140
|
478
|
100
|
|
|
|
1451
|
? $$self{'cmd'}{$cmd_num}{'check'} |
1141
|
|
|
|
|
|
|
: ''); |
1142
|
478
|
|
|
|
|
1384
|
$$self{'c'}{'c_check_q'} = $self->_quote($$self{'c'}{'c_check'}); |
1143
|
|
|
|
|
|
|
$$self{'c'}{'c_dir'} = ($$self{'cmd'}{$cmd_num}{'dire'} |
1144
|
478
|
100
|
|
|
|
1305
|
? $self->_quote($$self{'cmd'}{$cmd_num}{'dire'}) |
1145
|
|
|
|
|
|
|
: ''); |
1146
|
|
|
|
|
|
|
|
1147
|
478
|
100
|
|
|
|
1265
|
$$self{'c'}{'c_retries'} = 0 if ($$self{'c'}{'c_retries'} == 1); |
1148
|
|
|
|
|
|
|
|
1149
|
478
|
|
|
|
|
1040
|
$$self{'c'}{'ind'} = $$self{'g'}{'curr_ind'}; |
1150
|
478
|
100
|
|
|
|
1067
|
$$self{'c'}{'simp'} = $$self{'g'}{'simple'} if ($simple); |
1151
|
|
|
|
|
|
|
|
1152
|
478
|
100
|
|
|
|
1403
|
$$self{'c'}{'c_flow'} = ($$self{'cmd'}{$cmd_num}{'flow'} ? 1 : 0); |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
# Handle the cases of a command with no alternates and init stuff |
1155
|
|
|
|
|
|
|
|
1156
|
478
|
|
|
|
|
722
|
my $n = @{ $$self{'cmd'}{$cmd_num}{'cmd'} }; |
|
478
|
|
|
|
|
982
|
|
1157
|
|
|
|
|
|
|
|
1158
|
478
|
100
|
|
|
|
1271
|
if ($n == 1) { |
1159
|
|
|
|
|
|
|
# |
1160
|
|
|
|
|
|
|
# A command with no alternates. |
1161
|
|
|
|
|
|
|
# |
1162
|
|
|
|
|
|
|
|
1163
|
469
|
|
|
|
|
855
|
my $label = $$self{'c'}{'c_label'}; |
1164
|
469
|
|
|
|
|
1076
|
$$self{'c'}{'cmd_str'} = $$self{'cmd'}{$cmd_num}{'cmd'}[0]; |
1165
|
469
|
|
|
|
|
1073
|
$$self{'c'}{'cmd_str_q'} = $self->_quote($$self{'c'}{'cmd_str'}); |
1166
|
469
|
100
|
|
|
|
1706
|
$$self{'c'}{'cmd_label'} = $cmd_num . ($label ? " [$label]" : ''); |
1167
|
469
|
|
|
|
|
1224
|
$$self{'c'}{'alt_label'} = "$cmd_num.0"; |
1168
|
469
|
|
|
|
|
829
|
$$self{'c'}{'alts'} = 0; |
1169
|
469
|
|
|
|
|
1059
|
$$self{'c'}{'a_num'} = 0; |
1170
|
|
|
|
|
|
|
} |
1171
|
|
|
|
|
|
|
} |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
############################################################################### |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
# Text to script |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
sub _text_to_script { |
1178
|
3429
|
|
|
3429
|
|
5764
|
my($self,$text) = @_; |
1179
|
3429
|
|
|
|
|
4648
|
my @script; |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
# Text is a combination of: |
1182
|
|
|
|
|
|
|
# : CMD |
1183
|
|
|
|
|
|
|
# : CMD |
1184
|
|
|
|
|
|
|
# : CMD |
1185
|
|
|
|
|
|
|
# : CMD |
1186
|
|
|
|
|
|
|
# : CMD |
1187
|
|
|
|
|
|
|
# |
1188
|
|
|
|
|
|
|
# means to include this line only if the given TAG has a value |
1189
|
|
|
|
|
|
|
# of 'VAL'. The TAG can be either of: |
1190
|
|
|
|
|
|
|
# $$self{'c'}{TAG} |
1191
|
|
|
|
|
|
|
# $$self{'g'}{TAG} |
1192
|
|
|
|
|
|
|
# means to include this line only if the given TAG does NOT |
1193
|
|
|
|
|
|
|
# have a value of 'VAL' |
1194
|
|
|
|
|
|
|
# means to include this line only if the TAG has a true value |
1195
|
|
|
|
|
|
|
# means to include this line only if the TAG has a false value |
1196
|
|
|
|
|
|
|
# CMD can include indentation relative to the current text |
1197
|
|
|
|
|
|
|
# CMD can include and it will be replaced by the |
1198
|
|
|
|
|
|
|
# value of TAG |
1199
|
|
|
|
|
|
|
# |
1200
|
|
|
|
|
|
|
# Every line must contain a colon, and the colon defines the start of |
1201
|
|
|
|
|
|
|
# the actual line (so spacing to the right of the colon is used to |
1202
|
|
|
|
|
|
|
# determine indentation). |
1203
|
|
|
|
|
|
|
|
1204
|
3429
|
|
|
|
|
16504
|
my @lines = split(/\n/,$text); |
1205
|
3429
|
|
|
|
|
5049
|
my $line_ind = ''; |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
LINE: |
1208
|
3429
|
|
|
|
|
5644
|
foreach my $line (@lines) { |
1209
|
37784
|
|
|
|
|
145607
|
$line =~ /(.*?)\s*:(\s*)(.*)$/; |
1210
|
37784
|
|
|
|
|
98108
|
my($tags,$ind,$cmd) = ($1,$2,$3); |
1211
|
|
|
|
|
|
|
|
1212
|
37784
|
|
|
|
|
126981
|
while ($tags =~ s,^<(!?)(.*?)>,,) { |
1213
|
38257
|
|
|
|
|
86885
|
my ($not,$tagstr) = ($1,$2); |
1214
|
38257
|
100
|
|
|
|
80023
|
if ($tagstr =~ /^(.*?)=(.*)$/) { |
1215
|
12064
|
|
|
|
|
25299
|
my($tag,$req) = ($1,$2); |
1216
|
12064
|
100
|
|
|
|
21121
|
if ($self->_tagval($tag) eq $req) { |
1217
|
731
|
100
|
|
|
|
2633
|
next LINE if ($not); |
1218
|
|
|
|
|
|
|
} else { |
1219
|
11333
|
100
|
|
|
|
27345
|
next LINE if (! $not); |
1220
|
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
} else { |
1223
|
26193
|
|
|
|
|
33316
|
my $tag = $tagstr; |
1224
|
26193
|
100
|
|
|
|
40628
|
if ($self->_tagval($tag)) { |
1225
|
1168
|
100
|
|
|
|
3242
|
next LINE if ($not); |
1226
|
|
|
|
|
|
|
} else { |
1227
|
25025
|
100
|
|
|
|
72813
|
next LINE if (! $not); |
1228
|
|
|
|
|
|
|
} |
1229
|
|
|
|
|
|
|
} |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
|
1232
|
14691
|
|
|
|
|
29658
|
while ($cmd =~ /<\?(.*?)\?>/) { |
1233
|
2582
|
|
|
|
|
5121
|
my $tag = $1; |
1234
|
2582
|
|
|
|
|
4516
|
my $val = $self->_tagval($tag); |
1235
|
2582
|
|
|
|
|
40764
|
$cmd =~ s/<\?$tag\?>/$val/g; |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
|
1238
|
14691
|
100
|
|
|
|
24364
|
if (! $cmd) { |
1239
|
2903
|
|
|
|
|
4986
|
push(@script,''); |
1240
|
2903
|
|
|
|
|
4927
|
next; |
1241
|
|
|
|
|
|
|
} |
1242
|
|
|
|
|
|
|
|
1243
|
11788
|
|
|
|
|
15728
|
my $len = length($ind); |
1244
|
11788
|
100
|
|
|
|
20138
|
$line_ind = $len if ($line_ind eq ''); |
1245
|
|
|
|
|
|
|
|
1246
|
11788
|
100
|
|
|
|
22908
|
if ($len > $line_ind) { |
|
|
100
|
|
|
|
|
|
1247
|
2308
|
|
|
|
|
5226
|
$self->_ind_plus(); |
1248
|
2308
|
|
|
|
|
3213
|
$line_ind = $len; |
1249
|
|
|
|
|
|
|
} elsif ($len < $line_ind) { |
1250
|
2326
|
|
|
|
|
4946
|
$self->_ind_minus(); |
1251
|
2326
|
|
|
|
|
3113
|
$line_ind = $len; |
1252
|
|
|
|
|
|
|
} |
1253
|
11788
|
|
|
|
|
17474
|
my $spc = $$self{'g'}{'curr_ind'}; |
1254
|
11788
|
|
|
|
|
30335
|
push(@script,"${spc}$cmd"); |
1255
|
|
|
|
|
|
|
} |
1256
|
|
|
|
|
|
|
|
1257
|
3429
|
|
|
|
|
4584
|
push @{ $$self{'scr'} },@script; |
|
3429
|
|
|
|
|
16055
|
|
1258
|
|
|
|
|
|
|
} |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
sub _tagval { |
1261
|
40839
|
|
|
40839
|
|
59253
|
my($self,$tag) = @_; |
1262
|
|
|
|
|
|
|
|
1263
|
40839
|
|
|
|
|
46462
|
my $val; |
1264
|
40839
|
100
|
|
|
|
78029
|
if (exists $$self{'c'}{$tag}) { |
|
|
100
|
|
|
|
|
|
1265
|
22364
|
|
|
|
|
31158
|
$val = $$self{'c'}{$tag}; |
1266
|
|
|
|
|
|
|
} elsif (exists $$self{'g'}{$tag}) { |
1267
|
12651
|
|
|
|
|
18028
|
$val = $$self{'g'}{$tag}; |
1268
|
|
|
|
|
|
|
} |
1269
|
|
|
|
|
|
|
|
1270
|
40839
|
100
|
|
|
|
66831
|
$val = '' if (! defined($val)); |
1271
|
40839
|
|
|
|
|
78545
|
return $val; |
1272
|
|
|
|
|
|
|
} |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
##################### |
1275
|
|
|
|
|
|
|
# Script indentation |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
sub _ind { |
1278
|
4889
|
|
|
4889
|
|
6701
|
my($self) = @_; |
1279
|
|
|
|
|
|
|
$$self{'g'}{'curr_ind'} = |
1280
|
4889
|
|
|
|
|
10678
|
" "x($$self{'g'}{'ind_per_lev'} * $$self{'g'}{'ind_cur_lev'}); |
1281
|
|
|
|
|
|
|
$$self{'g'}{'next_ind'} = |
1282
|
4889
|
|
|
|
|
9074
|
" "x($$self{'g'}{'ind_per_lev'} * ($$self{'g'}{'ind_cur_lev'} + 1)); |
1283
|
|
|
|
|
|
|
$$self{'g'}{'prev_ind'} = |
1284
|
|
|
|
|
|
|
" "x($$self{'g'}{'ind_cur_lev'} == 0 |
1285
|
|
|
|
|
|
|
? 0 |
1286
|
4889
|
100
|
|
|
|
12501
|
: $$self{'g'}{'ind_per_lev'} * ($$self{'g'}{'ind_cur_lev'} - 1)); |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
sub _ind_0 { |
1290
|
69
|
|
|
69
|
|
248
|
my($self) = @_; |
1291
|
69
|
|
|
|
|
240
|
$$self{'g'}{'ind_cur_lev'} = 0; |
1292
|
69
|
|
|
|
|
460
|
$self->_ind(); |
1293
|
|
|
|
|
|
|
} |
1294
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
sub _ind_plus { |
1296
|
2410
|
|
|
2410
|
|
3787
|
my($self) = @_; |
1297
|
2410
|
|
|
|
|
3503
|
$$self{'g'}{'ind_cur_lev'}++; |
1298
|
2410
|
|
|
|
|
4024
|
$self->_ind(); |
1299
|
|
|
|
|
|
|
} |
1300
|
|
|
|
|
|
|
sub _ind_minus { |
1301
|
2410
|
|
|
2410
|
|
3452
|
my($self) = @_; |
1302
|
2410
|
|
|
|
|
3496
|
$$self{'g'}{'ind_cur_lev'}--; |
1303
|
2410
|
|
|
|
|
3844
|
$self->_ind(); |
1304
|
|
|
|
|
|
|
} |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
############################################################################### |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
sub _err { |
1309
|
13
|
|
|
13
|
|
38
|
my($self,$text) = @_; |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
# uncoverable branch false |
1312
|
13
|
100
|
|
|
|
43
|
if ($ENV{'SHELL_CMD_TESTING'}) { |
1313
|
8
|
|
|
|
|
15
|
return; |
1314
|
|
|
|
|
|
|
} |
1315
|
|
|
|
|
|
|
|
1316
|
5
|
|
|
|
|
132
|
print STDERR "# ERROR: ${text}\n"; |
1317
|
5
|
|
|
|
|
19
|
return; |
1318
|
|
|
|
|
|
|
} |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
# This prepares a string to be enclosed in double quotes. |
1321
|
|
|
|
|
|
|
# |
1322
|
|
|
|
|
|
|
# Escape: \ $ ` " |
1323
|
|
|
|
|
|
|
# |
1324
|
|
|
|
|
|
|
sub _quote { |
1325
|
1029
|
|
|
1029
|
|
1881
|
my($self,$string) = @_; |
1326
|
|
|
|
|
|
|
|
1327
|
1029
|
|
|
|
|
2398
|
$string =~ s/([\\\$`"])/\\$1/g; |
1328
|
1029
|
|
|
|
|
2274
|
return $string; |
1329
|
|
|
|
|
|
|
} |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
############################################################################### |
1332
|
|
|
|
|
|
|
# The stdout/stderr from a script-mode run are each of the form: |
1333
|
|
|
|
|
|
|
# #SC CMD N1.A1 |
1334
|
|
|
|
|
|
|
# ... |
1335
|
|
|
|
|
|
|
# #SC CMD N2.A2 |
1336
|
|
|
|
|
|
|
# ... |
1337
|
|
|
|
|
|
|
# where N* are the command number and A* are the alternate number. |
1338
|
|
|
|
|
|
|
# |
1339
|
|
|
|
|
|
|
# Retries are noted with: |
1340
|
|
|
|
|
|
|
# #SC TRY T |
1341
|
|
|
|
|
|
|
# |
1342
|
|
|
|
|
|
|
# If the script fails, for the failing command, it includes: |
1343
|
|
|
|
|
|
|
# #SC EXIT N1.A1 EXIT_VALUE |
1344
|
|
|
|
|
|
|
# |
1345
|
|
|
|
|
|
|
# STDOUT and STDERR are guaranteed to be identical in form (provided both |
1346
|
|
|
|
|
|
|
# are kept). |
1347
|
|
|
|
|
|
|
# |
1348
|
|
|
|
|
|
|
sub _script_output { |
1349
|
13
|
|
|
13
|
|
113
|
my($self,$out) = @_; |
1350
|
13
|
|
|
|
|
155
|
my @out = split(/\n/,$out); |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
# |
1353
|
|
|
|
|
|
|
# Parse stdout and turn it into: |
1354
|
|
|
|
|
|
|
# |
1355
|
|
|
|
|
|
|
# ( [ CMD_NUM_1, ALT_NUM_1, TRY_1, EXIT_1, STDOUT_1 ], |
1356
|
|
|
|
|
|
|
# [ CMD_NUM_2, ALT_NUM_2, TRY_2, EXIT_2, STDOUT_2 ], ... ) |
1357
|
|
|
|
|
|
|
# |
1358
|
|
|
|
|
|
|
|
1359
|
13
|
|
|
|
|
78
|
my @cmd_raw; |
1360
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
PARSE_LOOP: |
1362
|
13
|
|
|
|
|
87
|
while (@out) { |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
# |
1365
|
|
|
|
|
|
|
# Get STDOUT (or STDERR) for the one command. |
1366
|
|
|
|
|
|
|
# |
1367
|
|
|
|
|
|
|
|
1368
|
50
|
|
|
|
|
181
|
my($cmd_num,$alt_num,$cmd_exit,$cmd_try,$tmp); |
1369
|
50
|
|
|
|
|
0
|
my($out_hdr,@output); |
1370
|
50
|
|
|
|
|
112
|
$cmd_exit = 0; |
1371
|
50
|
|
|
|
|
96
|
$cmd_try = 0; |
1372
|
|
|
|
|
|
|
|
1373
|
50
|
|
|
|
|
124
|
$out_hdr = shift(@out); |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
# The output MUST start with a header: |
1376
|
|
|
|
|
|
|
# #SC CMD X.Y |
1377
|
|
|
|
|
|
|
# |
1378
|
|
|
|
|
|
|
# uncoverable branch true |
1379
|
50
|
50
|
|
|
|
396
|
if ($out_hdr !~ /^\#SC CMD (\d+)\.(\d+)$/) { |
1380
|
|
|
|
|
|
|
# Invalid output... should never happen |
1381
|
|
|
|
|
|
|
# uncoverable statement |
1382
|
0
|
|
|
|
|
0
|
$self->_err("Missing command header in STDOUT: $out_hdr"); |
1383
|
|
|
|
|
|
|
# uncoverable statement |
1384
|
0
|
|
|
|
|
0
|
return (); |
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
|
1387
|
50
|
|
|
|
|
275
|
($cmd_num,$alt_num) = ($1,$2); |
1388
|
|
|
|
|
|
|
|
1389
|
50
|
|
100
|
|
|
326
|
while (@out && $out[0] !~ /^\#SC CMD (\d+)\.(\d+)$/) { |
1390
|
114
|
100
|
|
|
|
1121
|
if ($out[0] =~ /^\#SC TRY (\d+)$/) { |
|
|
100
|
|
|
|
|
|
1391
|
20
|
|
|
|
|
52
|
$cmd_try = $1; |
1392
|
20
|
|
|
|
|
64
|
shift(@out); |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
} elsif ($out[0] =~ /^\#SC EXIT $cmd_num\.$alt_num (\d+)$/) { |
1395
|
20
|
|
|
|
|
48
|
$cmd_exit = $1; |
1396
|
20
|
|
|
|
|
99
|
shift(@out); |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
} else { |
1399
|
74
|
|
|
|
|
410
|
push(@output,shift(@out)); |
1400
|
|
|
|
|
|
|
} |
1401
|
|
|
|
|
|
|
} |
1402
|
|
|
|
|
|
|
|
1403
|
50
|
100
|
100
|
|
|
291
|
pop(@output) if (! defined($output[$#output]) || $output[$#output] eq ''); |
1404
|
50
|
|
|
|
|
362
|
push (@cmd_raw, [ $cmd_num,$alt_num,$cmd_try,$cmd_exit,\@output ]); |
1405
|
|
|
|
|
|
|
} |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
# |
1408
|
|
|
|
|
|
|
# Now go through this list and group all alternates together and determine |
1409
|
|
|
|
|
|
|
# the status for each command. |
1410
|
|
|
|
|
|
|
# |
1411
|
|
|
|
|
|
|
# This will now look like: |
1412
|
|
|
|
|
|
|
# ( CMD_1 CMD_2 ... ) |
1413
|
|
|
|
|
|
|
# where |
1414
|
|
|
|
|
|
|
# CMD_i = [ CMD_NUM EXIT TRY_1 TRY_2 ... ] |
1415
|
|
|
|
|
|
|
# CMD_NUM is the command number being executed |
1416
|
|
|
|
|
|
|
# EXIT is the exit code produced by this command |
1417
|
|
|
|
|
|
|
# TRY_i is the i'th retry (there will only be one if |
1418
|
|
|
|
|
|
|
# the command does not have retries |
1419
|
|
|
|
|
|
|
# |
1420
|
|
|
|
|
|
|
# TRY_i = [ ALT_1 ALT_2 ... ] |
1421
|
|
|
|
|
|
|
# ALT_i = [ LINE1 LINE2 ... ] the output |
1422
|
|
|
|
|
|
|
# |
1423
|
|
|
|
|
|
|
# The exit code is the one produced by the very first alternate in the first |
1424
|
|
|
|
|
|
|
# try. |
1425
|
|
|
|
|
|
|
# |
1426
|
|
|
|
|
|
|
# When looking at a command (I), we have to take into account the following |
1427
|
|
|
|
|
|
|
# command (J = I+1). |
1428
|
|
|
|
|
|
|
# |
1429
|
|
|
|
|
|
|
# I J |
1430
|
|
|
|
|
|
|
# CMD ALT TRY CMD ALT TRY |
1431
|
|
|
|
|
|
|
# |
1432
|
|
|
|
|
|
|
# * * * * 0/1 0 The next command is from a totally new |
1433
|
|
|
|
|
|
|
# command, so the current command concludes |
1434
|
|
|
|
|
|
|
# a retry and a command. |
1435
|
|
|
|
|
|
|
# |
1436
|
|
|
|
|
|
|
# C A T C A+1 T The next command is another alternate. |
1437
|
|
|
|
|
|
|
# Add it to the current retry. |
1438
|
|
|
|
|
|
|
# |
1439
|
|
|
|
|
|
|
# C A T C 0/1 T+1 The next command starts another retry, |
1440
|
|
|
|
|
|
|
# so the current command concludes a |
1441
|
|
|
|
|
|
|
# retry, but NOT a command. |
1442
|
|
|
|
|
|
|
# |
1443
|
|
|
|
|
|
|
# Everthing else is an error |
1444
|
|
|
|
|
|
|
# |
1445
|
|
|
|
|
|
|
|
1446
|
13
|
|
|
|
|
42
|
my @cmds = (); # @cmds = ( CMD_1 CMD_2 ... ) |
1447
|
13
|
|
|
|
|
42
|
my @cmd = (); # @cmd = ( TRY_1 TRY_2 ... ) |
1448
|
13
|
|
|
|
|
47
|
my @try = (); # @try = ( ALT_1 ALT_2 ... ) |
1449
|
13
|
|
|
|
|
37
|
my $alt; # $alt = [ LINE_1 LINE_2 ... ] |
1450
|
13
|
|
|
|
|
35
|
my $cmd_curr = 0; |
1451
|
13
|
|
|
|
|
34
|
my $alt_curr = 0; |
1452
|
13
|
|
|
|
|
38
|
my $try_curr = 0; |
1453
|
13
|
|
|
|
|
28
|
my $cmd_next = 0; |
1454
|
13
|
|
|
|
|
40
|
my $alt_next = 0; |
1455
|
13
|
|
|
|
|
27
|
my $try_next = 0; |
1456
|
13
|
|
|
|
|
25
|
my $exit_curr = 0; |
1457
|
13
|
|
|
|
|
48
|
my $exit_next = 0; |
1458
|
13
|
|
|
|
|
51
|
my $i = 0; |
1459
|
|
|
|
|
|
|
|
1460
|
13
|
|
|
|
|
37
|
($cmd_curr,$alt_curr,$try_curr,$exit_curr,$alt) = @{ shift(@cmd_raw) }; |
|
13
|
|
|
|
|
50
|
|
1461
|
13
|
|
|
|
|
52
|
push(@try,$alt); |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
COMMAND_LOOP: |
1464
|
13
|
|
|
|
|
75
|
while (@cmd_raw) { |
1465
|
37
|
|
|
|
|
74
|
$i++; |
1466
|
|
|
|
|
|
|
|
1467
|
37
|
|
|
|
|
58
|
($cmd_next,$alt_next,$try_next,$exit_next,$alt) = @{ shift(@cmd_raw) }; |
|
37
|
|
|
|
|
91
|
|
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
VALID_CONDITIONS: { |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
## ALT_NEXT = 0/1 and |
1472
|
|
|
|
|
|
|
## TRY_NEXT = 0 |
1473
|
|
|
|
|
|
|
## next command |
1474
|
|
|
|
|
|
|
## |
1475
|
|
|
|
|
|
|
## All valid CMD_NEXT != CMD_CURR entries will be covered here. |
1476
|
|
|
|
|
|
|
|
1477
|
37
|
100
|
100
|
|
|
79
|
if ($alt_next <= 1 && |
|
37
|
|
|
|
|
222
|
|
1478
|
|
|
|
|
|
|
$try_next == 0) { |
1479
|
|
|
|
|
|
|
|
1480
|
21
|
|
|
|
|
71
|
push(@cmd,[@try]); |
1481
|
21
|
|
|
|
|
68
|
push(@cmds,[$cmd_curr,$exit_curr,@cmd]); |
1482
|
21
|
|
|
|
|
49
|
@cmd = (); |
1483
|
21
|
|
|
|
|
45
|
@try = ($alt); |
1484
|
21
|
|
|
|
|
35
|
$cmd_curr = $cmd_next; |
1485
|
21
|
|
|
|
|
33
|
$alt_curr = $alt_next; |
1486
|
21
|
|
|
|
|
37
|
$try_curr = $try_next; |
1487
|
21
|
|
|
|
|
41
|
$exit_curr= $exit_next; |
1488
|
21
|
|
|
|
|
120
|
next COMMAND_LOOP; |
1489
|
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
# uncoverable branch true |
1492
|
16
|
50
|
|
|
|
37
|
if ($cmd_next != $cmd_curr) { |
1493
|
|
|
|
|
|
|
# uncoverable statement |
1494
|
0
|
|
|
|
|
0
|
last VALID_CONDITIONS; |
1495
|
|
|
|
|
|
|
} |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
## ALT_NEXT = ALT_CURR+1 |
1498
|
|
|
|
|
|
|
## next alternate |
1499
|
|
|
|
|
|
|
## |
1500
|
|
|
|
|
|
|
## All valid entries will have TRY_NEXT = TRY_CURR |
1501
|
|
|
|
|
|
|
|
1502
|
16
|
100
|
|
|
|
43
|
if ($alt_next == $alt_curr+1) { |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
# uncoverable branch true |
1505
|
8
|
50
|
|
|
|
18
|
if ($try_next != $try_curr) { |
1506
|
|
|
|
|
|
|
# uncoverable statement |
1507
|
0
|
|
|
|
|
0
|
last VALID_CONDITIONS; |
1508
|
|
|
|
|
|
|
} |
1509
|
|
|
|
|
|
|
|
1510
|
8
|
|
|
|
|
13
|
push(@try,$alt); |
1511
|
8
|
|
|
|
|
12
|
$alt_curr = $alt_next; |
1512
|
8
|
|
|
|
|
10
|
$exit_curr= $exit_next; |
1513
|
8
|
|
|
|
|
14
|
next COMMAND_LOOP; |
1514
|
|
|
|
|
|
|
} |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
## ALT_NEXT = 0/1 and |
1517
|
|
|
|
|
|
|
## TRY_NEXT = TRY_CURR+1 |
1518
|
|
|
|
|
|
|
## next try |
1519
|
|
|
|
|
|
|
## |
1520
|
|
|
|
|
|
|
## Everything left must have both of these conditions. |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
# uncoverable branch true |
1523
|
8
|
50
|
|
|
|
15
|
if ($alt_next > 1) { |
1524
|
|
|
|
|
|
|
# uncoverable statement |
1525
|
0
|
|
|
|
|
0
|
last VALID_CONDITIONS; |
1526
|
|
|
|
|
|
|
} |
1527
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
# uncoverable branch true |
1529
|
8
|
50
|
|
|
|
19
|
if ($try_next != $try_curr+1) { |
1530
|
|
|
|
|
|
|
# uncoverable statement |
1531
|
0
|
|
|
|
|
0
|
last VALID_CONDITIONS; |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
|
1534
|
8
|
|
|
|
|
26
|
push(@cmd,[@try]); |
1535
|
8
|
|
|
|
|
19
|
@try = ($alt); |
1536
|
8
|
|
|
|
|
12
|
$alt_curr = $alt_next; |
1537
|
8
|
|
|
|
|
12
|
$try_curr = $try_next; |
1538
|
8
|
|
|
|
|
11
|
$exit_curr= $exit_next; |
1539
|
8
|
|
|
|
|
17
|
next COMMAND_LOOP; |
1540
|
|
|
|
|
|
|
} |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
# |
1543
|
|
|
|
|
|
|
# Everything else is an error in the output (should never happen) |
1544
|
|
|
|
|
|
|
# |
1545
|
|
|
|
|
|
|
|
1546
|
|
|
|
|
|
|
# uncoverable statement |
1547
|
0
|
|
|
|
|
0
|
$self->_err("Unexpected error in output: $i " . |
1548
|
|
|
|
|
|
|
"[$cmd_curr,$alt_curr,$try_curr] " . |
1549
|
|
|
|
|
|
|
"[$cmd_next,$alt_next,$try_next]"); |
1550
|
|
|
|
|
|
|
# uncoverable statement |
1551
|
0
|
|
|
|
|
0
|
return (); |
1552
|
|
|
|
|
|
|
} |
1553
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
# |
1555
|
|
|
|
|
|
|
# Add on the last command is stored. |
1556
|
|
|
|
|
|
|
# |
1557
|
|
|
|
|
|
|
|
1558
|
13
|
|
|
|
|
49
|
push(@cmd,[@try]); |
1559
|
13
|
|
|
|
|
46
|
push(@cmds,[$cmd_curr,$exit_curr,@cmd]); |
1560
|
|
|
|
|
|
|
|
1561
|
13
|
|
|
|
|
167
|
return [@cmds]; |
1562
|
|
|
|
|
|
|
} |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
############################################################################### |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
sub ssh { |
1567
|
0
|
|
|
0
|
1
|
0
|
my($self,@hosts) = @_; |
1568
|
|
|
|
|
|
|
|
1569
|
0
|
0
|
|
|
|
0
|
if (! @hosts) { |
1570
|
0
|
|
|
|
|
0
|
$self->_err("A host or hosts must be supplied with the ssh method"); |
1571
|
0
|
|
|
|
|
0
|
return; |
1572
|
|
|
|
|
|
|
} |
1573
|
|
|
|
|
|
|
|
1574
|
0
|
0
|
|
|
|
0
|
if ($self->_cmd_valid_script()) { |
1575
|
0
|
|
|
|
|
0
|
$self->_err("script flow commands not closed correctly"); |
1576
|
0
|
|
|
|
|
0
|
return; |
1577
|
|
|
|
|
|
|
} |
1578
|
0
|
|
|
|
|
0
|
$self->_script(); |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
# |
1581
|
|
|
|
|
|
|
# Return the script if this is a dry run. |
1582
|
|
|
|
|
|
|
# |
1583
|
|
|
|
|
|
|
|
1584
|
0
|
|
|
|
|
0
|
my $script = join("\n",@{ $$self{'scr'} }); |
|
0
|
|
|
|
|
0
|
|
1585
|
0
|
0
|
|
|
|
0
|
return $script if ($$self{'g'}{'mode'} eq 'dry-run'); |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
# |
1588
|
|
|
|
|
|
|
# Create the temporary script |
1589
|
|
|
|
|
|
|
# |
1590
|
|
|
|
|
|
|
|
1591
|
0
|
|
|
|
|
0
|
my $tmp_script = $$self{'g'}{'tmp_script'}; |
1592
|
0
|
0
|
|
|
|
0
|
if (! $tmp_script) { |
1593
|
0
|
|
|
|
|
0
|
$self->_err("tmp_script option must be set"); |
1594
|
0
|
|
|
|
|
0
|
return 254; |
1595
|
|
|
|
|
|
|
} |
1596
|
|
|
|
|
|
|
|
1597
|
0
|
|
|
|
|
0
|
my $out = new IO::File; |
1598
|
|
|
|
|
|
|
|
1599
|
0
|
0
|
|
|
|
0
|
if ($out->open("> $tmp_script")) { |
1600
|
0
|
|
|
|
|
0
|
print $out $script; |
1601
|
0
|
|
|
|
|
0
|
$out->close(); |
1602
|
|
|
|
|
|
|
} else { |
1603
|
0
|
|
|
|
|
0
|
$self->_err("tmp_script not writable"); |
1604
|
0
|
|
|
|
|
0
|
return 254; |
1605
|
|
|
|
|
|
|
} |
1606
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
# |
1608
|
|
|
|
|
|
|
# Run the script |
1609
|
|
|
|
|
|
|
# |
1610
|
|
|
|
|
|
|
|
1611
|
0
|
|
|
|
|
0
|
my %ret; |
1612
|
0
|
0
|
|
|
|
0
|
if ($$self{'g'}{'ssh_num'} == 1) { |
1613
|
0
|
|
|
|
|
0
|
%ret = $self->_ssh_serial(@hosts); |
1614
|
|
|
|
|
|
|
} else { |
1615
|
0
|
|
|
|
|
0
|
%ret = $self->_ssh_parallel(@hosts); |
1616
|
|
|
|
|
|
|
} |
1617
|
|
|
|
|
|
|
|
1618
|
0
|
0
|
|
|
|
0
|
if (! $$self{'g'}{'tmp_script_keep'}) { |
1619
|
0
|
|
|
|
|
0
|
unlink($tmp_script); |
1620
|
|
|
|
|
|
|
} |
1621
|
|
|
|
|
|
|
|
1622
|
0
|
|
|
|
|
0
|
return %ret; |
1623
|
|
|
|
|
|
|
} |
1624
|
|
|
|
|
|
|
|
1625
|
|
|
|
|
|
|
sub _ssh_serial { |
1626
|
0
|
|
|
0
|
|
0
|
my($self,@hosts) = @_; |
1627
|
0
|
|
|
|
|
0
|
my %ret; |
1628
|
|
|
|
|
|
|
|
1629
|
0
|
|
|
|
|
0
|
foreach my $host (@hosts) { |
1630
|
0
|
|
|
|
|
0
|
$ret{$host} = $self->_ssh($host); |
1631
|
|
|
|
|
|
|
} |
1632
|
|
|
|
|
|
|
|
1633
|
0
|
|
|
|
|
0
|
return %ret; |
1634
|
|
|
|
|
|
|
} |
1635
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
sub _ssh_parallel { |
1637
|
0
|
|
|
0
|
|
0
|
my($self,@hosts) = @_; |
1638
|
0
|
|
|
|
|
0
|
my %ret; |
1639
|
|
|
|
|
|
|
|
1640
|
0
|
0
|
|
|
|
0
|
my $max_proc = ($$self{'g'}{'ssh_num'} ? $$self{'g'}{'ssh_num'} : @hosts); |
1641
|
0
|
|
|
|
|
0
|
my $manager = Parallel::ForkManager->new($max_proc); |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
$manager->run_on_finish |
1644
|
|
|
|
|
|
|
( |
1645
|
|
|
|
|
|
|
sub { |
1646
|
0
|
|
|
0
|
|
0
|
my($pid,$exit_code,$id,$signal,$core_dump,$data) = @_; |
1647
|
0
|
|
|
|
|
0
|
my($host,$exit,$stdout,$stderr) = @$data; |
1648
|
0
|
|
|
|
|
0
|
$ret{$host} = $exit; |
1649
|
0
|
0
|
|
|
|
0
|
$$self{'s'}{$host}{'out'} = $self->_script_output($stdout) |
1650
|
|
|
|
|
|
|
if (defined $stdout); |
1651
|
0
|
0
|
|
|
|
0
|
$$self{'s'}{$host}{'err'} = $self->_script_output($stderr) |
1652
|
|
|
|
|
|
|
if (defined $stderr); |
1653
|
0
|
|
|
|
|
0
|
$$self{'s'}{$host}{'exit'} = $exit; |
1654
|
|
|
|
|
|
|
} |
1655
|
0
|
|
|
|
|
0
|
); |
1656
|
|
|
|
|
|
|
|
1657
|
0
|
|
|
|
|
0
|
foreach my $host (@hosts) { |
1658
|
0
|
0
|
|
|
|
0
|
$manager->start and next; |
1659
|
|
|
|
|
|
|
|
1660
|
0
|
|
|
|
|
0
|
my @r = ($host,$self->_ssh($host)); |
1661
|
|
|
|
|
|
|
|
1662
|
0
|
|
|
|
|
0
|
$manager->finish(0,\@r); |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
|
1665
|
0
|
|
|
|
|
0
|
$manager->wait_all_children(); |
1666
|
0
|
|
|
|
|
0
|
return %ret; |
1667
|
|
|
|
|
|
|
} |
1668
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
sub _ssh { |
1670
|
0
|
|
|
0
|
|
0
|
my($self,$host) = @_; |
1671
|
|
|
|
|
|
|
|
1672
|
0
|
|
|
|
|
0
|
my $ssh = Net::OpenSSH->new($host, %{ $$self{'g'}{'ssh_opts'} }); |
|
0
|
|
|
|
|
0
|
|
1673
|
|
|
|
|
|
|
|
1674
|
0
|
|
|
|
|
0
|
my $script_loc = $$self{'g'}{'tmp_script'}; |
1675
|
0
|
|
0
|
|
|
0
|
my $script_rem = $$self{'g'}{'ssh_script'} || $script_loc; |
1676
|
0
|
0
|
|
|
|
0
|
$ssh->scp_put($script_loc,$script_rem) or return 253; |
1677
|
|
|
|
|
|
|
|
1678
|
|
|
|
|
|
|
# |
1679
|
|
|
|
|
|
|
# If we're sleeping, do so. |
1680
|
|
|
|
|
|
|
# |
1681
|
|
|
|
|
|
|
|
1682
|
0
|
0
|
|
|
|
0
|
if ($$self{'g'}{'ssh_sleep'}) { |
1683
|
0
|
|
|
|
|
0
|
my $n = $$self{'g'}{'ssh_sleep'}; |
1684
|
0
|
0
|
|
|
|
0
|
if ($n < 0) { |
1685
|
0
|
|
|
|
|
0
|
sleep(-$n); |
1686
|
|
|
|
|
|
|
} else { |
1687
|
0
|
|
|
|
|
0
|
sleep(int(rand($$self{'g'}{'ssh_sleep'}))); |
1688
|
|
|
|
|
|
|
} |
1689
|
|
|
|
|
|
|
} |
1690
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
# |
1692
|
|
|
|
|
|
|
# If it's running in real-time, do so. |
1693
|
|
|
|
|
|
|
# |
1694
|
|
|
|
|
|
|
|
1695
|
0
|
0
|
|
|
|
0
|
if ($$self{'g'}{'mode'} eq 'run') { |
1696
|
0
|
|
|
|
|
0
|
$ssh->system({},". $script_rem"); |
1697
|
0
|
|
|
|
|
0
|
my $ret = $?; |
1698
|
|
|
|
|
|
|
|
1699
|
0
|
0
|
|
|
|
0
|
if (! $$self{'g'}{'ssh_script_keep'}) { |
1700
|
0
|
|
|
|
|
0
|
$ssh->system({},"rm -f $script_rem"); |
1701
|
|
|
|
|
|
|
} |
1702
|
0
|
|
|
|
|
0
|
return ($ret); |
1703
|
|
|
|
|
|
|
} |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
# |
1706
|
|
|
|
|
|
|
# If it's running in script mode, do so. |
1707
|
|
|
|
|
|
|
# |
1708
|
|
|
|
|
|
|
|
1709
|
0
|
|
|
|
|
0
|
my($stdout,$stderr,$exit); |
1710
|
|
|
|
|
|
|
|
1711
|
0
|
0
|
|
|
|
0
|
if ($$self{'g'}{'err'}) { |
|
|
0
|
|
|
|
|
|
1712
|
0
|
|
|
|
|
0
|
($stdout,$stderr) = $ssh->capture2({},". $script_rem"); |
1713
|
0
|
0
|
|
|
|
0
|
$stdout = undef if (! $$self{'g'}{'out'}); |
1714
|
|
|
|
|
|
|
} elsif ($$self{'g'}{'out'}) { |
1715
|
0
|
|
|
|
|
0
|
$stdout = $ssh->capture({},". $script_rem"); |
1716
|
|
|
|
|
|
|
} else { |
1717
|
0
|
|
|
|
|
0
|
$ssh->system({},". $script_rem"); |
1718
|
|
|
|
|
|
|
} |
1719
|
0
|
|
|
|
|
0
|
$exit = $?; |
1720
|
0
|
|
|
|
|
0
|
$exit = $exit >> 8; |
1721
|
|
|
|
|
|
|
|
1722
|
0
|
0
|
|
|
|
0
|
if (! $$self{'g'}{'ssh_script_keep'}) { |
1723
|
0
|
|
|
|
|
0
|
$ssh->system({},"rm -f $script_rem"); |
1724
|
|
|
|
|
|
|
} |
1725
|
|
|
|
|
|
|
|
1726
|
0
|
|
|
|
|
0
|
return ($exit,$stdout,$stderr); |
1727
|
|
|
|
|
|
|
} |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
############################################################################### |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
sub output { |
1732
|
141
|
|
|
141
|
1
|
186278
|
my($self,%options) = @_; |
1733
|
|
|
|
|
|
|
|
1734
|
141
|
50
|
|
|
|
403
|
my $host = (exists $options{'host'} ? $options{'host'} : ''); |
1735
|
141
|
50
|
|
|
|
312
|
my $type = (exists $options{'output'} ? $options{'output'} : 'stdout'); |
1736
|
141
|
50
|
|
|
|
310
|
my $cmd = (exists $options{'command'} ? $options{'command'} : 'curr'); |
1737
|
|
|
|
|
|
|
|
1738
|
141
|
50
|
|
|
|
831
|
if ($type !~ /^(stdout|stderr|command|num|label|exit)$/) { |
1739
|
0
|
|
|
|
|
0
|
$self->_err("Invalid output option: output=$type"); |
1740
|
0
|
|
|
|
|
0
|
return; |
1741
|
|
|
|
|
|
|
} |
1742
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
# |
1744
|
|
|
|
|
|
|
# Output from ssh method |
1745
|
|
|
|
|
|
|
# |
1746
|
|
|
|
|
|
|
|
1747
|
141
|
50
|
|
|
|
307
|
if ($host) { |
1748
|
0
|
|
|
|
|
0
|
my @all = keys %{ $$self{'s'} }; |
|
0
|
|
|
|
|
0
|
|
1749
|
0
|
0
|
|
|
|
0
|
if (! @all) { |
1750
|
0
|
|
|
|
|
0
|
$self->_err("Invalid option in output: " . |
1751
|
|
|
|
|
|
|
"host not allowed unless run with ssh method"); |
1752
|
0
|
|
|
|
|
0
|
return; |
1753
|
|
|
|
|
|
|
} |
1754
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
# host = all |
1756
|
|
|
|
|
|
|
# host = HOST,HOST,... |
1757
|
|
|
|
|
|
|
|
1758
|
0
|
0
|
0
|
|
|
0
|
if ($host eq 'all' || $host =~ /,/) { |
1759
|
0
|
|
|
|
|
0
|
my %ret; |
1760
|
0
|
0
|
|
|
|
0
|
my @host = ($host eq 'all' |
1761
|
|
|
|
|
|
|
? @all |
1762
|
|
|
|
|
|
|
: split(/,/,$host)); |
1763
|
|
|
|
|
|
|
|
1764
|
0
|
|
|
|
|
0
|
foreach my $host (@host) { |
1765
|
0
|
0
|
|
|
|
0
|
if (! exists $$self{'s'}{$host}) { |
1766
|
0
|
|
|
|
|
0
|
$self->_err("Host has no output: $host"); |
1767
|
0
|
|
|
|
|
0
|
next; |
1768
|
|
|
|
|
|
|
} |
1769
|
|
|
|
|
|
|
|
1770
|
0
|
|
|
|
|
0
|
$ret{$host} = [ $self->_output($type,$cmd,$$self{'s'}{$host}) ]; |
1771
|
|
|
|
|
|
|
} |
1772
|
0
|
|
|
|
|
0
|
return %ret; |
1773
|
|
|
|
|
|
|
} |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
# host = HOST |
1776
|
|
|
|
|
|
|
|
1777
|
0
|
0
|
|
|
|
0
|
if (! exists $$self{'s'}{$host}) { |
1778
|
0
|
|
|
|
|
0
|
$self->_err("Host has no output: $host"); |
1779
|
0
|
|
|
|
|
0
|
return; |
1780
|
|
|
|
|
|
|
} |
1781
|
0
|
|
|
|
|
0
|
return $self->_output($type,$cmd,$$self{'s'}{$host}); |
1782
|
|
|
|
|
|
|
} |
1783
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
# |
1785
|
|
|
|
|
|
|
# Output from run method |
1786
|
|
|
|
|
|
|
# |
1787
|
|
|
|
|
|
|
|
1788
|
141
|
|
|
|
|
396
|
return $self->_output($type,$cmd,$$self{'o'}); |
1789
|
|
|
|
|
|
|
} |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
sub _output { |
1792
|
141
|
|
|
141
|
|
296
|
my($self,$type,$cmd,$output) = @_; |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
# |
1795
|
|
|
|
|
|
|
# Figure out which output sections need to be returned. |
1796
|
|
|
|
|
|
|
# |
1797
|
|
|
|
|
|
|
|
1798
|
141
|
|
|
|
|
189
|
my @c; |
1799
|
141
|
100
|
|
|
|
263
|
my $no = (exists $$output{'out'} ? @{ $$output{'out'} } : 0); |
|
116
|
|
|
|
|
189
|
|
1800
|
141
|
100
|
|
|
|
279
|
my $ne = (exists $$output{'err'} ? @{ $$output{'err'} } : 0); |
|
91
|
|
|
|
|
127
|
|
1801
|
141
|
100
|
|
|
|
265
|
my $max = ($no > $ne ? $no : $ne); |
1802
|
|
|
|
|
|
|
|
1803
|
141
|
100
|
|
|
|
517
|
if ($cmd eq 'curr') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1804
|
26
|
|
|
|
|
57
|
push @c,$$self{'curr'}; |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
} elsif ($cmd eq 'next') { |
1807
|
5
|
|
|
|
|
13
|
$$self{'curr'}++; |
1808
|
5
|
|
|
|
|
20
|
push @c,$$self{'curr'}; |
1809
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
} elsif ($cmd eq 'all') { |
1811
|
43
|
|
|
|
|
138
|
push @c, (0 .. ($max-1)); |
1812
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
} elsif ($cmd eq 'fail') { |
1814
|
|
|
|
|
|
|
# Find the command that failed. |
1815
|
|
|
|
|
|
|
|
1816
|
38
|
|
|
|
|
108
|
foreach my $i (0 .. ($max-1)) { |
1817
|
86
|
100
|
66
|
|
|
383
|
if (exists $$output{'out'} && defined $$output{'out'}[$i]) { |
|
|
50
|
33
|
|
|
|
|
1818
|
74
|
100
|
|
|
|
186
|
if ($$output{'out'}[$i][1]) { |
1819
|
9
|
|
|
|
|
13
|
push(@c,$i); |
1820
|
9
|
|
|
|
|
18
|
last; |
1821
|
|
|
|
|
|
|
} |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
} elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) { |
1824
|
12
|
50
|
|
|
|
28
|
if ($$output{'err'}[$i][1]) { |
1825
|
0
|
|
|
|
|
0
|
push(@c,$i); |
1826
|
0
|
|
|
|
|
0
|
last; |
1827
|
|
|
|
|
|
|
} |
1828
|
|
|
|
|
|
|
} |
1829
|
|
|
|
|
|
|
} |
1830
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
} elsif ($cmd =~ /^\d+$/) { |
1832
|
|
|
|
|
|
|
# CMD_NUM |
1833
|
|
|
|
|
|
|
|
1834
|
29
|
|
|
|
|
96
|
foreach my $i (0 .. ($max-1)) { |
1835
|
68
|
100
|
66
|
|
|
284
|
if (exists $$output{'out'} && defined $$output{'out'}[$i]) { |
|
|
50
|
33
|
|
|
|
|
1836
|
56
|
100
|
|
|
|
134
|
if ($$output{'out'}[$i][0] eq $cmd) { |
1837
|
23
|
|
|
|
|
49
|
push(@c,$i); |
1838
|
|
|
|
|
|
|
} |
1839
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
} elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) { |
1841
|
12
|
100
|
|
|
|
30
|
if ($$output{'err'}[$i][0] eq $cmd) { |
1842
|
6
|
|
|
|
|
13
|
push(@c,$i); |
1843
|
|
|
|
|
|
|
} |
1844
|
|
|
|
|
|
|
} |
1845
|
|
|
|
|
|
|
} |
1846
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
} else { |
1848
|
|
|
|
|
|
|
# LABEL |
1849
|
|
|
|
|
|
|
|
1850
|
0
|
|
|
|
|
0
|
foreach my $i (0 .. ($max-1)) { |
1851
|
0
|
0
|
0
|
|
|
0
|
if (exists $$output{'out'} && defined $$output{'out'}[$i]) { |
|
|
0
|
0
|
|
|
|
|
1852
|
0
|
|
|
|
|
0
|
my $n = $$output{'out'}[$i][0]; |
1853
|
0
|
0
|
|
|
|
0
|
if ($$self{'cmd'}{$n}{'label'} eq $cmd) { |
1854
|
0
|
|
|
|
|
0
|
push(@c,$i); |
1855
|
|
|
|
|
|
|
} |
1856
|
|
|
|
|
|
|
|
1857
|
|
|
|
|
|
|
} elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) { |
1858
|
0
|
|
|
|
|
0
|
my $n = $$output{'err'}[$i][0]; |
1859
|
0
|
0
|
|
|
|
0
|
if ($$self{'cmd'}{$n}{'label'} eq $cmd) { |
1860
|
0
|
|
|
|
|
0
|
push(@c,$i); |
1861
|
|
|
|
|
|
|
} |
1862
|
|
|
|
|
|
|
} |
1863
|
|
|
|
|
|
|
} |
1864
|
|
|
|
|
|
|
} |
1865
|
|
|
|
|
|
|
|
1866
|
141
|
100
|
|
|
|
397
|
return if (! @c); |
1867
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
# |
1869
|
|
|
|
|
|
|
# Now gather up the stuff to return. |
1870
|
|
|
|
|
|
|
# |
1871
|
|
|
|
|
|
|
|
1872
|
112
|
|
|
|
|
173
|
my @ret; |
1873
|
|
|
|
|
|
|
|
1874
|
112
|
|
|
|
|
224
|
foreach my $i (@c) { |
1875
|
175
|
100
|
|
|
|
695
|
if ($type eq 'stdout') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1876
|
31
|
|
|
|
|
51
|
my @r; |
1877
|
31
|
100
|
66
|
|
|
187
|
if (exists $$output{'out'} && defined $$output{'out'}[$i]) { |
1878
|
27
|
|
|
|
|
59
|
my @tmp = @{ $$output{'out'}[$i] }; |
|
27
|
|
|
|
|
78
|
|
1879
|
27
|
|
|
|
|
50
|
shift(@tmp); |
1880
|
27
|
|
|
|
|
134
|
shift(@tmp); |
1881
|
27
|
|
|
|
|
57
|
foreach my $try (@tmp) { |
1882
|
31
|
|
|
|
|
56
|
foreach my $alt (@$try) { |
1883
|
35
|
|
|
|
|
76
|
push(@r,@$alt); |
1884
|
|
|
|
|
|
|
} |
1885
|
|
|
|
|
|
|
} |
1886
|
27
|
|
|
|
|
125
|
push(@ret,[@r]); |
1887
|
|
|
|
|
|
|
} |
1888
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
} elsif ($type eq 'stderr') { |
1890
|
21
|
|
|
|
|
34
|
my @r; |
1891
|
21
|
100
|
66
|
|
|
107
|
if (exists $$output{'err'} && defined $$output{'err'}[$i]) { |
1892
|
13
|
|
|
|
|
25
|
my @tmp = @{ $$output{'err'}[$i] }; |
|
13
|
|
|
|
|
45
|
|
1893
|
13
|
|
|
|
|
21
|
shift(@tmp); |
1894
|
13
|
|
|
|
|
24
|
shift(@tmp); |
1895
|
13
|
|
|
|
|
23
|
foreach my $try (@tmp) { |
1896
|
15
|
|
|
|
|
26
|
foreach my $alt (@$try) { |
1897
|
17
|
|
|
|
|
44
|
push(@r,@$alt); |
1898
|
|
|
|
|
|
|
} |
1899
|
|
|
|
|
|
|
} |
1900
|
13
|
|
|
|
|
36
|
push(@ret,[@r]); |
1901
|
|
|
|
|
|
|
} |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
} elsif ($type eq 'command') { |
1904
|
31
|
|
|
|
|
47
|
my $n; |
1905
|
31
|
100
|
66
|
|
|
187
|
if (exists $$output{'out'} && defined $$output{'out'}[$i]) { |
|
|
50
|
33
|
|
|
|
|
1906
|
27
|
|
|
|
|
100
|
$n = $$output{'out'}[$i][0]; |
1907
|
|
|
|
|
|
|
} elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) { |
1908
|
4
|
|
|
|
|
9
|
$n = $$output{'err'}[$i][0]; |
1909
|
|
|
|
|
|
|
} |
1910
|
31
|
|
|
|
|
159
|
push(@ret,$$self{'cmd'}{$n}{'cmd'}); |
1911
|
|
|
|
|
|
|
|
1912
|
|
|
|
|
|
|
} elsif ($type eq 'num') { |
1913
|
37
|
|
|
|
|
59
|
my $n; |
1914
|
37
|
100
|
66
|
|
|
231
|
if (exists $$output{'out'} && defined $$output{'out'}[$i]) { |
|
|
50
|
33
|
|
|
|
|
1915
|
32
|
|
|
|
|
75
|
$n = $$output{'out'}[$i][0]; |
1916
|
|
|
|
|
|
|
} elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) { |
1917
|
5
|
|
|
|
|
10
|
$n = $$output{'err'}[$i][0]; |
1918
|
|
|
|
|
|
|
} |
1919
|
37
|
|
|
|
|
111
|
push(@ret,$n); |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
} elsif ($type eq 'label') { |
1922
|
23
|
|
|
|
|
35
|
my $n; |
1923
|
23
|
100
|
66
|
|
|
162
|
if (exists $$output{'out'} && defined $$output{'out'}[$i]) { |
|
|
50
|
33
|
|
|
|
|
1924
|
19
|
|
|
|
|
50
|
$n = $$output{'out'}[$i][0]; |
1925
|
|
|
|
|
|
|
} elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) { |
1926
|
4
|
|
|
|
|
8
|
$n = $$output{'err'}[$i][0]; |
1927
|
|
|
|
|
|
|
} |
1928
|
23
|
|
|
|
|
97
|
push(@ret,$$self{'cmd'}{$n}{'label'}); |
1929
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
} elsif ($type eq 'exit') { |
1931
|
32
|
|
|
|
|
44
|
my $exit; |
1932
|
32
|
100
|
66
|
|
|
210
|
if (exists $$output{'out'} && defined $$output{'out'}[$i]) { |
|
|
50
|
33
|
|
|
|
|
1933
|
28
|
|
|
|
|
67
|
$exit = $$output{'out'}[$i][1]; |
1934
|
|
|
|
|
|
|
} elsif (exists $$output{'err'} && defined $$output{'err'}[$i]) { |
1935
|
4
|
|
|
|
|
8
|
$exit = $$output{'err'}[$i][1]; |
1936
|
|
|
|
|
|
|
} |
1937
|
32
|
|
|
|
|
85
|
push(@ret,$exit); |
1938
|
|
|
|
|
|
|
} |
1939
|
|
|
|
|
|
|
} |
1940
|
|
|
|
|
|
|
|
1941
|
112
|
|
|
|
|
583
|
return @ret; |
1942
|
|
|
|
|
|
|
} |
1943
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
1; |
1945
|
|
|
|
|
|
|
# Local Variables: |
1946
|
|
|
|
|
|
|
# mode: cperl |
1947
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
1948
|
|
|
|
|
|
|
# cperl-indent-level: 3 |
1949
|
|
|
|
|
|
|
# cperl-continued-statement-offset: 2 |
1950
|
|
|
|
|
|
|
# cperl-continued-brace-offset: 0 |
1951
|
|
|
|
|
|
|
# cperl-brace-offset: 0 |
1952
|
|
|
|
|
|
|
# cperl-brace-imaginary-offset: 0 |
1953
|
|
|
|
|
|
|
# cperl-label-offset: 0 |
1954
|
|
|
|
|
|
|
# End: |