line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Clustericious::Admin::RemoteHandler; |
2
|
|
|
|
|
|
|
|
3
|
9
|
|
|
9
|
|
38
|
use strict; |
|
9
|
|
|
|
|
12
|
|
|
9
|
|
|
|
|
256
|
|
4
|
9
|
|
|
9
|
|
39
|
use warnings; |
|
9
|
|
|
|
|
11
|
|
|
9
|
|
|
|
|
233
|
|
5
|
9
|
|
|
9
|
|
165
|
use 5.010; |
|
9
|
|
|
|
|
21
|
|
6
|
9
|
|
|
9
|
|
33
|
use AE; |
|
9
|
|
|
|
|
12
|
|
|
9
|
|
|
|
|
182
|
|
7
|
9
|
|
|
9
|
|
3800
|
use AnyEvent::Open3::Simple 0.76; |
|
9
|
|
|
|
|
43095
|
|
|
9
|
|
|
|
|
7398
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '1.09'; # VERSION |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub new |
12
|
|
|
|
|
|
|
{ |
13
|
30
|
|
|
30
|
0
|
200
|
my($class, %args) = @_; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# args: prefix, clad, user, host, payload |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $self = bless { |
18
|
|
|
|
|
|
|
prefix => $args{prefix}, |
19
|
|
|
|
|
|
|
clad => $args{clad}, |
20
|
|
|
|
|
|
|
cv => AE::cv, |
21
|
|
|
|
|
|
|
summary => $args{clad}->summary, |
22
|
30
|
|
|
|
|
1806
|
}, $class; |
23
|
|
|
|
|
|
|
|
24
|
30
|
|
|
|
|
94
|
my $clad = $args{clad}; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# TODO: handle the same host multiple times |
27
|
30
|
100
|
|
|
|
125
|
if($clad->log_dir) |
28
|
|
|
|
|
|
|
{ |
29
|
3
|
|
|
|
|
25
|
my $fn = $clad->log_dir->file($args{prefix} . ".log"); |
30
|
3
|
50
|
|
|
|
587
|
open(my $fh, '>', "$fn") |
31
|
|
|
|
|
|
|
|| die "unable to write to $fn $!"; |
32
|
3
|
|
|
|
|
666
|
$self->{logfile} = $fh; |
33
|
3
|
|
|
|
|
84
|
$self->{logfilename} = $fn; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
30
|
|
|
|
|
64
|
my $done = $self->{cv}; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $ipc = AnyEvent::Open3::Simple->new( |
39
|
|
|
|
|
|
|
on_start => sub { |
40
|
30
|
|
|
30
|
|
204894
|
my($proc, $program, @args) = @_; |
41
|
30
|
50
|
|
|
|
408
|
$self->print_line(star => "% $program @args") if $clad->verbose; |
42
|
|
|
|
|
|
|
}, |
43
|
|
|
|
|
|
|
on_stdout => sub { |
44
|
35
|
|
|
35
|
|
2495528
|
my($proc, $line) = @_; |
45
|
35
|
|
|
|
|
267
|
$self->print_line(out => $line); |
46
|
|
|
|
|
|
|
}, |
47
|
|
|
|
|
|
|
on_stderr => sub { |
48
|
6
|
|
|
6
|
|
773161
|
my($proc, $line) = @_; |
49
|
6
|
|
|
|
|
43
|
$self->print_line(err => $line); |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
on_exit => sub { |
52
|
30
|
|
|
30
|
|
1413180
|
my($proc, $exit, $signal) = @_; |
53
|
30
|
100
|
66
|
|
|
143
|
$self->print_line(exit => $exit) if ($self->summary && !$signal) || $exit; |
|
|
|
100
|
|
|
|
|
54
|
30
|
50
|
|
|
|
84
|
$self->print_line(sig => $signal) if $signal; |
55
|
30
|
100
|
66
|
|
|
175
|
$clad->ret(2) if $exit || $signal; |
56
|
30
|
|
|
|
|
112
|
$self->cleanup; |
57
|
|
|
|
|
|
|
}, |
58
|
|
|
|
|
|
|
on_error => sub { |
59
|
0
|
|
|
0
|
|
0
|
my($error) = @_; |
60
|
0
|
|
|
|
|
0
|
$self->print_line(fail => $error); |
61
|
0
|
|
|
|
|
0
|
$clad->ret(2); |
62
|
0
|
|
|
|
|
0
|
$self->cleanup; |
63
|
|
|
|
|
|
|
}, |
64
|
30
|
|
|
|
|
800
|
); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
$ipc->run( |
67
|
|
|
|
|
|
|
$clad->ssh_command, |
68
|
|
|
|
|
|
|
$clad->ssh_options, |
69
|
|
|
|
|
|
|
$clad->ssh_extra, |
70
|
|
|
|
|
|
|
($args{user} ? ('-l' => $args{user}) : ()), |
71
|
|
|
|
|
|
|
$args{host}, |
72
|
|
|
|
|
|
|
$clad->server_command, |
73
|
|
|
|
|
|
|
\$args{payload}, |
74
|
30
|
100
|
|
|
|
1820
|
); |
75
|
|
|
|
|
|
|
|
76
|
30
|
|
|
|
|
5449
|
$self; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
69
|
|
|
69
|
0
|
488
|
sub clad { shift->{clad} } |
80
|
41
|
|
|
41
|
0
|
1686
|
sub prefix { shift->{prefix} } |
81
|
77
|
|
|
77
|
0
|
617
|
sub summary { shift->{summary} } |
82
|
80
|
|
|
80
|
0
|
292
|
sub logfile { shift->{logfile} } |
83
|
0
|
|
|
0
|
0
|
0
|
sub logfilename { shift->{logfilename} } |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub cleanup |
86
|
|
|
|
|
|
|
{ |
87
|
30
|
|
|
30
|
0
|
59
|
my($self) = @_; |
88
|
30
|
100
|
|
|
|
81
|
$self->logfile->close if $self->logfile; |
89
|
30
|
|
|
|
|
492
|
$self->{cv}->send; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub color |
93
|
|
|
|
|
|
|
{ |
94
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
95
|
0
|
|
0
|
|
|
0
|
$self->{color} //= $self->clad->next_color; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub is_color |
99
|
|
|
|
|
|
|
{ |
100
|
88
|
|
|
88
|
0
|
127
|
my($self) = @_; |
101
|
88
|
|
66
|
|
|
567
|
$self->{is_color} //= $self->clad->color; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub print_line |
105
|
|
|
|
|
|
|
{ |
106
|
47
|
|
|
47
|
0
|
160
|
my($self, $code, $line) = @_; |
107
|
|
|
|
|
|
|
|
108
|
47
|
|
|
|
|
180
|
my $fh = $self->logfile; |
109
|
47
|
100
|
|
|
|
217
|
printf $fh "[%-4s] %s\n", $code, $line |
110
|
|
|
|
|
|
|
if $fh; |
111
|
|
|
|
|
|
|
|
112
|
47
|
|
|
|
|
260
|
my $last_line = $code =~ /^(exit|sig|fail)$/; |
113
|
|
|
|
|
|
|
|
114
|
47
|
100
|
100
|
|
|
162
|
return if $self->summary && ! $last_line; |
115
|
|
|
|
|
|
|
|
116
|
41
|
100
|
100
|
|
|
197
|
if($last_line && $line ne '0') |
117
|
|
|
|
|
|
|
{ |
118
|
4
|
50
|
|
|
|
24
|
print Term::ANSIColor::color($self->clad->fail_color) if $self->is_color; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
else |
121
|
|
|
|
|
|
|
{ |
122
|
37
|
50
|
|
|
|
120
|
print Term::ANSIColor::color($self->color) if $self->is_color; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
41
|
|
|
|
|
106
|
printf "[%@{[ $self->clad->host_length ]}s %-4s] ", $self->prefix, $code; |
|
41
|
|
|
|
|
123
|
|
126
|
|
|
|
|
|
|
|
127
|
41
|
100
|
|
|
|
181
|
if(! $last_line) |
128
|
|
|
|
|
|
|
{ |
129
|
35
|
100
|
|
|
|
123
|
if($code eq 'err') |
130
|
|
|
|
|
|
|
{ |
131
|
6
|
50
|
|
|
|
26
|
print Term::ANSIColor::color($self->clad->err_color) if $self->is_color; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
else |
134
|
|
|
|
|
|
|
{ |
135
|
29
|
50
|
|
|
|
78
|
print Term::ANSIColor::color('reset') if $self->is_color; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
41
|
|
|
|
|
423
|
print $line; |
140
|
|
|
|
|
|
|
|
141
|
41
|
100
|
100
|
|
|
291
|
if($last_line || $code eq 'err') |
142
|
|
|
|
|
|
|
{ |
143
|
12
|
50
|
|
|
|
51
|
print Term::ANSIColor::color('reset') if $self->is_color; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
41
|
|
|
|
|
333
|
print "\n"; |
147
|
|
|
|
|
|
|
|
148
|
41
|
50
|
66
|
|
|
435
|
if($fh && $last_line && $line ne '0') |
|
|
|
33
|
|
|
|
|
149
|
|
|
|
|
|
|
{ |
150
|
0
|
|
|
|
|
0
|
print ' ' x ($self->clad->host_length +8), "see @{[ $self->logfilename ]}\n"; |
|
0
|
|
|
|
|
0
|
|
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
30
|
|
|
30
|
0
|
93
|
sub cv { shift->{cv} } |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
1; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
__END__ |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=pod |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=encoding UTF-8 |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 NAME |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Clustericious::Admin::RemoteHandler |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 VERSION |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
version 1.09 |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head1 AUTHOR |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Graham Ollis <plicease@cpan.org> |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
This software is copyright (c) 2015 by Graham Ollis. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
181
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=cut |