line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# This file is part of StorageDisplay |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# This software is copyright (c) 2014-2023 by Vincent Danjean. |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# This is free software; you can redistribute it and/or modify it under |
7
|
|
|
|
|
|
|
# the same terms as the Perl 5 programming language system itself. |
8
|
|
|
|
|
|
|
# |
9
|
1
|
|
|
1
|
|
255662
|
use strict; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
29
|
|
10
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1281
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Implementation note: this file must contains all required modules |
13
|
|
|
|
|
|
|
# required to collect data, but modules included in perl itself. |
14
|
|
|
|
|
|
|
# This file can be sent to remote machine through SSH, this is why |
15
|
|
|
|
|
|
|
# it must be self-contained. |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
package StorageDisplay::Collect; |
18
|
|
|
|
|
|
|
# ABSTRACT: modules required to collect data. |
19
|
|
|
|
|
|
|
# No dependencies (but perl itself and its basic modules) |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $VERSION = '2.03'; # VERSION |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub collectors { |
25
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
26
|
0
|
|
|
|
|
0
|
return @{$self->{_attr_collectors}}; |
|
0
|
|
|
|
|
0
|
|
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub collector { |
30
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
31
|
0
|
|
|
|
|
0
|
my $name = shift; |
32
|
0
|
|
|
|
|
0
|
return $self->{_attr_collectors_by_provide}->{$name}; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub registerCollector { |
36
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
37
|
0
|
|
|
|
|
0
|
my $collector = shift; |
38
|
|
|
|
|
|
|
|
39
|
0
|
0
|
|
|
|
0
|
die "$collector not a StorageDisplay::Collect::Collector" |
40
|
|
|
|
|
|
|
if not $collector->isa("StorageDisplay::Collect::Collector"); |
41
|
|
|
|
|
|
|
|
42
|
0
|
|
|
|
|
0
|
push @{$self->{_attr_collectors}}, $collector; |
|
0
|
|
|
|
|
0
|
|
43
|
0
|
|
|
|
|
0
|
foreach my $cn ($collector->provides) { |
44
|
0
|
0
|
|
|
|
0
|
if (exists($self->{_attr_collectors_by_provide}->{$cn})) { |
45
|
|
|
|
|
|
|
die "$cn provided by both ".$collector->module." and ". |
46
|
0
|
|
|
|
|
0
|
$self->{_attr_collectors_by_provide}->{$cn}->module; |
47
|
|
|
|
|
|
|
} |
48
|
0
|
|
|
|
|
0
|
$self->{_attr_collectors_by_provide}->{$cn} = $collector; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub open_cmd_pipe { |
53
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
54
|
0
|
|
|
|
|
0
|
return $self->cmdreader->open_cmd_pipe(@_); |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub open_cmd_pipe_root { |
58
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
59
|
0
|
|
|
|
|
0
|
return $self->cmdreader->open_cmd_pipe_root(@_); |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub open_file { |
63
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
64
|
0
|
|
|
|
|
0
|
return $self->cmdreader->open_file(@_); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub has_file { |
68
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
69
|
0
|
|
|
|
|
0
|
return $self->cmdreader->has_file(@_); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub cmdreader { |
73
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
74
|
0
|
|
|
|
|
0
|
return $self->{_attr_cmdreader}; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
my @collectors; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub new { |
80
|
0
|
|
|
0
|
0
|
0
|
my $class = shift; |
81
|
0
|
|
0
|
|
|
0
|
my $reader = shift // 'Local'; |
82
|
|
|
|
|
|
|
|
83
|
0
|
0
|
|
|
|
0
|
if (ref($reader) eq '') { |
84
|
0
|
|
|
|
|
0
|
my $fullreadername = 'StorageDisplay::Collect::CMD::'.$reader; |
85
|
0
|
|
|
|
|
0
|
$reader = $fullreadername->new(@_); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
0
|
|
|
|
|
0
|
my $self = { |
89
|
|
|
|
|
|
|
_attr_cmdreader => $reader, |
90
|
|
|
|
|
|
|
_attr_collectors => [], |
91
|
|
|
|
|
|
|
_attr_collectors_by_provide => {}, |
92
|
|
|
|
|
|
|
}; |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
0
|
bless $self, $class; |
95
|
|
|
|
|
|
|
|
96
|
0
|
|
|
|
|
0
|
foreach my $cdata (@collectors) { |
97
|
0
|
|
|
|
|
0
|
my $cn = $cdata->{name}; |
98
|
0
|
|
|
|
|
0
|
$cn->new($cdata, $self); |
99
|
|
|
|
|
|
|
} |
100
|
0
|
|
|
|
|
0
|
return $self; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub registerCollectorModule { |
104
|
11
|
|
|
11
|
0
|
33
|
my $class = shift; |
105
|
11
|
|
|
|
|
16
|
my $collector = shift; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
#my $collector = caller 0; |
108
|
|
|
|
|
|
|
#print STDERR "Registering $collector from ".(caller 0)."\n"; |
109
|
11
|
|
|
|
|
46
|
my $info = { name => $collector, @_ }; |
110
|
11
|
|
|
|
|
33
|
foreach my $entry (qw(provides requires)) { |
111
|
22
|
100
|
|
|
|
69
|
next if not exists($info->{$entry}); |
112
|
14
|
100
|
|
|
|
47
|
if (ref($info->{$entry}) eq "") { |
113
|
8
|
|
|
|
|
40
|
$info->{$entry} = [ $info->{$entry} ]; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
} |
116
|
11
|
|
|
|
|
8353
|
push @collectors, $info; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# Main collect function |
120
|
|
|
|
|
|
|
# |
121
|
|
|
|
|
|
|
# It will iterate on the collectors, respecting dependencies. |
122
|
|
|
|
|
|
|
sub collect { |
123
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
124
|
0
|
|
|
|
|
0
|
my $req = shift; |
125
|
0
|
|
|
|
|
0
|
my $infos = {}; |
126
|
|
|
|
|
|
|
|
127
|
0
|
|
|
|
|
0
|
$infos = $self->cmdreader->data_init($infos); |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# 0/undef : not computed |
130
|
|
|
|
|
|
|
# 1 : computed |
131
|
|
|
|
|
|
|
# 2 : computing |
132
|
|
|
|
|
|
|
# 3 : N/A |
133
|
0
|
|
|
|
|
0
|
my $collector_state = {}; |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
0
|
my $load; |
136
|
|
|
|
|
|
|
$load = sub { |
137
|
0
|
|
|
0
|
|
0
|
my $col = shift; |
138
|
0
|
|
|
|
|
0
|
$collector_state->{$_} = 2 for $col->provides; |
139
|
0
|
|
|
|
|
0
|
foreach my $cname ($col->requires) { |
140
|
|
|
|
|
|
|
#print STDERR " preloading $cname\n"; |
141
|
0
|
|
|
|
|
0
|
my $state = $collector_state->{$cname}; |
142
|
0
|
0
|
|
|
|
0
|
if (not defined($state)) { |
|
|
0
|
|
|
|
|
|
143
|
0
|
|
|
|
|
0
|
my $collector = $self->collector($cname); |
144
|
0
|
0
|
|
|
|
0
|
die "E: No $cname collector available for ".$col->module."\n" |
145
|
|
|
|
|
|
|
if not defined($collector); |
146
|
0
|
|
|
|
|
0
|
$load->($collector); |
147
|
|
|
|
|
|
|
} elsif ($collector_state->{$cname} == 1) { |
148
|
|
|
|
|
|
|
next |
149
|
0
|
|
|
|
|
0
|
} else { |
150
|
0
|
|
|
|
|
0
|
die "Loop in collectors requires ($cname required in $col->name)"; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
# are files present? |
154
|
|
|
|
|
|
|
my @missing_files = |
155
|
|
|
|
|
|
|
grep { |
156
|
0
|
|
|
|
|
0
|
not $self->has_file($_); |
|
0
|
|
|
|
|
0
|
|
157
|
|
|
|
|
|
|
} $col->depends('files'); |
158
|
0
|
0
|
|
|
|
0
|
if (scalar(@missing_files)) { |
159
|
0
|
|
|
|
|
0
|
print STDERR "I: skipping ", $col->module, " due to missing file(s): '", |
160
|
|
|
|
|
|
|
join("', '", @missing_files), "'\n"; |
161
|
0
|
|
|
|
|
0
|
$collector_state->{$_} = 3 for $col->provides; |
162
|
0
|
|
|
|
|
0
|
return; |
163
|
|
|
|
|
|
|
} |
164
|
0
|
0
|
|
|
|
0
|
my $opencmd = $col->depends('root') ? |
165
|
|
|
|
|
|
|
'open_cmd_pipe_root' : 'open_cmd_pipe'; |
166
|
|
|
|
|
|
|
# are programs present? |
167
|
|
|
|
|
|
|
my @missing_progs = |
168
|
|
|
|
|
|
|
grep { |
169
|
0
|
|
|
|
|
0
|
my @cmd=('which', $_); |
|
0
|
|
|
|
|
0
|
|
170
|
0
|
|
|
|
|
0
|
my $dh = $col->$opencmd(@cmd); |
171
|
0
|
|
|
|
|
0
|
my $path = <$dh>; |
172
|
0
|
|
|
|
|
0
|
close($dh); |
173
|
0
|
|
|
|
|
0
|
not defined($path); |
174
|
|
|
|
|
|
|
} $col->depends('progs'); |
175
|
0
|
0
|
|
|
|
0
|
if (scalar(@missing_progs)) { |
176
|
0
|
|
|
|
|
0
|
print STDERR "I: skipping ", $col->module, " due to missing program(s): '", |
177
|
|
|
|
|
|
|
join("', '", @missing_progs), "'\n"; |
178
|
0
|
|
|
|
|
0
|
$collector_state->{$_} = 3 for $col->provides; |
179
|
0
|
|
|
|
|
0
|
return; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
# collecting data while providing required data |
182
|
|
|
|
|
|
|
my $collected_infos = $col->collect( |
183
|
|
|
|
|
|
|
{ |
184
|
0
|
|
|
|
|
0
|
map { $_ => $infos->{$_} } $col->requires |
|
0
|
|
|
|
|
0
|
|
185
|
|
|
|
|
|
|
}, $req); |
186
|
|
|
|
|
|
|
# registering provided data |
187
|
0
|
|
|
|
|
0
|
$infos->{$_} = $collected_infos->{$_} for $col->provides; |
188
|
0
|
|
|
|
|
0
|
$collector_state->{$_} = 1 for $col->provides; |
189
|
|
|
|
|
|
|
#print STDERR "loaded $cn\n"; |
190
|
0
|
|
|
|
|
0
|
}; |
191
|
|
|
|
|
|
|
# Be sure to collect all collectors |
192
|
0
|
|
|
|
|
0
|
foreach my $col ($self->collectors) { |
193
|
0
|
|
|
|
|
0
|
$load->($col); |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
0
|
return $self->cmdreader->data_finish($infos); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
1; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
########################################################################### |
202
|
|
|
|
|
|
|
package StorageDisplay::Collect::JSON; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
BEGIN { |
205
|
|
|
|
|
|
|
# Mark current package as loaded; |
206
|
|
|
|
|
|
|
# else, we cannot use 'use StorageDisplay::Collect::JSON;' latter |
207
|
1
|
|
|
1
|
|
5
|
my $p = __PACKAGE__; |
208
|
1
|
|
|
|
|
5
|
$p =~ s,::,/,g; |
209
|
1
|
|
|
|
|
7240
|
chomp(my $cwd = `pwd`); |
210
|
1
|
|
|
|
|
198
|
$INC{$p.'.pm'} = $cwd.'/'.__FILE__;#k"current file"; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# This package contains |
214
|
|
|
|
|
|
|
# - two public subroutines |
215
|
|
|
|
|
|
|
# - `use_pp_parser` to know if JSON:PP makes all the work alone |
216
|
|
|
|
|
|
|
# - `decode_json` to decode a json text with the $json_parser object |
217
|
|
|
|
|
|
|
# - a public `new` class method that returns |
218
|
|
|
|
|
|
|
# - a plain JSON::PP object (if boolean_values method exists) |
219
|
|
|
|
|
|
|
# - a __PACKAGE__ object (if not) that inherit from JSON::PP |
220
|
|
|
|
|
|
|
# - an overrided `decode` method that |
221
|
|
|
|
|
|
|
# - calls SUPER::decode |
222
|
|
|
|
|
|
|
# - manually transforms JSON:::PP::Boolean into plain scalar |
223
|
|
|
|
|
|
|
# $json_parser is |
224
|
|
|
|
|
|
|
# - either a JSON::PP object (if boolean_values method exists) |
225
|
|
|
|
|
|
|
# - or a StorageDisplay::Collect::JSON that inherit of JSON::PP |
226
|
|
|
|
|
|
|
# but override the decode method |
227
|
|
|
|
|
|
|
|
228
|
1
|
|
|
1
|
|
29
|
use base 'JSON::PP'; |
|
1
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
1434
|
|
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
my $has_boolean_values; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub new { |
233
|
2
|
|
|
2
|
1
|
1756
|
my $class = shift; |
234
|
2
|
|
|
|
|
7
|
my $json_pp_parser; |
235
|
2
|
100
|
|
|
|
18
|
if (!defined($has_boolean_values)) { |
236
|
1
|
|
|
|
|
11
|
$json_pp_parser = JSON::PP->new; |
237
|
1
|
|
|
|
|
20
|
$has_boolean_values = 0; |
238
|
1
|
|
|
|
|
2
|
eval { |
239
|
|
|
|
|
|
|
# workaround if not supported |
240
|
1
|
|
|
|
|
17
|
$json_pp_parser->boolean_values(0, 1); |
241
|
0
|
|
|
|
|
0
|
$has_boolean_values = 1; |
242
|
|
|
|
|
|
|
}; |
243
|
|
|
|
|
|
|
} |
244
|
2
|
|
|
|
|
6
|
my $parser; |
245
|
2
|
50
|
|
|
|
8
|
if ($has_boolean_values) { |
246
|
0
|
|
|
|
|
0
|
$parser = JSON::PP->new(@_); |
247
|
0
|
|
|
|
|
0
|
$parser->boolean_values(0, 1); |
248
|
|
|
|
|
|
|
} else { |
249
|
2
|
|
|
|
|
47
|
$parser = JSON::PP::new(__PACKAGE__, @_); |
250
|
|
|
|
|
|
|
} |
251
|
2
|
|
|
|
|
33
|
eval { |
252
|
|
|
|
|
|
|
# ignore if not supported |
253
|
2
|
|
|
|
|
60
|
$parser->allow_bignum; |
254
|
|
|
|
|
|
|
}; |
255
|
2
|
|
|
|
|
47
|
return $parser; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub decode { |
259
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
260
|
|
|
|
|
|
|
|
261
|
1
|
|
|
|
|
7
|
my $data = $self->SUPER::decode(@_); |
262
|
|
|
|
|
|
|
|
263
|
1
|
|
|
|
|
103957
|
my %unrecognized; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
local *_convert_bools = sub { |
266
|
8
|
|
|
8
|
|
136
|
my $ref_type = ref($_[0]); |
267
|
8
|
100
|
|
|
|
43
|
if (!$ref_type) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# Nothing. |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
elsif ($ref_type eq 'HASH') { |
271
|
1
|
|
|
|
|
3
|
_convert_bools($_) for values(%{ $_[0] }); |
|
1
|
|
|
|
|
9
|
|
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
elsif ($ref_type eq 'ARRAY') { |
274
|
2
|
|
|
|
|
3
|
_convert_bools($_) for @{ $_[0] }; |
|
2
|
|
|
|
|
9
|
|
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
elsif ($ref_type eq 'JSON::PP::Boolean') { |
277
|
2
|
100
|
|
|
|
41
|
$_[0] = $_[0] ? 1 : 0; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
elsif ($ref_type eq 'Math::BigInt') { |
280
|
0
|
0
|
|
|
|
0
|
if ($_[0]->beq($_[0]->numify())) { |
281
|
|
|
|
|
|
|
# old versions of JSON::PP always use Math::Big* |
282
|
|
|
|
|
|
|
# even if this is not required |
283
|
0
|
|
|
|
|
0
|
$_[0] = $_[0]->numify(); |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
elsif ($ref_type eq 'Math::BigFloat') { |
287
|
1
|
50
|
33
|
|
|
7
|
if ($_[0]->is_int() |
288
|
|
|
|
|
|
|
&& $_[0]->beq($_[0]->numify())) { |
289
|
1
|
|
|
|
|
626
|
$_[0] = $_[0]->numify(); |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
else { |
293
|
0
|
|
|
|
|
0
|
++$unrecognized{$ref_type}; |
294
|
|
|
|
|
|
|
} |
295
|
1
|
|
|
|
|
33
|
}; |
296
|
|
|
|
|
|
|
|
297
|
1
|
|
|
|
|
6
|
&_convert_bools($data); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
warn("Encountered an object of unrecognized type $_") |
300
|
1
|
|
|
|
|
6
|
for sort values(%unrecognized); |
301
|
|
|
|
|
|
|
|
302
|
1
|
|
|
|
|
18
|
return $data; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
my $json_parser; |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub decode_json { |
308
|
1
|
50
|
|
1
|
1
|
696
|
if (not defined($json_parser)) { |
309
|
1
|
|
|
|
|
14
|
$json_parser = __PACKAGE__->new(); |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
1
|
|
|
|
|
6
|
$json_parser->decode(@_); |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub pp_parser_has_boolean_values { |
316
|
2
|
|
|
2
|
0
|
7384
|
return $has_boolean_values; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
1; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
########################################################################### |
322
|
|
|
|
|
|
|
package StorageDisplay::Collect::CMD; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub new { |
325
|
0
|
|
|
0
|
|
0
|
my $class = shift; |
326
|
0
|
|
|
|
|
0
|
my $self = {}; |
327
|
0
|
|
|
|
|
0
|
bless $self, $class; |
328
|
0
|
|
|
|
|
0
|
return $self; |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub cmd2str { |
332
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
333
|
0
|
|
|
|
|
0
|
my @cmd = @_; |
334
|
|
|
|
|
|
|
my $str = join(' ', map { |
335
|
0
|
|
|
|
|
0
|
my $s = $_; |
|
0
|
|
|
|
|
0
|
|
336
|
0
|
|
|
|
|
0
|
$s =~ s/(['\\])/\\$1/g; |
337
|
0
|
0
|
|
|
|
0
|
if ($s !~ /^[0-9a-zA-Z_@,:\/=-]+$/) { |
338
|
0
|
|
|
|
|
0
|
$s="'".$s."'"; |
339
|
|
|
|
|
|
|
} |
340
|
0
|
|
|
|
|
0
|
$s; |
341
|
|
|
|
|
|
|
} @cmd); |
342
|
0
|
|
|
|
|
0
|
return $str; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
sub data_init { |
346
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
347
|
0
|
|
|
|
|
0
|
my $data = shift; |
348
|
|
|
|
|
|
|
|
349
|
0
|
|
|
|
|
0
|
return $data; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub data_finish { |
353
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
354
|
0
|
|
|
|
|
0
|
my $data = shift; |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
|
|
0
|
return $data; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub open_file { |
360
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
361
|
0
|
|
|
|
|
0
|
my $filename = shift; |
362
|
|
|
|
|
|
|
|
363
|
0
|
|
|
|
|
0
|
return $self->open_cmd_pipe('cat', $filename); |
364
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
0
|
my $dh; |
366
|
0
|
0
|
|
|
|
0
|
open($dh, '<', $filename) or die "Cannot open $filename: $!"; |
367
|
0
|
|
|
|
|
0
|
return $dh; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub has_file { |
371
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
372
|
0
|
|
|
|
|
0
|
my $filename = shift; |
373
|
|
|
|
|
|
|
|
374
|
0
|
|
|
|
|
0
|
return -e $filename; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
1; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
########################################################################### |
380
|
|
|
|
|
|
|
package StorageDisplay::Collect::CMD::Local; |
381
|
|
|
|
|
|
|
|
382
|
1
|
|
|
1
|
|
771
|
use parent -norequire => "StorageDisplay::Collect::CMD"; |
|
1
|
|
|
|
|
424
|
|
|
1
|
|
|
|
|
17
|
|
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub open_cmd_pipe { |
385
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
386
|
0
|
|
|
|
|
0
|
my @cmd = @_; |
387
|
0
|
|
|
|
|
0
|
print STDERR "Running: ", $self->cmd2str(@cmd)."\n"; |
388
|
0
|
0
|
|
|
|
0
|
open(my $dh, '-|', @cmd) or |
389
|
|
|
|
|
|
|
die "Cannot run ".$self->cmd2str(@cmd).": $!\n"; |
390
|
0
|
|
|
|
|
0
|
return $dh; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub open_cmd_pipe_root { |
394
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
395
|
0
|
0
|
|
|
|
0
|
if ($> != 0) { |
396
|
0
|
|
|
|
|
0
|
return $self->open_cmd_pipe('sudo', @_); |
397
|
|
|
|
|
|
|
} else { |
398
|
0
|
|
|
|
|
0
|
return $self->open_cmd_pipe(@_); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
1; |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
########################################################################### |
405
|
|
|
|
|
|
|
package StorageDisplay::Collect::CMD::LocalBySSH; |
406
|
|
|
|
|
|
|
|
407
|
1
|
|
|
1
|
|
216
|
use parent -norequire => "StorageDisplay::Collect::CMD"; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
13
|
|
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub open_cmd_pipe { |
410
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
411
|
0
|
|
|
|
|
0
|
my @cmd = @_; |
412
|
0
|
|
|
|
|
0
|
my $cmd = $self->cmd2str(@cmd); |
413
|
0
|
|
|
|
|
0
|
$cmd =~ s/sudo password:\n/sudo password:/; |
414
|
0
|
|
|
|
|
0
|
print STDERR "Running: $cmd\n"; |
415
|
0
|
0
|
|
|
|
0
|
open(my $dh, '-|', @cmd) or |
416
|
|
|
|
|
|
|
die "Cannot run $cmd: $!\n"; |
417
|
0
|
|
|
|
|
0
|
return $dh; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
sub open_cmd_pipe_root { |
421
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
422
|
0
|
0
|
|
|
|
0
|
if ($> != 0) { |
423
|
0
|
|
|
|
|
0
|
return $self->open_cmd_pipe(qw(sudo -S -p), 'sudo password:'."\n", '--', @_); |
424
|
|
|
|
|
|
|
} else { |
425
|
0
|
|
|
|
|
0
|
return $self->open_cmd_pipe(@_); |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
1; |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
########################################################################### |
432
|
|
|
|
|
|
|
package StorageDisplay::Collect::CMD::Proxy::Recorder; |
433
|
|
|
|
|
|
|
|
434
|
1
|
|
|
1
|
|
282
|
use parent -norequire => "StorageDisplay::Collect::CMD"; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
6
|
|
435
|
1
|
|
|
1
|
|
55
|
use Scalar::Util 'blessed'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
840
|
|
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
sub new { |
438
|
0
|
|
|
0
|
|
0
|
my $class = shift; |
439
|
0
|
|
|
|
|
0
|
my %args = ( @_ ); |
440
|
0
|
0
|
|
|
|
0
|
if (not exists($args{'recorder-reader'})) { |
441
|
0
|
|
|
|
|
0
|
die 'recorder-reader argument required'; |
442
|
|
|
|
|
|
|
} |
443
|
0
|
|
|
|
|
0
|
my $reader = $args{'recorder-reader'}; |
444
|
0
|
0
|
|
|
|
0
|
if (ref($reader) eq '') { |
445
|
0
|
|
|
|
|
0
|
my $fullreadername = 'StorageDisplay::Collect::CMD::'.$reader; |
446
|
0
|
|
0
|
|
|
0
|
$reader = $fullreadername->new(@_, %{$args{'recorder-args-pass'} // {}}); |
|
0
|
|
|
|
|
0
|
|
447
|
|
|
|
|
|
|
} |
448
|
0
|
0
|
0
|
|
|
0
|
die "Invalid reader" if not blessed($reader) or not $reader->isa("StorageDisplay::Collect::CMD"); |
449
|
0
|
|
|
|
|
0
|
my $self = $class->SUPER::new(@_); |
450
|
0
|
|
|
|
|
0
|
$self->{'_attr_reader'} = $reader; |
451
|
0
|
|
|
|
|
0
|
return $self; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
sub reader { |
455
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
456
|
0
|
|
|
|
|
0
|
return $self->{_attr_reader}; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub data_finish { |
460
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
461
|
0
|
|
|
|
|
0
|
my $infos = shift; |
462
|
0
|
|
|
|
|
0
|
$infos = $self->SUPER::data_finish($infos); |
463
|
0
|
|
|
|
|
0
|
$infos->{'recorder'} = $self->{_attr_records}; |
464
|
0
|
|
|
|
|
0
|
return $infos; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub _record { |
468
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
469
|
0
|
|
|
|
|
0
|
my $args = { @_ }; |
470
|
0
|
|
|
|
|
0
|
my $dh = $args->{'dh'}; |
471
|
0
|
|
|
|
|
0
|
delete($args->{'dh'}); |
472
|
0
|
|
|
|
|
0
|
my @infos = <$dh>; |
473
|
0
|
|
|
|
|
0
|
@infos = map { chomp; $_ } @infos; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
474
|
0
|
|
|
|
|
0
|
close($dh); |
475
|
0
|
|
|
|
|
0
|
$args->{'stdout'} = \@infos; |
476
|
0
|
|
|
|
|
0
|
push @{$self->{'_attr_records'}}, $args; |
|
0
|
|
|
|
|
0
|
|
477
|
0
|
|
|
|
|
0
|
my $infos = join("\n", @infos); |
478
|
0
|
0
|
|
|
|
0
|
if (scalar(@infos)) { |
479
|
0
|
|
|
|
|
0
|
$infos .= "\n"; |
480
|
|
|
|
|
|
|
} |
481
|
0
|
|
|
|
|
0
|
open(my $fh, "<", \$infos); |
482
|
0
|
|
|
|
|
0
|
return $fh; |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
sub open_cmd_pipe { |
486
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
487
|
0
|
|
|
|
|
0
|
return $self->_record( |
488
|
|
|
|
|
|
|
'root' => 0, |
489
|
|
|
|
|
|
|
'cmd' => [ @_ ], |
490
|
|
|
|
|
|
|
'dh' => $self->reader->open_cmd_pipe(@_), |
491
|
|
|
|
|
|
|
); |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
sub open_cmd_pipe_root { |
495
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
496
|
0
|
|
|
|
|
0
|
return $self->_record( |
497
|
|
|
|
|
|
|
'root' => 1, |
498
|
|
|
|
|
|
|
'cmd' => [ @_ ], |
499
|
|
|
|
|
|
|
'dh' => $self->reader->open_cmd_pipe_root(@_), |
500
|
|
|
|
|
|
|
); |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
sub has_file { |
504
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
505
|
0
|
|
|
|
|
0
|
my $filename = shift; |
506
|
0
|
|
|
|
|
0
|
my $ret = $self->reader->has_file($filename); |
507
|
0
|
|
|
|
|
0
|
push @{$self->{'_attr_records'}}, { |
|
0
|
|
|
|
|
0
|
|
508
|
|
|
|
|
|
|
'filename' => $filename, |
509
|
|
|
|
|
|
|
'value' => $ret, |
510
|
|
|
|
|
|
|
}; |
511
|
0
|
|
|
|
|
0
|
return $ret; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
1; |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
########################################################################### |
517
|
|
|
|
|
|
|
package is_collector; |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
our $CALLER; |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub import { |
522
|
11
|
|
|
11
|
|
25
|
my $class = shift; |
523
|
|
|
|
|
|
|
|
524
|
11
|
|
|
|
|
23
|
my $inheritor = caller(0); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
{ |
527
|
1
|
|
|
1
|
|
14
|
no strict 'refs'; ## no critic |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
173
|
|
|
11
|
|
|
|
|
19
|
|
528
|
11
|
|
|
|
|
15
|
push @{"$inheritor\::ISA"}, 'StorageDisplay::Collect::Collector'; # dies if a loop is detected |
|
11
|
|
|
|
|
143
|
|
529
|
11
|
|
|
|
|
26
|
$CALLER = $inheritor; |
530
|
11
|
|
|
|
|
46
|
StorageDisplay::Collect->registerCollectorModule($inheritor, @_); |
531
|
|
|
|
|
|
|
}; |
532
|
|
|
|
|
|
|
}; |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
BEGIN { |
535
|
|
|
|
|
|
|
# Mark current package as loaded; |
536
|
1
|
|
|
1
|
|
4
|
my $p = __PACKAGE__; |
537
|
1
|
|
|
|
|
4
|
$p =~ s,::,/,g; |
538
|
1
|
|
|
|
|
4815
|
chomp(my $cwd = `pwd`); |
539
|
1
|
|
|
|
|
251
|
$INC{$p.'.pm'} = $cwd.'/'.__FILE__;#k"current file"; |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
1; |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
########################################################################### |
545
|
|
|
|
|
|
|
package StorageDisplay::Collect::Collector; |
546
|
|
|
|
|
|
|
|
547
|
1
|
|
|
1
|
|
1384
|
use Storable; |
|
1
|
|
|
|
|
4183
|
|
|
1
|
|
|
|
|
395
|
|
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
sub open_cmd_pipe { |
550
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
551
|
0
|
|
|
|
|
|
return $self->proxy->open_cmd_pipe(@_); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub open_cmd_pipe_root { |
555
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
556
|
0
|
|
|
|
|
|
return $self->proxy->open_cmd_pipe_root(@_); |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub open_file { |
560
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
561
|
0
|
|
|
|
|
|
return $self->proxy->open_file(@_); |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub has_file { |
565
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
566
|
0
|
|
|
|
|
|
return $self->proxy->has_file(@_); |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
sub collect { |
570
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
571
|
0
|
|
|
|
|
|
print STDERR "collect must be implemented in $self\n"; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub names_avail { |
575
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
576
|
0
|
|
|
|
|
|
print STDERR "names_avail must be implemented in $self\n"; |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
sub import { |
580
|
0
|
|
|
0
|
|
|
print STDERR __PACKAGE__." imported from ".(caller 0)."\n"; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
BEGIN { |
584
|
|
|
|
|
|
|
# Mark current package as loaded; |
585
|
1
|
|
|
1
|
|
6
|
my $p = __PACKAGE__; |
586
|
1
|
|
|
|
|
13
|
$p =~ s,::,/,g; |
587
|
1
|
|
|
|
|
514
|
$INC{$p.'.pm'} = "current file"; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
sub module { |
591
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
592
|
0
|
|
|
|
|
|
return $self->{_attr_module}; |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
sub requires { |
596
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
597
|
0
|
|
|
|
|
|
return @{$self->{_attr_requires}}; |
|
0
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
sub depends { |
601
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
602
|
0
|
|
|
|
|
|
my $kind = shift; |
603
|
|
|
|
|
|
|
return wantarray |
604
|
0
|
|
0
|
|
|
|
? @{$self->{_attr_depends}->{$kind} // []} |
605
|
0
|
0
|
|
|
|
|
: $self->{_attr_depends}->{$kind}; |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
sub provides { |
609
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
610
|
0
|
|
|
|
|
|
return @{$self->{_attr_provides}}; |
|
0
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
sub proxy { |
614
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
615
|
0
|
|
|
|
|
|
return $self->{_attr_collect}; |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
sub select { |
619
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
620
|
0
|
|
|
|
|
|
my $infos = shift; |
621
|
0
|
|
0
|
|
|
|
my $request = shift // {}; |
622
|
0
|
|
|
|
|
|
return $self->names_avail; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub new { |
626
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
627
|
0
|
|
|
|
|
|
my $infos = shift; |
628
|
0
|
|
|
|
|
|
my $collect = shift; |
629
|
|
|
|
|
|
|
|
630
|
0
|
|
|
|
|
|
my $self = {}; |
631
|
0
|
|
|
|
|
|
bless $self, $class; |
632
|
|
|
|
|
|
|
|
633
|
0
|
|
|
|
|
|
$self->{_attr_module} = $infos->{name}; |
634
|
0
|
|
|
|
|
|
$self->{_attr_collect} = $collect; |
635
|
0
|
|
0
|
|
|
|
$self->{_attr_requires} = Storable::dclone($infos->{requires}//[]); |
636
|
0
|
|
0
|
|
|
|
$self->{_attr_provides} = Storable::dclone($infos->{provides}//[]); |
637
|
0
|
|
0
|
|
|
|
$self->{_attr_depends} = Storable::dclone($infos->{depends}//{}); |
638
|
0
|
|
|
|
|
|
$collect->registerCollector($self); |
639
|
|
|
|
|
|
|
|
640
|
0
|
|
|
|
|
|
return $self; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
1; |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
########################################################################### |
646
|
|
|
|
|
|
|
########################################################################### |
647
|
|
|
|
|
|
|
########################################################################### |
648
|
|
|
|
|
|
|
########################################################################### |
649
|
|
|
|
|
|
|
package StorageDisplay::Collect::Host; |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
use is_collector |
652
|
1
|
|
|
|
|
8
|
provides => [ qw(hostname) ], |
653
|
|
|
|
|
|
|
no_names => 1, |
654
|
|
|
|
|
|
|
depends => { |
655
|
|
|
|
|
|
|
progs => [ 'hostname', 'date' ], |
656
|
1
|
|
|
1
|
|
19
|
}; |
|
1
|
|
|
|
|
2
|
|
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub collect { |
659
|
0
|
|
|
0
|
|
|
my $self = shift; |
660
|
0
|
|
|
|
|
|
my $infos = {}; |
661
|
0
|
|
|
|
|
|
my $dh; |
662
|
|
|
|
|
|
|
|
663
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(hostname)); |
664
|
0
|
|
|
|
|
|
my $hostname = <$dh>; |
665
|
0
|
|
|
|
|
|
close $dh; |
666
|
0
|
|
|
|
|
|
chomp($hostname); |
667
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(hostname --fqdn)); |
668
|
0
|
|
|
|
|
|
my $fqdn_hostname = <$dh>; |
669
|
0
|
|
|
|
|
|
close $dh; |
670
|
0
|
|
|
|
|
|
chomp($fqdn_hostname); |
671
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(date --rfc-3339=s)); |
672
|
0
|
|
|
|
|
|
my $date = <$dh>; |
673
|
0
|
|
|
|
|
|
close $dh; |
674
|
0
|
|
|
|
|
|
chomp($date); |
675
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(uname -a)); |
676
|
0
|
|
|
|
|
|
my $uname = <$dh>; |
677
|
0
|
|
|
|
|
|
close $dh; |
678
|
0
|
|
|
|
|
|
chomp($uname); |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
return { |
681
|
0
|
|
|
|
|
|
hostname => $hostname, |
682
|
|
|
|
|
|
|
fqdn_hostname => $fqdn_hostname, |
683
|
|
|
|
|
|
|
date => $date, |
684
|
|
|
|
|
|
|
uname => $uname, |
685
|
|
|
|
|
|
|
}; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
1; |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
########################################################################### |
691
|
|
|
|
|
|
|
package StorageDisplay::Collect::SystemBlocks; |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
use is_collector |
694
|
1
|
|
|
|
|
5
|
provides => [ qw(lsblk lsblk-hierarchy udev) ], |
695
|
|
|
|
|
|
|
no_names => 1, |
696
|
|
|
|
|
|
|
depends => { |
697
|
|
|
|
|
|
|
progs => [ 'lsblk', 'udevadm' ], |
698
|
1
|
|
|
1
|
|
9
|
}; |
|
1
|
|
|
|
|
2
|
|
699
|
|
|
|
|
|
|
|
700
|
1
|
|
|
1
|
|
7
|
use StorageDisplay::Collect::JSON; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
798
|
|
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub lsblkjson2perl { |
703
|
0
|
|
|
0
|
|
|
my $self = shift; |
704
|
0
|
|
|
|
|
|
my $json = shift; |
705
|
|
|
|
|
|
|
my $info = { |
706
|
0
|
|
|
|
|
|
map { $_->{kname} => $_ } |
707
|
0
|
|
|
|
|
|
(@{StorageDisplay::Collect::JSON::decode_json($json) |
708
|
0
|
|
|
|
|
|
->{"blockdevices"}}) |
709
|
|
|
|
|
|
|
}; |
710
|
0
|
|
|
|
|
|
return $info; |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
sub collect { |
714
|
0
|
|
|
0
|
|
|
my $self = shift; |
715
|
0
|
|
|
|
|
|
my $infos = {}; |
716
|
0
|
|
|
|
|
|
my $dh; |
717
|
|
|
|
|
|
|
my $json; |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
# Get all infos on system blocks |
720
|
|
|
|
|
|
|
# 'lsblk-json-hierarchy' -> Str(json) |
721
|
|
|
|
|
|
|
#my $dh=open_cmd_pipe(qw(lsblk --json --bytes --output-all)); |
722
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(lsblk --all --json --output), 'name,kname'); |
723
|
0
|
|
|
|
|
|
$json=join("\n", <$dh>); |
724
|
0
|
|
|
|
|
|
close $dh; |
725
|
0
|
|
|
|
|
|
$infos->{'lsblk-hierarchy'}=$self->lsblkjson2perl($json); |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
# And keep json infos |
728
|
|
|
|
|
|
|
# 'lsblk-json' -> kn -> Str(json) |
729
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(lsblk --all --json --bytes --output-all --list)); |
730
|
0
|
|
|
|
|
|
$infos->{'lsblk'}=$self->lsblkjson2perl(join("\n", <$dh>)); |
731
|
0
|
|
|
|
|
|
close $dh; |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
# Get all infos with udev |
734
|
|
|
|
|
|
|
# 'udev' -> kn -> |
735
|
|
|
|
|
|
|
# - 'path' -> Str(P:) |
736
|
|
|
|
|
|
|
# - 'name' -> Str(N:) |
737
|
|
|
|
|
|
|
# - 'names' -> [ N:, S:... ] |
738
|
|
|
|
|
|
|
# - '_udev_infos' -> id -> Str(val) |
739
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(udevadm info --query all --export-db)); |
740
|
0
|
|
|
|
|
|
my $data={'_udev_infos' => {}}; |
741
|
0
|
|
|
|
|
|
my $dname; |
742
|
|
|
|
|
|
|
my $lastline; |
743
|
0
|
|
|
|
|
|
while (defined(my $line=<$dh>)) { |
744
|
0
|
|
|
|
|
|
chomp($line); |
745
|
0
|
|
|
|
|
|
$lastline=$line; |
746
|
0
|
0
|
|
|
|
|
if ($line eq '') { |
747
|
0
|
0
|
|
|
|
|
if (defined($dname)) { |
748
|
0
|
0
|
|
|
|
|
if (exists($data->{'names'})) { |
749
|
0
|
|
|
|
|
|
my @sorted_names=sort @{$data->{'names'}}; |
|
0
|
|
|
|
|
|
|
750
|
0
|
|
|
|
|
|
$data->{'names'}=\@sorted_names; |
751
|
|
|
|
|
|
|
} |
752
|
0
|
|
|
|
|
|
$infos->{'udev'}->{$dname}=$data; |
753
|
|
|
|
|
|
|
} else { |
754
|
|
|
|
|
|
|
#print STDERR "No 'N:' tag in udev entry ".($data->[0]//"")."\n"; |
755
|
|
|
|
|
|
|
} |
756
|
0
|
|
|
|
|
|
$data={'_udev_infos' => {}}; |
757
|
0
|
|
|
|
|
|
$dname=undef; |
758
|
|
|
|
|
|
|
} else { |
759
|
0
|
0
|
|
|
|
|
if ($line =~ /^P: (.*)$/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
760
|
0
|
|
|
|
|
|
$data->{'path'}=$1; |
761
|
|
|
|
|
|
|
} elsif ($line =~ /^N: (.*)$/) { |
762
|
0
|
|
|
|
|
|
$dname=$1; |
763
|
0
|
|
|
|
|
|
$data->{'name'}=$1; |
764
|
0
|
|
|
|
|
|
push @{$data->{'names'}}, $1; |
|
0
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
} elsif ($line =~ /^S: (.*)$/) { |
766
|
0
|
|
|
|
|
|
push @{$data->{'names'}}, $1; |
|
0
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
} elsif ($line =~ /^E: (DEVLINKS)=(.*)$/) { |
768
|
0
|
|
|
|
|
|
$data->{'_udev_infos'}->{$1}=join(' ', sort(split(' ',$2))); |
769
|
|
|
|
|
|
|
} elsif ($line =~ /^E: ([^=]*)=(.*)$/) { |
770
|
0
|
|
|
|
|
|
$data->{'_udev_infos'}->{$1}=$2; |
771
|
|
|
|
|
|
|
} elsif ($line =~ /^[MRUTDILQV]: .*$/) { |
772
|
|
|
|
|
|
|
# Unused info. See udevadm(8) / Table 1 for more info |
773
|
|
|
|
|
|
|
} else { |
774
|
0
|
0
|
|
|
|
|
print STDERR "Ignoring '$line'".(defined($dname)?(' for '.$dname):'')."\n"; |
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
} |
778
|
0
|
|
|
|
|
|
close $dh; |
779
|
0
|
0
|
|
|
|
|
if(defined($dname)) { |
780
|
0
|
|
|
|
|
|
die "E: pb avec $dname ($lastline)", "\n"; |
781
|
|
|
|
|
|
|
} |
782
|
0
|
|
|
|
|
|
return $infos; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
1; |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
########################################################################### |
788
|
|
|
|
|
|
|
package StorageDisplay::Collect::DeviceMapper; |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
use is_collector |
791
|
1
|
|
|
|
|
10
|
provides => qw(dm), |
792
|
|
|
|
|
|
|
depends => { |
793
|
|
|
|
|
|
|
progs => [ 'dmsetup' ], |
794
|
|
|
|
|
|
|
root => 1, |
795
|
1
|
|
|
1
|
|
10
|
}; |
|
1
|
|
|
|
|
4
|
|
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
sub collect { |
798
|
0
|
|
|
0
|
|
|
my $self = shift; |
799
|
0
|
|
|
|
|
|
my $dm={}; |
800
|
0
|
|
|
|
|
|
my $dh; |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
# Get all infos with dmsetup |
803
|
|
|
|
|
|
|
# 'dm' -> kn -> |
804
|
|
|
|
|
|
|
# DM_NAME |
805
|
|
|
|
|
|
|
# DM_BLKDEVNAME |
806
|
|
|
|
|
|
|
# DM_BLKDEVS_USED |
807
|
|
|
|
|
|
|
# DM_SUBSYSTEM |
808
|
|
|
|
|
|
|
# DM_DEVS_USED |
809
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(dmsetup info -c --nameprefix --noheadings -o), |
810
|
|
|
|
|
|
|
'name,blkdevname,blkdevs_used,subsystem,devs_used', |
811
|
|
|
|
|
|
|
'--separator', "\n "); |
812
|
0
|
|
|
|
|
|
my $data={}; |
813
|
0
|
|
|
|
|
|
my $dname; |
814
|
0
|
|
|
|
|
|
while (defined(my $line=<$dh>)) { |
815
|
0
|
|
|
|
|
|
chomp($line); |
816
|
0
|
0
|
|
|
|
|
next if $line eq 'No devices found'; |
817
|
0
|
0
|
|
|
|
|
if ($line =~ /^DM_/) { |
818
|
0
|
0
|
|
|
|
|
if (defined($dname)) { |
819
|
0
|
|
|
|
|
|
$dm->{$dname}=$data; |
820
|
|
|
|
|
|
|
} else { |
821
|
|
|
|
|
|
|
#print STDERR "No 'N:' tag in udev entry ".($data->[0]//"")."\n"; |
822
|
|
|
|
|
|
|
} |
823
|
0
|
|
|
|
|
|
$data={}; |
824
|
0
|
|
|
|
|
|
$dname=undef; |
825
|
|
|
|
|
|
|
} |
826
|
0
|
0
|
|
|
|
|
if ($line =~ /^ ?(DM_[^=]*)='(.*)'$/) { |
827
|
0
|
0
|
|
|
|
|
if ($2 ne '') { |
828
|
0
|
|
|
|
|
|
$data->{$1} = $2; |
829
|
|
|
|
|
|
|
} |
830
|
0
|
0
|
|
|
|
|
if ($1 eq 'DM_BLKDEVNAME') { |
831
|
0
|
|
|
|
|
|
$dname = $2; |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
} else { |
834
|
0
|
0
|
|
|
|
|
print STDERR "Ignoring '$line'".(defined($dname)?(' for '.$dname):'')."\n"; |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
} |
837
|
0
|
0
|
|
|
|
|
if (defined($dname)) { |
838
|
0
|
|
|
|
|
|
$dm->{$dname}=$data; |
839
|
|
|
|
|
|
|
} |
840
|
0
|
|
|
|
|
|
close $dh; |
841
|
0
|
|
|
|
|
|
return { 'dm' => $dm }; |
842
|
|
|
|
|
|
|
} |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
1; |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
########################################################################### |
847
|
|
|
|
|
|
|
package StorageDisplay::Collect::Partitions; |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
use is_collector |
850
|
1
|
|
|
|
|
20
|
provides => [ qw(partitions disks-no-part)], |
851
|
|
|
|
|
|
|
requires => [ qw(lsblk udev) ], |
852
|
|
|
|
|
|
|
depends => { |
853
|
|
|
|
|
|
|
progs => [ 'parted' ], |
854
|
|
|
|
|
|
|
root => 1, |
855
|
1
|
|
|
1
|
|
23
|
}; |
|
1
|
|
|
|
|
4
|
|
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
sub select { |
858
|
0
|
|
|
0
|
|
|
my $self = shift; |
859
|
0
|
|
|
|
|
|
my $infos = shift; |
860
|
0
|
|
0
|
|
|
|
my $request = shift // {}; |
861
|
0
|
|
|
|
|
|
my @devs=(); |
862
|
|
|
|
|
|
|
|
863
|
0
|
|
|
|
|
|
foreach my $kn (sort keys %{$infos->{'lsblk'}}) { |
|
0
|
|
|
|
|
|
|
864
|
0
|
|
|
|
|
|
my $udev_info = $infos->{'udev'}->{$kn}; |
865
|
0
|
|
|
|
|
|
my $lsblk_info = $infos->{'lsblk'}->{$kn}; |
866
|
0
|
0
|
|
|
|
|
next if not defined($udev_info); |
867
|
0
|
0
|
0
|
|
|
|
if (($udev_info->{'_udev_infos'}->{DEVTYPE} // '') ne 'disk') { |
868
|
0
|
|
|
|
|
|
next; |
869
|
|
|
|
|
|
|
} |
870
|
0
|
0
|
0
|
|
|
|
if (($udev_info->{'_udev_infos'}->{ID_PART_TABLE_TYPE} // '') eq '') { |
871
|
0
|
0
|
0
|
|
|
|
if (($lsblk_info->{'rm'} // 0) == 1) { |
872
|
|
|
|
|
|
|
# removed disk (cd, ...), skipping |
873
|
0
|
|
|
|
|
|
next; |
874
|
|
|
|
|
|
|
} |
875
|
0
|
0
|
0
|
|
|
|
if (($lsblk_info->{'type'} // '') eq 'loop' |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
876
|
|
|
|
|
|
|
&& ($lsblk_info->{'size'} // 0) == 0) { |
877
|
|
|
|
|
|
|
# loop device not attached |
878
|
0
|
|
|
|
|
|
next; |
879
|
|
|
|
|
|
|
} |
880
|
0
|
0
|
0
|
|
|
|
if (($lsblk_info->{'type'} // '') eq 'lvm') { |
881
|
|
|
|
|
|
|
# handled by lvm subsystem |
882
|
0
|
|
|
|
|
|
next; |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
# disk with no partition, just get it |
885
|
0
|
|
|
|
|
|
push @devs, $kn; |
886
|
0
|
|
|
|
|
|
next; |
887
|
|
|
|
|
|
|
} |
888
|
0
|
0
|
0
|
|
|
|
if ( |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
889
|
|
|
|
|
|
|
($udev_info->{'_udev_infos'}->{ID_PART_TABLE_TYPE} // '') eq 'dos' |
890
|
|
|
|
|
|
|
&& ($udev_info->{'_udev_infos'}->{ID_PART_ENTRY_NUMBER} // '') ne '' |
891
|
|
|
|
|
|
|
&& ($udev_info->{'_udev_infos'}->{DM_TYPE} // '') eq 'raid' |
892
|
|
|
|
|
|
|
) { |
893
|
0
|
|
|
|
|
|
print STDERR "I: $kn seems to be a dm-mapped extended dos partition. Skipping it as disk\n"; |
894
|
|
|
|
|
|
|
#$partitions->{$kn}->{"dos-extended"}=1; |
895
|
0
|
|
|
|
|
|
next; |
896
|
|
|
|
|
|
|
} |
897
|
0
|
|
|
|
|
|
push @devs, $kn; |
898
|
|
|
|
|
|
|
} |
899
|
0
|
|
|
|
|
|
return @devs; |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
sub collect { |
903
|
0
|
|
|
0
|
|
|
my $self = shift; |
904
|
0
|
|
|
|
|
|
my $infos = shift; |
905
|
0
|
|
|
|
|
|
my $partitions; |
906
|
|
|
|
|
|
|
my $noparts; |
907
|
0
|
|
|
|
|
|
my $dh; |
908
|
|
|
|
|
|
|
|
909
|
0
|
|
|
|
|
|
my @devs=$self->select($infos); |
910
|
|
|
|
|
|
|
|
911
|
0
|
|
|
|
|
|
foreach my $kn (@devs) { |
912
|
0
|
|
|
|
|
|
my $udev_info = $infos->{'udev'}->{$kn}; |
913
|
0
|
0
|
0
|
|
|
|
if (($udev_info->{'_udev_infos'}->{ID_PART_TABLE_TYPE} // '') eq '') { |
914
|
0
|
|
|
|
|
|
$noparts->{$kn}={'no partitions' => 1}; |
915
|
0
|
|
|
|
|
|
next; |
916
|
|
|
|
|
|
|
} |
917
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(parted -m -s), "/dev/".$kn, qw(unit B print free)); |
918
|
0
|
|
|
|
|
|
my $state=0; |
919
|
0
|
|
|
|
|
|
my $parted={ 'parts' => [] }; |
920
|
0
|
|
|
|
|
|
my $startline = ''; |
921
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
922
|
0
|
|
|
|
|
|
chomp($line); |
923
|
0
|
|
|
|
|
|
my $multiline = 0; |
924
|
0
|
0
|
|
|
|
|
if ($startline ne '') { |
925
|
0
|
|
|
|
|
|
$line = $startline . $line; |
926
|
0
|
|
|
|
|
|
$multiline = 1; |
927
|
|
|
|
|
|
|
} |
928
|
0
|
0
|
|
|
|
|
if ($line !~ /;$/) { |
929
|
0
|
|
|
|
|
|
$startline = $line; |
930
|
0
|
|
|
|
|
|
next; |
931
|
|
|
|
|
|
|
} |
932
|
0
|
|
|
|
|
|
$startline = ''; |
933
|
0
|
0
|
|
|
|
|
if ($state == 0) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
934
|
0
|
0
|
|
|
|
|
if ($line eq "BYT;") { |
935
|
0
|
|
|
|
|
|
$state = 1; |
936
|
0
|
|
|
|
|
|
next; |
937
|
|
|
|
|
|
|
} |
938
|
|
|
|
|
|
|
} elsif ($state == 1) { |
939
|
0
|
0
|
|
|
|
|
if ($line =~ /.*:([0-9]+)B:[^:]*:[0-9]+:[0-9]+:([^:]*):(.*):;/) { |
940
|
0
|
|
|
|
|
|
$parted->{size} = $1; |
941
|
0
|
|
|
|
|
|
$parted->{type} = $2; |
942
|
0
|
|
|
|
|
|
$parted->{label} = $3; |
943
|
0
|
|
|
|
|
|
$state = 2; |
944
|
0
|
|
|
|
|
|
next; |
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
} elsif ($state == 2) { |
947
|
0
|
0
|
|
|
|
|
if ($line =~ m/^1:([0-9]+)B:[0-9]+B:([0-9]+)B:free;$/) { |
|
|
0
|
|
|
|
|
|
948
|
0
|
|
|
|
|
|
push @{$parted->{parts}}, { |
|
0
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
'kind' => 'free', |
950
|
|
|
|
|
|
|
'start' => $1, |
951
|
|
|
|
|
|
|
'size' => $2, |
952
|
|
|
|
|
|
|
}; |
953
|
0
|
|
|
|
|
|
next; |
954
|
|
|
|
|
|
|
} elsif ($line =~ m/^([0-9]+):([0-9]+)B:[0-9]+B:([0-9]+)B:[^:]*:(.*):([^:]*);$/) { |
955
|
0
|
|
|
|
|
|
push @{$parted->{parts}}, { |
|
0
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
'kind' => 'part', |
957
|
|
|
|
|
|
|
'id' => $1, |
958
|
|
|
|
|
|
|
'start' => $2, |
959
|
|
|
|
|
|
|
'size' => $3, |
960
|
|
|
|
|
|
|
'label' => $4, |
961
|
|
|
|
|
|
|
'flags' => $5, |
962
|
|
|
|
|
|
|
}; |
963
|
0
|
0
|
|
|
|
|
if ($multiline) { |
964
|
0
|
|
|
|
|
|
my $label = $4; |
965
|
0
|
0
|
|
|
|
|
if ($label =~ /^Project-Id.*Content-Transfer-Encoding: 8bit$/) { |
966
|
|
|
|
|
|
|
# workaround a parted bug with xfs partitions (at least) |
967
|
0
|
|
|
|
|
|
$parted->{parts}->[-1]->{'label'}=''; |
968
|
|
|
|
|
|
|
} |
969
|
|
|
|
|
|
|
} |
970
|
0
|
|
|
|
|
|
next; |
971
|
|
|
|
|
|
|
} |
972
|
|
|
|
|
|
|
} |
973
|
0
|
|
|
|
|
|
print STDERR "W: parted on $kn: Unknown line '$line'\n"; |
974
|
|
|
|
|
|
|
} |
975
|
0
|
|
|
|
|
|
close($dh); |
976
|
0
|
0
|
|
|
|
|
if ($state != 2) { |
977
|
0
|
|
|
|
|
|
print STDERR "W: parted on $kn: invalid data (skipping device)\n"; |
978
|
0
|
|
|
|
|
|
next; |
979
|
|
|
|
|
|
|
} |
980
|
0
|
0
|
|
|
|
|
if ($udev_info->{'_udev_infos'}->{ID_PART_TABLE_TYPE} eq 'dos') { |
981
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(parted -s), "/dev/".$kn, qw(print)); |
982
|
0
|
|
|
|
|
|
$state=0; |
983
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
984
|
0
|
|
|
|
|
|
chomp($line); |
985
|
0
|
0
|
|
|
|
|
if ($line =~ /^\s([1234]) .* extended( .*)?$/) { |
986
|
0
|
|
|
|
|
|
$parted->{extended} = $1; |
987
|
0
|
|
|
|
|
|
last; |
988
|
|
|
|
|
|
|
} |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
} |
991
|
0
|
|
|
|
|
|
$partitions->{$kn}=$parted; |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
return { |
994
|
0
|
|
|
|
|
|
'partitions' => $partitions, |
995
|
|
|
|
|
|
|
'disks-no-part' => $noparts, |
996
|
|
|
|
|
|
|
}; |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
1; |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
########################################################################### |
1002
|
|
|
|
|
|
|
package StorageDisplay::Collect::LVM; |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
use is_collector |
1005
|
1
|
|
|
|
|
13
|
provides => 'lvm', |
1006
|
|
|
|
|
|
|
depends => { |
1007
|
|
|
|
|
|
|
progs => [ 'lvm' ], |
1008
|
|
|
|
|
|
|
root => 1, |
1009
|
1
|
|
|
1
|
|
11
|
}; |
|
1
|
|
|
|
|
2
|
|
1010
|
|
|
|
|
|
|
|
1011
|
1
|
|
|
1
|
|
7
|
use StorageDisplay::Collect::JSON; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
672
|
|
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
sub lvmjson2perl { |
1014
|
0
|
|
|
0
|
|
|
my $self = shift; |
1015
|
0
|
|
|
|
|
|
my $kind = shift; |
1016
|
0
|
|
|
|
|
|
my $kstore = shift; |
1017
|
0
|
|
|
|
|
|
my $uniq = shift; |
1018
|
0
|
|
|
|
|
|
my $keys = shift; |
1019
|
0
|
|
0
|
|
|
|
my $info = shift // {}; |
1020
|
0
|
|
|
|
|
|
my $json = shift; |
1021
|
|
|
|
|
|
|
my $alldata = StorageDisplay::Collect::JSON::decode_json($json) |
1022
|
0
|
|
|
|
|
|
->{'report'}->[0]->{$kind}; |
1023
|
0
|
|
|
|
|
|
foreach my $data (@$alldata) { |
1024
|
0
|
|
0
|
|
|
|
my $vg=$data->{vg_name} // die "no vg_name in data!"; |
1025
|
0
|
|
|
|
|
|
my $base = $info->{$vg}->{$kstore}; |
1026
|
0
|
|
|
|
|
|
my $hashs = [ [$info->{$vg}, $kstore] ]; |
1027
|
0
|
0
|
|
|
|
|
if (scalar(@$keys) == 1) { |
|
|
0
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
# force creation of $info->{$vg}->{$kstore} hash if needed |
1029
|
0
|
|
|
|
|
|
my $dummy=$info->{$vg}->{$kstore}->{$data->{$keys->[0]}}; |
1030
|
|
|
|
|
|
|
$hashs = [ [ $info->{$vg}->{$kstore}, |
1031
|
0
|
|
|
|
|
|
$data->{$keys->[0]} ] ]; |
1032
|
|
|
|
|
|
|
} elsif (scalar(@$keys) > 1) { |
1033
|
|
|
|
|
|
|
$hashs = [ |
1034
|
|
|
|
|
|
|
map { |
1035
|
|
|
|
|
|
|
# force creation of $info->{$vg}->{$kstore}->{$_} hash if needed |
1036
|
0
|
|
|
|
|
|
my $dummy=$info->{$vg}->{$kstore}->{$_}->{$data->{$_}}; |
|
0
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
[ $info->{$vg}->{$kstore}->{$_}, |
1038
|
0
|
|
|
|
|
|
$data->{$_} ] |
1039
|
|
|
|
|
|
|
} @$keys |
1040
|
|
|
|
|
|
|
]; |
1041
|
|
|
|
|
|
|
} |
1042
|
0
|
|
|
|
|
|
foreach my $i (@$hashs) { |
1043
|
0
|
|
|
|
|
|
my ($h, $k) = @$i; |
1044
|
0
|
0
|
|
|
|
|
if ($uniq) { |
1045
|
0
|
0
|
|
|
|
|
die "duplicate info" if defined($h->{$k}); |
1046
|
0
|
|
|
|
|
|
$h->{$k} = $data; |
1047
|
|
|
|
|
|
|
} else { |
1048
|
0
|
|
|
|
|
|
push @{$h->{$k}}, $data; |
|
0
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
} |
1050
|
|
|
|
|
|
|
} |
1051
|
|
|
|
|
|
|
} |
1052
|
0
|
|
|
|
|
|
return $info; |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
sub collect { |
1056
|
0
|
|
|
0
|
|
|
my $self = shift; |
1057
|
0
|
|
|
|
|
|
my $dh; |
1058
|
0
|
|
|
|
|
|
my $lvm = {}; |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
# Get all infos on LVM |
1061
|
|
|
|
|
|
|
# 'lvm' -> 'pv'| -> Str(json) |
1062
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root( |
1063
|
|
|
|
|
|
|
qw(lvm pvs --units B --reportformat json --all -o), |
1064
|
|
|
|
|
|
|
'pv_name,pv_size,pv_free,pv_used,seg_size,seg_start,segtype,pvseg_start,pvseg_size,lv_name,lv_role,vg_name', |
1065
|
|
|
|
|
|
|
'--select', 'pv_size > 0 || vg_name != ""'); |
1066
|
0
|
|
|
|
|
|
$self->lvmjson2perl('pv', 'pvs', 0, [], $lvm, join("\n", <$dh>)); |
1067
|
0
|
|
|
|
|
|
close $dh; |
1068
|
|
|
|
|
|
|
|
1069
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root( |
1070
|
|
|
|
|
|
|
qw(lvm lvs --units B --reportformat json --all -o), |
1071
|
|
|
|
|
|
|
'lv_name,seg_size,segtype,seg_start,seg_pe_ranges,seg_le_ranges,vgname,devices,pool_lv,lv_parent'); |
1072
|
0
|
|
|
|
|
|
$self->lvmjson2perl('lv', 'lvs', 0, [], $lvm, join("\n", <$dh>)); |
1073
|
0
|
|
|
|
|
|
close $dh; |
1074
|
|
|
|
|
|
|
|
1075
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root( |
1076
|
|
|
|
|
|
|
qw(lvm vgs --units B --reportformat json --all -o), |
1077
|
|
|
|
|
|
|
'vg_name,vg_size,vg_free'); |
1078
|
0
|
|
|
|
|
|
$self->lvmjson2perl('vg', 'vgs-vg', 1, [], $lvm, join("\n", <$dh>)); |
1079
|
0
|
|
|
|
|
|
close $dh; |
1080
|
|
|
|
|
|
|
|
1081
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root( |
1082
|
|
|
|
|
|
|
qw(lvm vgs --units B --reportformat json --all -o), |
1083
|
|
|
|
|
|
|
'vg_name,pv_name,pv_size,pv_free,pv_used'); |
1084
|
0
|
|
|
|
|
|
$self->lvmjson2perl('vg', 'vgs-pv', 1, ['pv_name'], $lvm, join("\n", <$dh>)); |
1085
|
0
|
|
|
|
|
|
close $dh; |
1086
|
|
|
|
|
|
|
|
1087
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root( |
1088
|
|
|
|
|
|
|
qw(lvm vgs --units B --reportformat json --all -o), |
1089
|
|
|
|
|
|
|
'vg_name,lv_name,lv_size,data_percent,origin,pool_lv,lv_role'); |
1090
|
0
|
|
|
|
|
|
$self->lvmjson2perl('vg', 'vgs-lv', 1, ['lv_name'], $lvm, join("\n", <$dh>)); |
1091
|
0
|
|
|
|
|
|
close $dh; |
1092
|
|
|
|
|
|
|
|
1093
|
0
|
|
|
|
|
|
return {'lvm' => $lvm }; |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
1; |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
########################################################################### |
1099
|
|
|
|
|
|
|
package StorageDisplay::Collect::FS; |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
use is_collector |
1102
|
1
|
|
|
|
|
6
|
provides => 'fs', |
1103
|
|
|
|
|
|
|
no_names => 1, |
1104
|
|
|
|
|
|
|
depends => { |
1105
|
|
|
|
|
|
|
progs => [ '/sbin/swapon', 'df', 'findmnt', 'stat' ], |
1106
|
|
|
|
|
|
|
root => 1, |
1107
|
1
|
|
|
1
|
|
8
|
}; |
|
1
|
|
|
|
|
3
|
|
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
sub collect { |
1110
|
0
|
|
|
0
|
|
|
my $self = shift; |
1111
|
0
|
|
|
|
|
|
my $dh; |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
# Swap and mounted FS |
1114
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(/sbin/swapon --noheadings --raw --bytes), |
1115
|
|
|
|
|
|
|
'--show=NAME,TYPE,SIZE,USED'); |
1116
|
0
|
|
|
|
|
|
my $fs={}; |
1117
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1118
|
0
|
|
|
|
|
|
chomp($line); |
1119
|
0
|
0
|
|
|
|
|
if ($line =~ m,([^ ]+) (partition|file) ([0-9]+) ([0-9]+)$,) { |
|
|
0
|
|
|
|
|
|
1120
|
0
|
|
|
|
|
|
my $info={ |
1121
|
|
|
|
|
|
|
size => $3, |
1122
|
|
|
|
|
|
|
used => $4, |
1123
|
|
|
|
|
|
|
free => ''.($3-$4), |
1124
|
|
|
|
|
|
|
fstype => $2, |
1125
|
|
|
|
|
|
|
mountpoint => 'SWAP', |
1126
|
|
|
|
|
|
|
}; |
1127
|
0
|
|
|
|
|
|
my $dev = $1; |
1128
|
0
|
0
|
|
|
|
|
if ($2 eq 'file') { |
1129
|
0
|
|
|
|
|
|
my $dh2=$self->open_cmd_pipe_root(qw(findmnt -n -o TARGET --target), $1); |
1130
|
0
|
|
|
|
|
|
my $mountpoint = <$dh2>; |
1131
|
0
|
0
|
|
|
|
|
chomp($mountpoint) if defined($mountpoint); |
1132
|
0
|
|
|
|
|
|
close $dh2; |
1133
|
0
|
|
|
|
|
|
$info->{'file-mountpoint'}=$mountpoint; |
1134
|
0
|
|
|
|
|
|
$dh2=$self->open_cmd_pipe_root(qw(stat -c %s), $1); |
1135
|
0
|
|
|
|
|
|
my $size = <$dh2>; |
1136
|
0
|
|
|
|
|
|
chomp($size); |
1137
|
0
|
|
|
|
|
|
close $dh2; |
1138
|
0
|
|
|
|
|
|
$info->{'file-size'}=$size; |
1139
|
|
|
|
|
|
|
} |
1140
|
0
|
|
|
|
|
|
$fs->{$dev} = $info; |
1141
|
|
|
|
|
|
|
} elsif ($line =~ m,([^ ]+) ([^ ]+) ([0-9]+) ([0-9]+)$,) { |
1142
|
|
|
|
|
|
|
# skipping other kind of swap |
1143
|
|
|
|
|
|
|
} else { |
1144
|
0
|
|
|
|
|
|
print STDERR "W: swapon: Unknown line '$line'\n"; |
1145
|
|
|
|
|
|
|
} |
1146
|
|
|
|
|
|
|
} |
1147
|
0
|
|
|
|
|
|
close $dh; |
1148
|
|
|
|
|
|
|
|
1149
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(df -B1 --local), |
1150
|
|
|
|
|
|
|
'--output=source,fstype,size,used,avail,target'); |
1151
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1152
|
0
|
|
|
|
|
|
chomp($line); |
1153
|
0
|
0
|
|
|
|
|
next if $line !~ m,^/,; |
1154
|
0
|
|
|
|
|
|
my @i=split(/\s+/, $line); |
1155
|
0
|
|
|
|
|
|
$fs->{$i[0]} = { |
1156
|
|
|
|
|
|
|
fstype => $i[1], |
1157
|
|
|
|
|
|
|
size => $i[2], |
1158
|
|
|
|
|
|
|
used => $i[3], |
1159
|
|
|
|
|
|
|
free => $i[4], |
1160
|
|
|
|
|
|
|
mountpoint => $i[5], |
1161
|
|
|
|
|
|
|
}; |
1162
|
|
|
|
|
|
|
} |
1163
|
0
|
|
|
|
|
|
close $dh; |
1164
|
|
|
|
|
|
|
|
1165
|
0
|
|
|
|
|
|
return { 'fs' => $fs }; |
1166
|
|
|
|
|
|
|
} |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
1; |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
########################################################################### |
1171
|
|
|
|
|
|
|
package StorageDisplay::Collect::LUKS; |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
use is_collector |
1174
|
1
|
|
|
|
|
5
|
provides => 'luks', |
1175
|
|
|
|
|
|
|
requires => [ qw(dm lsblk udev) ], |
1176
|
|
|
|
|
|
|
depends => { |
1177
|
|
|
|
|
|
|
progs => [ 'cryptsetup' ], |
1178
|
|
|
|
|
|
|
root => 1, |
1179
|
1
|
|
|
1
|
|
9
|
}; |
|
1
|
|
|
|
|
3
|
|
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
sub select { |
1182
|
0
|
|
|
0
|
|
|
my $self = shift; |
1183
|
0
|
|
|
|
|
|
my $infos = shift; |
1184
|
0
|
|
0
|
|
|
|
my $request = shift // {}; |
1185
|
0
|
|
|
|
|
|
my @devs=(); |
1186
|
|
|
|
|
|
|
|
1187
|
0
|
|
|
|
|
|
my $dh; |
1188
|
0
|
|
|
|
|
|
foreach my $kn (sort keys %{$infos->{'lsblk'}}) { |
|
0
|
|
|
|
|
|
|
1189
|
0
|
|
|
|
|
|
my $udev_info = $infos->{'udev'}->{$kn}; |
1190
|
0
|
0
|
|
|
|
|
next if not defined($udev_info); |
1191
|
0
|
0
|
0
|
|
|
|
if (($udev_info->{'_udev_infos'}->{ID_FS_TYPE} // '') ne 'crypto_LUKS') { |
1192
|
0
|
|
|
|
|
|
next; |
1193
|
|
|
|
|
|
|
} |
1194
|
0
|
|
|
|
|
|
push @devs, $kn; |
1195
|
|
|
|
|
|
|
} |
1196
|
0
|
|
|
|
|
|
return @devs; |
1197
|
|
|
|
|
|
|
} |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
sub collect { |
1200
|
0
|
|
|
0
|
|
|
my $self = shift; |
1201
|
0
|
|
|
|
|
|
my $infos = shift; |
1202
|
0
|
|
|
|
|
|
my $dh; |
1203
|
0
|
|
|
|
|
|
my $luks={}; |
1204
|
|
|
|
|
|
|
|
1205
|
0
|
|
|
|
|
|
my @devs=$self->select($infos); |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
my $decrypted={ |
1208
|
|
|
|
|
|
|
map { |
1209
|
|
|
|
|
|
|
$_->{DM_BLKDEVS_USED} => $_->{DM_BLKDEVNAME} |
1210
|
0
|
|
|
|
|
|
} grep { |
1211
|
0
|
|
0
|
|
|
|
($_->{DM_SUBSYSTEM} // '') eq 'CRYPT' |
1212
|
0
|
|
|
|
|
|
} values(%{$infos->{dm}}) |
|
0
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
}; |
1214
|
|
|
|
|
|
|
|
1215
|
0
|
|
|
|
|
|
foreach my $dev (@devs) { |
1216
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root( |
1217
|
|
|
|
|
|
|
qw(cryptsetup luksDump), '/dev/'.$dev); |
1218
|
0
|
|
|
|
|
|
my $l={}; |
1219
|
0
|
|
|
|
|
|
my $luks_header=0; |
1220
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1221
|
0
|
|
|
|
|
|
chomp($line); |
1222
|
0
|
0
|
|
|
|
|
if ($line =~ /^LUKS header information/) { |
|
|
0
|
|
|
|
|
|
1223
|
0
|
|
|
|
|
|
$luks_header=1; |
1224
|
|
|
|
|
|
|
} elsif ($line =~ /^Version:\s*([^\s]*)$/) { |
1225
|
0
|
|
|
|
|
|
$l->{VERSION} = $1; |
1226
|
|
|
|
|
|
|
} |
1227
|
|
|
|
|
|
|
} |
1228
|
0
|
|
|
|
|
|
close $dh; |
1229
|
0
|
0
|
|
|
|
|
if ($luks_header) { |
1230
|
0
|
|
|
|
|
|
$l->{decrypted} = $decrypted->{$dev}; |
1231
|
0
|
|
|
|
|
|
$luks->{$dev} = $l; |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
} |
1234
|
|
|
|
|
|
|
|
1235
|
0
|
|
|
|
|
|
return { 'luks' => $luks }; |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
1; |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
########################################################################### |
1241
|
|
|
|
|
|
|
package StorageDisplay::Collect::MD; |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
use is_collector |
1244
|
1
|
|
|
|
|
17
|
provides => 'md', |
1245
|
|
|
|
|
|
|
requires => [ qw(dm lsblk udev) ], |
1246
|
|
|
|
|
|
|
depends => { |
1247
|
|
|
|
|
|
|
files => [ '/proc/mdstat' ], |
1248
|
|
|
|
|
|
|
progs => [ 'mdadm' ], |
1249
|
|
|
|
|
|
|
root => 1, |
1250
|
1
|
|
|
1
|
|
9
|
}; |
|
1
|
|
|
|
|
3
|
|
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
sub names_avail { |
1253
|
0
|
|
|
0
|
|
|
my $self = shift; |
1254
|
0
|
|
|
|
|
|
my $infos = shift; |
1255
|
0
|
|
|
|
|
|
my @devs=(); |
1256
|
|
|
|
|
|
|
|
1257
|
0
|
|
|
|
|
|
my $dh=$self->open_file('/proc/mdstat'); |
1258
|
0
|
|
|
|
|
|
while (defined(my $line=<$dh>)) { |
1259
|
0
|
|
|
|
|
|
chomp($line); |
1260
|
0
|
0
|
|
|
|
|
next if ($line =~ /^Personalities/); |
1261
|
0
|
0
|
|
|
|
|
next if ($line =~ /^unused devices/); |
1262
|
0
|
0
|
|
|
|
|
next if ($line =~ /^\s/); |
1263
|
0
|
|
|
|
|
|
push @devs, ((split(/\s/, $line))[0]); |
1264
|
|
|
|
|
|
|
} |
1265
|
0
|
|
|
|
|
|
close $dh; |
1266
|
0
|
|
|
|
|
|
return @devs; |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
sub collect { |
1270
|
0
|
|
|
0
|
|
|
my $self = shift; |
1271
|
0
|
|
|
|
|
|
my $infos = shift; |
1272
|
0
|
|
0
|
|
|
|
my @devs = @{ shift // [ $self->select($infos) ] }; |
|
0
|
|
|
|
|
|
|
1273
|
0
|
|
|
|
|
|
my $dh; |
1274
|
0
|
|
|
|
|
|
my $md={}; |
1275
|
|
|
|
|
|
|
|
1276
|
0
|
|
|
|
|
|
foreach my $dev (@devs) { |
1277
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root( |
1278
|
|
|
|
|
|
|
qw(mdadm --misc --detail), '/dev/'.$dev); |
1279
|
0
|
|
|
|
|
|
my $l={}; |
1280
|
0
|
|
|
|
|
|
my $container=0; |
1281
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1282
|
0
|
|
|
|
|
|
chomp($line); |
1283
|
0
|
0
|
|
|
|
|
if ($line =~ /^\s*Array Size :\s*([0-9]+)\s*\(/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1284
|
0
|
|
|
|
|
|
$l->{'array-size'} = $1*1024; |
1285
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*Used Dev Size :\s*([0-9]+)\s*\(/) { |
1286
|
0
|
|
|
|
|
|
$l->{'used-dev-size'} = $1*1024; |
1287
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*Raid Level :\s*([^\s].*)/) { |
1288
|
0
|
|
|
|
|
|
$l->{'raid-level'} = $1; |
1289
|
0
|
0
|
|
|
|
|
if ($1 eq 'container') { |
1290
|
0
|
|
|
|
|
|
$l->{'raid-container'} = 1; |
1291
|
0
|
|
|
|
|
|
$container = 1; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*State : \s*([^\s].*)/) { |
1294
|
0
|
|
|
|
|
|
$l->{'raid-state'} = $1; |
1295
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*Version : \s*([^\s].*)/) { |
1296
|
0
|
|
|
|
|
|
$l->{'raid-version'} = $1; |
1297
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*Name : \s*([^\s]+)\s*/) { |
1298
|
0
|
|
|
|
|
|
$l->{'raid-name'} = $1; |
1299
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*Member Arrays : \s*([^\s]+.*[^\s])\s*/) { |
1300
|
0
|
|
|
|
|
|
$l->{'raid-member-arrays'} = [ split(/ +/, $1) ]; |
1301
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*Container : \s*([^\s]+), member ([0-9]+)\s*/) { |
1302
|
0
|
|
|
|
|
|
$l->{'raid-container-device'} = $1; |
1303
|
0
|
|
|
|
|
|
$l->{'raid-container-member'} = $2; |
1304
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*Number\s*Major\s*Minor\s*RaidDevice(\s*State)?/) { |
1305
|
0
|
|
|
|
|
|
last; |
1306
|
|
|
|
|
|
|
} |
1307
|
|
|
|
|
|
|
} |
1308
|
|
|
|
|
|
|
|
1309
|
0
|
|
|
|
|
|
my $raid_id = 0; |
1310
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1311
|
0
|
|
|
|
|
|
chomp($line); |
1312
|
0
|
0
|
0
|
|
|
|
if ((! $container) |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
&& $line =~ /^\s*([0-9]+)\s+([0-9]+)\s+([0-9]+)\s+([0-9-]+)\s+([^\s].*[^\s])\s+([^\s]+)$/) { |
1314
|
0
|
|
|
|
|
|
$l->{'devices'}->{$6} = { |
1315
|
|
|
|
|
|
|
state => $5, |
1316
|
|
|
|
|
|
|
raiddevice => $4, |
1317
|
|
|
|
|
|
|
}; |
1318
|
|
|
|
|
|
|
} elsif ($container |
1319
|
|
|
|
|
|
|
&& $line =~ /^\s*(-)\s+([0-9]+)\s+([0-9]+)\s+(-)\s+([^\s]+)$/) { |
1320
|
0
|
|
|
|
|
|
$l->{'devices'}->{$5} = { |
1321
|
|
|
|
|
|
|
raiddevice => $raid_id++, |
1322
|
|
|
|
|
|
|
}; |
1323
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*$/) { |
1324
|
|
|
|
|
|
|
} else { |
1325
|
0
|
|
|
|
|
|
print STDERR "W: mdadm on $dev: Unknown line '$line'\n"; |
1326
|
|
|
|
|
|
|
} |
1327
|
|
|
|
|
|
|
} |
1328
|
0
|
|
|
|
|
|
close $dh; |
1329
|
0
|
|
|
|
|
|
$md->{$dev} = $l; |
1330
|
|
|
|
|
|
|
} |
1331
|
|
|
|
|
|
|
|
1332
|
0
|
|
|
|
|
|
return { 'md' => $md }; |
1333
|
|
|
|
|
|
|
} |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
1; |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
########################################################################### |
1338
|
|
|
|
|
|
|
package StorageDisplay::Collect::LSI::Sas2ircu; |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
use is_collector |
1341
|
1
|
|
|
|
|
6
|
provides => 'lsi-sas-ircu', |
1342
|
|
|
|
|
|
|
depends => { |
1343
|
|
|
|
|
|
|
progs => [ 'sas2ircu' ], |
1344
|
|
|
|
|
|
|
root => 1, |
1345
|
1
|
|
|
1
|
|
8
|
}; |
|
1
|
|
|
|
|
12
|
|
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
sub select { |
1348
|
0
|
|
|
0
|
|
|
my $self = shift; |
1349
|
0
|
|
|
|
|
|
my $infos = shift; |
1350
|
0
|
|
0
|
|
|
|
my $request = shift // {}; |
1351
|
0
|
|
|
|
|
|
my @devs=(); |
1352
|
|
|
|
|
|
|
|
1353
|
0
|
|
|
|
|
|
my $dh; |
1354
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(sas2ircu LIST)); |
1355
|
0
|
|
|
|
|
|
my $state=0; |
1356
|
0
|
|
|
|
|
|
my $nodata=0; |
1357
|
0
|
|
|
|
|
|
while (defined(my $line=<$dh>)) { |
1358
|
0
|
|
|
|
|
|
chomp($line); |
1359
|
0
|
0
|
|
|
|
|
if ($state == 0) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1360
|
0
|
0
|
|
|
|
|
$nodata=1 if $line eq 'SAS2IRCU: MPTLib2 Error 1'; |
1361
|
0
|
0
|
|
|
|
|
next if $line !~ /^[\s-]*-[\s-]*$/; |
1362
|
0
|
|
|
|
|
|
$state = 1; |
1363
|
|
|
|
|
|
|
} elsif ($state == 1) { |
1364
|
0
|
0
|
|
|
|
|
if ($line =~ /^SAS2IRCU:/) { |
|
|
0
|
|
|
|
|
|
1365
|
0
|
0
|
|
|
|
|
if ($line ne 'SAS2IRCU: Utility Completed Successfully.') { |
1366
|
0
|
|
|
|
|
|
print STDERR "W: sas2ircu: $line\n"; |
1367
|
|
|
|
|
|
|
} |
1368
|
0
|
|
|
|
|
|
$state = 2; |
1369
|
|
|
|
|
|
|
} elsif ($line =~ /^\s*([0-9]+)\s+/) { |
1370
|
0
|
|
|
|
|
|
push @devs, $1; |
1371
|
|
|
|
|
|
|
} else { |
1372
|
0
|
|
|
|
|
|
print STDERR "E: sas2ircu: unknown line: $line\n"; |
1373
|
|
|
|
|
|
|
} |
1374
|
|
|
|
|
|
|
} elsif ($state == 2) { |
1375
|
0
|
|
|
|
|
|
print STDERR "W: sas2ircu: $line\n"; |
1376
|
|
|
|
|
|
|
} |
1377
|
|
|
|
|
|
|
} |
1378
|
0
|
0
|
|
|
|
|
if ($state != 2) { |
1379
|
0
|
0
|
0
|
|
|
|
if ($state != 0 || $nodata != 1) { |
1380
|
0
|
|
|
|
|
|
print STDERR "E: sas2ircu: Cannot parse data\n"; |
1381
|
|
|
|
|
|
|
} |
1382
|
|
|
|
|
|
|
} |
1383
|
0
|
|
|
|
|
|
close $dh; |
1384
|
0
|
|
|
|
|
|
return @devs; |
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
sub parse { |
1388
|
0
|
|
|
0
|
|
|
my $parser = shift; |
1389
|
0
|
|
|
|
|
|
my $closure = shift; |
1390
|
0
|
|
0
|
|
|
|
my $res = shift // {}; |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
} |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
my %name = ( |
1395
|
|
|
|
|
|
|
'Size (in MB)' => 'size-mb', |
1396
|
|
|
|
|
|
|
'Volume ID' => 'id', |
1397
|
|
|
|
|
|
|
'Volume wwid' => 'wwid', |
1398
|
|
|
|
|
|
|
'Status of volume' => 'status', |
1399
|
|
|
|
|
|
|
); |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
sub collect { |
1402
|
0
|
|
|
0
|
|
|
my $self = shift; |
1403
|
0
|
|
|
|
|
|
my $infos = shift; |
1404
|
0
|
|
|
|
|
|
my $dh; |
1405
|
0
|
|
|
|
|
|
my $lsi={}; |
1406
|
|
|
|
|
|
|
|
1407
|
0
|
|
|
|
|
|
my @devs=$self->select($infos); |
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
my $parse_section = sub { |
1411
|
0
|
|
|
0
|
|
|
my $self = shift; |
1412
|
0
|
|
|
|
|
|
my $line = shift; |
1413
|
0
|
0
|
|
|
|
|
if ($line eq 'Controller information') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
#$self->push_new_section->($parse_controller, $closure_controller); |
1415
|
|
|
|
|
|
|
} elsif ($line eq 'IR Volume information') { |
1416
|
|
|
|
|
|
|
#return (1, $parse_volumes); |
1417
|
|
|
|
|
|
|
} elsif ($line eq 'Physical device information') { |
1418
|
|
|
|
|
|
|
#return (1, $parse_phydev); |
1419
|
|
|
|
|
|
|
} elsif ($line eq 'Enclosure information') { |
1420
|
|
|
|
|
|
|
#return (1, $parse_phydev); |
1421
|
|
|
|
|
|
|
} elsif ($line =~ /SAS2IRCU:/) { |
1422
|
0
|
0
|
0
|
|
|
|
if ($line eq 'SAS2IRCU: Command DISPLAY Completed Successfully.' |
1423
|
|
|
|
|
|
|
or $line eq 'SAS2IRCU: Utility Completed Successfully.') { |
1424
|
|
|
|
|
|
|
} else { |
1425
|
0
|
|
|
|
|
|
print STDERR "W: sas2ircu: $line\n"; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
} else { |
1428
|
|
|
|
|
|
|
#if (scalar(keys %$l) != 0) { |
1429
|
|
|
|
|
|
|
# print STDERR "W: sas2ircu: unknown line: $line\n"; |
1430
|
|
|
|
|
|
|
#} |
1431
|
|
|
|
|
|
|
} |
1432
|
0
|
|
|
|
|
|
return 1; |
1433
|
0
|
|
|
|
|
|
}; |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
|
1436
|
0
|
|
|
|
|
|
foreach my $dev (@devs) { |
1437
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root('sas2ircu', $dev, 'DISPLAY'); |
1438
|
0
|
|
|
|
|
|
my $l={}; |
1439
|
0
|
|
|
|
|
|
my $state = 0; |
1440
|
0
|
|
|
|
|
|
my $wwid = {}; |
1441
|
0
|
|
|
|
|
|
my $guid = {}; |
1442
|
|
|
|
|
|
|
|
1443
|
0
|
|
|
|
|
|
my $data = undef; |
1444
|
0
|
|
|
|
|
|
my $secdata = undef; |
1445
|
|
|
|
|
|
|
|
1446
|
0
|
|
|
0
|
|
|
my $closure=sub {} ; |
1447
|
0
|
|
|
0
|
|
|
my $subclosure=sub {} ; |
1448
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1449
|
0
|
|
|
|
|
|
chomp($line); |
1450
|
0
|
0
|
|
|
|
|
next if $line =~ /^[\s-]*$/; |
1451
|
0
|
0
|
0
|
|
|
|
if ($line =~ /^(Controller) information$/ |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
|| $line =~ /^(Enclosure) information$/) { |
1453
|
0
|
|
|
|
|
|
my $section = lc($1); |
1454
|
0
|
|
|
|
|
|
$subclosure->($data); |
1455
|
0
|
|
|
|
|
|
$closure->($data); |
1456
|
0
|
|
|
|
|
|
$data = {}; |
1457
|
0
|
|
|
0
|
|
|
$subclosure = sub {}; |
1458
|
|
|
|
|
|
|
$closure = sub { |
1459
|
0
|
|
|
0
|
|
|
my $curdata = shift; |
1460
|
0
|
0
|
|
|
|
|
if (exists($l->{$section})) { |
1461
|
0
|
|
|
|
|
|
print STDERR "E: sas2ircu: duplicate section: $line\n"; |
1462
|
|
|
|
|
|
|
} |
1463
|
0
|
|
|
|
|
|
$l->{$section}=$curdata; |
1464
|
0
|
|
|
|
|
|
return {}; |
1465
|
0
|
|
|
|
|
|
}; |
1466
|
0
|
|
|
|
|
|
$state=10; |
1467
|
|
|
|
|
|
|
} elsif ($line =~ /^IR (Volume) information$/ |
1468
|
|
|
|
|
|
|
|| $line =~ /^Physical (device) information$/) { |
1469
|
0
|
|
|
|
|
|
my $section = lc($1).'s'; |
1470
|
0
|
|
|
|
|
|
$subclosure->($data); |
1471
|
0
|
|
|
|
|
|
$closure->($data); |
1472
|
0
|
|
|
|
|
|
$secdata=[]; |
1473
|
0
|
|
|
0
|
|
|
$subclosure = sub { }; |
1474
|
|
|
|
|
|
|
$closure=sub { |
1475
|
0
|
|
|
0
|
|
|
my $data = shift; |
1476
|
0
|
0
|
|
|
|
|
if (exists($l->{$section})) { |
1477
|
0
|
|
|
|
|
|
print STDERR "E: sas2ircu: duplicate section: $line\n"; |
1478
|
|
|
|
|
|
|
} |
1479
|
0
|
|
|
|
|
|
$l->{$section}=$secdata; |
1480
|
|
|
|
|
|
|
return |
1481
|
0
|
|
|
|
|
|
}; |
|
0
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
} elsif ($line =~ /^IR volume ([^\s])+$/) { |
1483
|
0
|
|
|
|
|
|
my $name = $1; |
1484
|
0
|
|
|
|
|
|
$subclosure->($data); |
1485
|
0
|
|
|
|
|
|
$data = { |
1486
|
|
|
|
|
|
|
name => $name, |
1487
|
|
|
|
|
|
|
}; |
1488
|
|
|
|
|
|
|
$subclosure = sub { |
1489
|
0
|
|
|
0
|
|
|
my $data = shift; |
1490
|
0
|
|
|
|
|
|
push @$secdata, $data; |
1491
|
0
|
|
|
|
|
|
}; |
1492
|
|
|
|
|
|
|
} elsif ($line =~ /^Device is a Hard disk$/) { |
1493
|
0
|
|
|
|
|
|
$subclosure->($data); |
1494
|
0
|
|
|
|
|
|
$data = {}; |
1495
|
|
|
|
|
|
|
$subclosure = sub { |
1496
|
0
|
|
|
0
|
|
|
my $data = shift; |
1497
|
0
|
|
|
|
|
|
push @$secdata, $data; |
1498
|
0
|
|
|
|
|
|
}; |
1499
|
|
|
|
|
|
|
} elsif ($line =~ /^Initiator at ID .*$/) { |
1500
|
|
|
|
|
|
|
} elsif ($line =~ /^SAS2IRCU: .* Completed Successfully.$/) { |
1501
|
|
|
|
|
|
|
} elsif ($line =~ /^[^\s]/) { |
1502
|
0
|
0
|
|
|
|
|
if ($state != 0) { |
1503
|
0
|
|
|
|
|
|
print STDERR "W: sas2ircu: unknown line: $line\n"; |
1504
|
|
|
|
|
|
|
} |
1505
|
|
|
|
|
|
|
} elsif ($line =~ /^\s+([^\s][^:]*[^\s])\s*:\s+([^\s].*)$/) { |
1506
|
0
|
|
|
|
|
|
my $k = $1; |
1507
|
0
|
|
|
|
|
|
my $v = $2; |
1508
|
0
|
0
|
|
|
|
|
if ($k =~ m,^PHY\[([^\]]+)\] Enclosure#/Slot#,) { |
|
|
0
|
|
|
|
|
|
1509
|
0
|
|
|
|
|
|
my $phy=$1; |
1510
|
0
|
|
|
|
|
|
my ($e, $s) = split(':', $v); |
1511
|
0
|
|
|
|
|
|
$data->{PHY}->{$phy} = { enclosure => $e, slot => $s }; |
1512
|
0
|
|
|
|
|
|
next; |
1513
|
|
|
|
|
|
|
} elsif ($k eq 'Size (in MB)/(in sectors)') { |
1514
|
0
|
|
|
|
|
|
my ($s1, $s2) = split('/', $v); |
1515
|
0
|
|
|
|
|
|
$data->{'size-mb'}=$s1; |
1516
|
0
|
|
|
|
|
|
$data->{'size-s'}=$s2; |
1517
|
0
|
|
|
|
|
|
$data->{'size'}=$s2 * 512; |
1518
|
0
|
|
|
|
|
|
next; |
1519
|
|
|
|
|
|
|
} |
1520
|
0
|
|
0
|
|
|
|
$k = $name{$k} // $k; |
1521
|
0
|
|
|
|
|
|
$k =~ s/\s*[#]//; |
1522
|
0
|
|
|
|
|
|
$k = lc($k); |
1523
|
0
|
|
|
|
|
|
$k =~ s/\s+/-/g; |
1524
|
0
|
0
|
|
|
|
|
if ($k eq 'guid') { |
|
|
0
|
|
|
|
|
|
1525
|
0
|
|
|
|
|
|
$guid->{$v}=1; |
1526
|
|
|
|
|
|
|
} elsif ($k eq 'wwid') { |
1527
|
0
|
|
|
|
|
|
$wwid->{$v}=1; |
1528
|
|
|
|
|
|
|
} |
1529
|
0
|
|
|
|
|
|
$data->{$k}=$v; |
1530
|
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
|
} |
1532
|
0
|
|
|
|
|
|
$subclosure->($data); |
1533
|
0
|
|
|
|
|
|
$closure->($data); |
1534
|
0
|
|
|
|
|
|
close $dh; |
1535
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe(qw(find /sys/devices -name sas_address)); |
1536
|
0
|
|
|
|
|
|
my @lines=<$dh>; |
1537
|
0
|
|
|
|
|
|
for my $line (sort @lines) { |
1538
|
0
|
|
|
|
|
|
chomp($line); |
1539
|
0
|
0
|
|
|
|
|
my $dh2 = $self->open_file($line) |
1540
|
|
|
|
|
|
|
or die "Cannot open $line: $!\n"; |
1541
|
0
|
|
|
|
|
|
my $addr=<$dh2>; |
1542
|
0
|
|
|
|
|
|
close $dh2; |
1543
|
0
|
|
|
|
|
|
chomp($addr); |
1544
|
0
|
|
|
|
|
|
$addr =~ s/^0x//; |
1545
|
0
|
0
|
|
|
|
|
if (defined($wwid->{$addr})) { |
1546
|
0
|
|
|
|
|
|
my $dir = $line; |
1547
|
0
|
|
|
|
|
|
$dir =~ s/sas_address/block/; |
1548
|
0
|
|
|
|
|
|
my $dh3 = $self->open_cmd_pipe('ls', '-1', $dir); |
1549
|
0
|
|
|
|
|
|
my @dirs=<$dh3>; |
1550
|
0
|
|
|
|
|
|
close($dh3); |
1551
|
0
|
0
|
|
|
|
|
if (scalar(@dirs) != 1) { |
1552
|
0
|
|
|
|
|
|
print STDERR "E: sas2ircu: bad number of block devices for $addr\n"; |
1553
|
|
|
|
|
|
|
} else { |
1554
|
0
|
|
|
|
|
|
chomp($l->{wwid}->{$addr} = $dirs[0]); |
1555
|
|
|
|
|
|
|
} |
1556
|
|
|
|
|
|
|
} |
1557
|
|
|
|
|
|
|
} |
1558
|
0
|
|
|
|
|
|
$lsi->{$dev} = $l; |
1559
|
|
|
|
|
|
|
} |
1560
|
|
|
|
|
|
|
|
1561
|
0
|
|
|
|
|
|
return { 'lsi-sas-ircu' => $lsi }; |
1562
|
|
|
|
|
|
|
} |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
1; |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
########################################################################### |
1567
|
|
|
|
|
|
|
package StorageDisplay::Collect::LSI::Megacli; |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
use is_collector |
1570
|
1
|
|
|
|
|
8
|
provides => 'lsi-megacli', |
1571
|
|
|
|
|
|
|
depends => { |
1572
|
|
|
|
|
|
|
progs => [ 'megaclisas-status', 'megacli' ], |
1573
|
|
|
|
|
|
|
root => 1, |
1574
|
1
|
|
|
1
|
|
9
|
}; |
|
1
|
|
|
|
|
3
|
|
1575
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
sub select { |
1577
|
0
|
|
|
0
|
|
|
my $self = shift; |
1578
|
0
|
|
|
|
|
|
my $infos = shift; |
1579
|
0
|
|
0
|
|
|
|
my $request = shift // {}; |
1580
|
0
|
|
|
|
|
|
my @devs=(); |
1581
|
|
|
|
|
|
|
|
1582
|
0
|
|
|
|
|
|
my $dh; |
1583
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(megacli -adpCount -NoLog)); |
1584
|
0
|
|
|
|
|
|
while (defined(my $line=<$dh>)) { |
1585
|
0
|
|
|
|
|
|
chomp($line); |
1586
|
0
|
0
|
|
|
|
|
next if $line !~ /^Controller Count:\s*([0-9]+)\.?\s*$/; |
1587
|
0
|
|
|
|
|
|
my $nb_controllers = $1; |
1588
|
0
|
|
|
|
|
|
for (my $i=0; $i<$nb_controllers; $i++) { |
1589
|
0
|
|
|
|
|
|
push @devs, $i; |
1590
|
|
|
|
|
|
|
} |
1591
|
0
|
|
|
|
|
|
close $dh; |
1592
|
0
|
|
|
|
|
|
return @devs; |
1593
|
|
|
|
|
|
|
} |
1594
|
0
|
|
|
|
|
|
print STDERR "E: megacli: cannot find the number of controllers, assuming 0\n"; |
1595
|
0
|
|
|
|
|
|
close $dh; |
1596
|
0
|
|
|
|
|
|
return @devs; |
1597
|
|
|
|
|
|
|
} |
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
sub parse { |
1600
|
0
|
|
|
0
|
|
|
my $parser = shift; |
1601
|
0
|
|
|
|
|
|
my $closure = shift; |
1602
|
0
|
|
0
|
|
|
|
my $res = shift // {}; |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
} |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
sub interleave { |
1607
|
0
|
|
|
0
|
|
|
my @lists = map [@$_], @_; |
1608
|
0
|
|
|
|
|
|
my @res; |
1609
|
0
|
|
|
|
|
|
while (my $list = shift @lists) { |
1610
|
0
|
0
|
|
|
|
|
if (@$list) { |
1611
|
0
|
|
|
|
|
|
push @res, shift @$list; |
1612
|
0
|
|
|
|
|
|
push @lists, $list; |
1613
|
|
|
|
|
|
|
} |
1614
|
|
|
|
|
|
|
} |
1615
|
0
|
0
|
|
|
|
|
wantarray ? @res : \@res; |
1616
|
|
|
|
|
|
|
} |
1617
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
sub collect { |
1619
|
0
|
|
|
0
|
|
|
my $self = shift; |
1620
|
0
|
|
|
|
|
|
my $infos = shift; |
1621
|
0
|
|
|
|
|
|
my $dh; |
1622
|
|
|
|
|
|
|
|
1623
|
0
|
|
|
|
|
|
my @devs=$self->select($infos); |
1624
|
|
|
|
|
|
|
|
1625
|
0
|
|
|
|
|
|
my $megacli={ map { $_ => {} } @devs }; |
|
0
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
|
1627
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root('megaclisas-status'); |
1628
|
|
|
|
|
|
|
|
1629
|
0
|
|
|
|
|
|
my $section_name; |
1630
|
|
|
|
|
|
|
my @headers; |
1631
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1632
|
0
|
|
|
|
|
|
chomp($line); |
1633
|
0
|
0
|
|
|
|
|
next if $line =~ /^\s*$/; |
1634
|
0
|
0
|
|
|
|
|
if ($line =~ /^-- (.*) [Ii]nformation(s)?(\s*--)?\s*$/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1635
|
0
|
|
|
|
|
|
$section_name=$1; |
1636
|
0
|
0
|
|
|
|
|
if ($section_name =~ /Disk/) { |
1637
|
0
|
|
|
|
|
|
$section_name = 'Disk'; |
1638
|
|
|
|
|
|
|
} |
1639
|
|
|
|
|
|
|
} elsif ($line =~ /^--\s*(ID\s*|.*[^\s])\s*$/) { |
1640
|
0
|
|
|
|
|
|
@headers = split(/\s*[|]\s*/, $1); |
1641
|
|
|
|
|
|
|
} elsif ($line =~ /^(c([0-9]+)(\s|u).*[^\s])\s*$/) { |
1642
|
0
|
|
|
|
|
|
my $idc = $2; |
1643
|
0
|
0
|
|
|
|
|
next if not exists($megacli->{$idc}); |
1644
|
0
|
|
|
|
|
|
my @infos = split(/\s*[|]\s*/, $1); |
1645
|
0
|
0
|
|
|
|
|
if (scalar(@infos) != scalar(@headers)) { |
1646
|
0
|
|
|
|
|
|
print STDERR "E: megaclisas-status: invalid number of information: $line\n"; |
1647
|
0
|
|
|
|
|
|
next; |
1648
|
|
|
|
|
|
|
} |
1649
|
0
|
|
|
|
|
|
my $infos = { interleave(\@headers, \@infos) }; |
1650
|
0
|
|
|
|
|
|
my $id = $infos->{ID}; |
1651
|
0
|
0
|
|
|
|
|
if ($section_name eq 'Disk') { |
1652
|
0
|
|
|
|
|
|
$id = $infos->{'Slot ID'}; |
1653
|
|
|
|
|
|
|
} |
1654
|
0
|
0
|
|
|
|
|
if (exists($megacli->{$idc}->{$section_name}->{$id})) { |
1655
|
0
|
|
|
|
|
|
print STDERR "E: megaclisas-status: duplicate info for $id: $line\n"; |
1656
|
|
|
|
|
|
|
} |
1657
|
0
|
|
|
|
|
|
$megacli->{$idc}->{$section_name}->{$id}=$infos; |
1658
|
|
|
|
|
|
|
} elsif ($line =~ /^There is at least one disk\/array in a NOT OPTIMAL state.$/) { |
1659
|
|
|
|
|
|
|
# skip |
1660
|
|
|
|
|
|
|
} elsif ($line =~ /^RAID ERROR - Arrays: OK:[0-9]+ Bad:[0-9]+ - Disks: OK:[0-9]+ Bad:[0-9]+$/) { |
1661
|
|
|
|
|
|
|
# skip |
1662
|
|
|
|
|
|
|
} elsif ($line =~ /^No MegaRAID or PERC adapter detected on your system!$/) { |
1663
|
|
|
|
|
|
|
# skip |
1664
|
|
|
|
|
|
|
} else { |
1665
|
0
|
|
|
|
|
|
print STDERR "E: megaclisas-status: invalid line: $line\n"; |
1666
|
|
|
|
|
|
|
} |
1667
|
|
|
|
|
|
|
} |
1668
|
0
|
|
|
|
|
|
close($dh); |
1669
|
|
|
|
|
|
|
|
1670
|
0
|
|
|
|
|
|
for my $dev (@devs) { |
1671
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(megacli -PDList), "-a$dev"); |
1672
|
0
|
|
|
|
|
|
my $cur_enc; |
1673
|
|
|
|
|
|
|
my $cur_slot; |
1674
|
0
|
|
|
|
|
|
my $cur_size; |
1675
|
|
|
|
|
|
|
my $get_cur_disk=sub { |
1676
|
0
|
|
|
0
|
|
|
my $slot_id = "[$cur_enc:$cur_slot]"; |
1677
|
0
|
0
|
|
|
|
|
if (not exists($megacli->{$dev}->{'Disk'}->{$slot_id})) { |
1678
|
0
|
|
|
|
|
|
print STDERR "E: missing disk with slot $slot_id\n"; |
1679
|
0
|
|
|
|
|
|
return; |
1680
|
|
|
|
|
|
|
} |
1681
|
0
|
|
|
|
|
|
return $megacli->{$dev}->{'Disk'}->{$slot_id}; |
1682
|
0
|
|
|
|
|
|
}; |
1683
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1684
|
0
|
|
|
|
|
|
chomp($line); |
1685
|
0
|
0
|
|
|
|
|
next if $line =~ /^\s*$/; |
1686
|
0
|
0
|
|
|
|
|
next if $line eq "Adapter #$dev"; |
1687
|
0
|
0
|
|
|
|
|
if ($line eq "^Adapter") { |
1688
|
0
|
|
|
|
|
|
print STDERR "W: megacli: strange adapter for #$dev: $line\n"; |
1689
|
0
|
|
|
|
|
|
next; |
1690
|
|
|
|
|
|
|
} |
1691
|
0
|
0
|
|
|
|
|
if ($line =~ /^Enclosure Device ID: *([0-9]+|N\/A) *$/) { |
1692
|
0
|
|
|
|
|
|
$cur_enc=$1; |
1693
|
0
|
0
|
|
|
|
|
$cur_enc='' if $cur_enc eq 'N/A'; |
1694
|
0
|
|
|
|
|
|
$cur_slot=undef; |
1695
|
0
|
|
|
|
|
|
next; |
1696
|
|
|
|
|
|
|
} |
1697
|
0
|
0
|
|
|
|
|
if ($line =~ /^Enclosure Device ID: *(.*) *$/) { |
1698
|
0
|
|
|
|
|
|
print STDERR "W: megacli: strange enclosure device ID '$1'\n"; |
1699
|
|
|
|
|
|
|
} |
1700
|
0
|
0
|
|
|
|
|
if ($line =~ /^Slot Number: *([0-9]+) *$/) { |
1701
|
0
|
0
|
0
|
|
|
|
if (defined($cur_slot) || not defined($cur_enc)) { |
1702
|
0
|
|
|
|
|
|
print STDERR "W: megacli: strange state when finding slot number $1\n"; |
1703
|
|
|
|
|
|
|
} |
1704
|
0
|
|
|
|
|
|
$cur_slot=$1; |
1705
|
0
|
|
|
|
|
|
next; |
1706
|
|
|
|
|
|
|
} |
1707
|
0
|
0
|
|
|
|
|
if ($line =~ /^Array *#: *([0-9]+) *$/) { |
1708
|
0
|
|
0
|
|
|
|
my $d=$get_cur_disk->() // next; |
1709
|
0
|
0
|
|
|
|
|
if ($d->{'ID'} !~ /^c[0-9]+uXpY$/) { |
1710
|
0
|
|
|
|
|
|
my $slot_id = $d->{'Slot ID'}; |
1711
|
0
|
|
|
|
|
|
print STDERR "E: slot $slot_id has a strange ID\n"; |
1712
|
0
|
|
|
|
|
|
next; |
1713
|
|
|
|
|
|
|
} |
1714
|
0
|
|
|
|
|
|
$d->{'ID'} =~ s/X/$dev/; |
1715
|
|
|
|
|
|
|
} |
1716
|
0
|
0
|
|
|
|
|
if ($line =~ /^Coerced Size:.*\[(0x[0-9a-f]+) *Sectors\]/i) { |
1717
|
0
|
|
0
|
|
|
|
my $d=$get_cur_disk->() // next; |
1718
|
0
|
|
|
|
|
|
$d->{'# sectors'} = $1; |
1719
|
|
|
|
|
|
|
} |
1720
|
0
|
0
|
|
|
|
|
if ($line =~ /^Sector Size: *([0-9]+)$/i) { |
1721
|
0
|
|
0
|
|
|
|
my $d=$get_cur_disk->() // next; |
1722
|
0
|
0
|
|
|
|
|
$d->{'sector size'} = ($1==0)?512:$1; |
1723
|
|
|
|
|
|
|
} |
1724
|
|
|
|
|
|
|
} |
1725
|
0
|
|
|
|
|
|
close($dh); |
1726
|
|
|
|
|
|
|
} |
1727
|
|
|
|
|
|
|
|
1728
|
0
|
|
|
|
|
|
return { 'lsi-megacli' => $megacli }; |
1729
|
|
|
|
|
|
|
} |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
1; |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
########################################################################### |
1734
|
|
|
|
|
|
|
package StorageDisplay::Collect::Libvirt; |
1735
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
use is_collector |
1737
|
1
|
|
|
|
|
5
|
provides => 'libvirt', |
1738
|
|
|
|
|
|
|
depends => { |
1739
|
|
|
|
|
|
|
progs => [ 'virsh' ], |
1740
|
|
|
|
|
|
|
root => 1, |
1741
|
1
|
|
|
1
|
|
9
|
}; |
|
1
|
|
|
|
|
3
|
|
1742
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
sub select { |
1744
|
0
|
|
|
0
|
|
|
my $self = shift; |
1745
|
0
|
|
|
|
|
|
my $infos = shift; |
1746
|
0
|
|
0
|
|
|
|
my $request = shift // {}; |
1747
|
0
|
|
|
|
|
|
my @vms=(); |
1748
|
|
|
|
|
|
|
|
1749
|
0
|
|
|
|
|
|
my $dh=$self->open_cmd_pipe_root(qw(virsh list --all --name)); |
1750
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1751
|
0
|
|
|
|
|
|
chomp($line); |
1752
|
0
|
0
|
|
|
|
|
next if $line =~ /^\s*$/; |
1753
|
0
|
|
|
|
|
|
push @vms, $line; |
1754
|
|
|
|
|
|
|
} |
1755
|
0
|
|
|
|
|
|
close $dh; |
1756
|
0
|
|
|
|
|
|
@vms = sort @vms; |
1757
|
0
|
|
|
|
|
|
return @vms; |
1758
|
|
|
|
|
|
|
} |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
sub collect { |
1761
|
0
|
|
|
0
|
|
|
my $self = shift; |
1762
|
0
|
|
|
|
|
|
my $infos = shift; |
1763
|
0
|
|
|
|
|
|
my $dh; |
1764
|
0
|
|
|
|
|
|
my $libvirt={}; |
1765
|
|
|
|
|
|
|
|
1766
|
0
|
|
|
|
|
|
my @vms=$self->select($infos); |
1767
|
|
|
|
|
|
|
|
1768
|
0
|
|
|
|
|
|
foreach my $vm (@vms) { |
1769
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(virsh domstate), $vm); |
1770
|
0
|
|
|
|
|
|
my $v={ name => $vm }; |
1771
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1772
|
0
|
|
|
|
|
|
chomp($line); |
1773
|
0
|
0
|
|
|
|
|
if ($line =~ /running/) { |
1774
|
0
|
|
|
|
|
|
$v->{state} = 'running'; |
1775
|
0
|
|
|
|
|
|
last; |
1776
|
|
|
|
|
|
|
} |
1777
|
|
|
|
|
|
|
} |
1778
|
0
|
|
|
|
|
|
close $dh; |
1779
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(virsh domblklist --details), $vm); |
1780
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1781
|
0
|
|
|
|
|
|
chomp($line); |
1782
|
0
|
0
|
|
|
|
|
next if $line =~ /^[\s-]*$/; |
1783
|
0
|
|
|
|
|
|
my @info=split(' ', $line); |
1784
|
0
|
0
|
0
|
|
|
|
next if ($info[0]//'') eq 'Type'; |
1785
|
|
|
|
|
|
|
#next if ($info[0]//'') ne 'block'; |
1786
|
0
|
0
|
|
|
|
|
next if $info[3] eq '-'; |
1787
|
0
|
0
|
|
|
|
|
if (scalar(@info) != 4) { |
1788
|
0
|
|
|
|
|
|
print STDERR "W: libvirt on $vm: Unknown line '$line'\n"; |
1789
|
0
|
|
|
|
|
|
next; |
1790
|
|
|
|
|
|
|
} |
1791
|
0
|
|
|
|
|
|
$v->{'blocks'}->{$info[3]} = { |
1792
|
|
|
|
|
|
|
type => $info[0], |
1793
|
|
|
|
|
|
|
device => $info[1], |
1794
|
|
|
|
|
|
|
target => $info[2], |
1795
|
|
|
|
|
|
|
source => $info[3], |
1796
|
|
|
|
|
|
|
}; |
1797
|
0
|
0
|
|
|
|
|
if ($info[0] eq 'file') { |
|
|
0
|
|
|
|
|
|
1798
|
0
|
|
|
|
|
|
my $dh2=$self->open_cmd_pipe_root(qw(findmnt -n -o TARGET --target), $info[3]); |
1799
|
0
|
|
|
|
|
|
my $mountpoint = <$dh2>; |
1800
|
0
|
0
|
|
|
|
|
chomp($mountpoint) if defined($mountpoint); |
1801
|
0
|
|
|
|
|
|
close $dh2; |
1802
|
0
|
|
|
|
|
|
$v->{'blocks'}->{$info[3]}->{'mount-point'}=$mountpoint; |
1803
|
0
|
0
|
|
|
|
|
if (defined($mountpoint)) { |
1804
|
0
|
|
|
|
|
|
$dh2=$self->open_cmd_pipe_root(qw(stat -c %s), $info[3]); |
1805
|
0
|
|
|
|
|
|
my $size = <$dh2>; |
1806
|
0
|
|
|
|
|
|
chomp($size); |
1807
|
0
|
|
|
|
|
|
close $dh2; |
1808
|
0
|
|
|
|
|
|
$v->{'blocks'}->{$info[3]}->{'size'}=$size; |
1809
|
|
|
|
|
|
|
} |
1810
|
|
|
|
|
|
|
} elsif ($info[0] eq 'block') { |
1811
|
|
|
|
|
|
|
} else { |
1812
|
0
|
|
|
|
|
|
print STDERR "W: unknown VM device type: $info[0]\n"; |
1813
|
|
|
|
|
|
|
} |
1814
|
|
|
|
|
|
|
} |
1815
|
0
|
|
|
|
|
|
close $dh; |
1816
|
0
|
0
|
0
|
|
|
|
if ($v->{state}//'' eq 'running') { |
1817
|
|
|
|
|
|
|
# trying to get infos from QEMU guest agent |
1818
|
0
|
|
|
|
|
|
$dh=$self->open_cmd_pipe_root(qw(virsh guestinfo --hostname --disk), $vm); |
1819
|
0
|
|
|
|
|
|
my $curdisk=''; |
1820
|
0
|
|
|
|
|
|
my $curdiskinfo={}; |
1821
|
0
|
|
|
|
|
|
while(defined(my $line=<$dh>)) { |
1822
|
0
|
|
|
|
|
|
chomp($line); |
1823
|
0
|
0
|
0
|
|
|
|
if ($curdisk ne '' && $line !~ /^disk\.$curdisk\./) { |
1824
|
0
|
0
|
0
|
|
|
|
if (exists($curdiskinfo->{name}) && exists($curdiskinfo->{alias})) { |
1825
|
|
|
|
|
|
|
#print STDERR "W: libvirt guestagent on $vm: adding ".$curdiskinfo->{alias}."\n"; |
1826
|
0
|
|
|
|
|
|
$v->{ga}->{disks}->{$curdiskinfo->{alias}}=$curdiskinfo; |
1827
|
|
|
|
|
|
|
} |
1828
|
0
|
|
|
|
|
|
$curdiskinfo={}; |
1829
|
0
|
|
|
|
|
|
$curdisk = ''; |
1830
|
|
|
|
|
|
|
} |
1831
|
0
|
0
|
|
|
|
|
next if $line =~ /^[\s-]*$/; |
1832
|
0
|
0
|
|
|
|
|
if ($line !~ m/^([^:\s]+)\s*: (.*)$/) { |
1833
|
0
|
|
|
|
|
|
print STDERR "W: libvirt guestagent on $vm: Unknown line '$line'\n"; |
1834
|
|
|
|
|
|
|
} |
1835
|
0
|
|
|
|
|
|
my $key=$1; |
1836
|
0
|
|
|
|
|
|
my $value=$2; |
1837
|
0
|
0
|
|
|
|
|
if ($key eq 'hostname') { |
1838
|
0
|
|
|
|
|
|
$v->{ga}->{hostname} = $value; |
1839
|
0
|
|
|
|
|
|
next; |
1840
|
|
|
|
|
|
|
} |
1841
|
0
|
0
|
|
|
|
|
if ($key =~ /^disk\.([0-9]+)\./) { |
1842
|
0
|
|
|
|
|
|
$curdisk = $1; |
1843
|
0
|
0
|
|
|
|
|
if ($key =~ /\.(name|alias)$/) { |
1844
|
0
|
|
|
|
|
|
$curdiskinfo->{$1} = $value; |
1845
|
|
|
|
|
|
|
} |
1846
|
|
|
|
|
|
|
} |
1847
|
|
|
|
|
|
|
} |
1848
|
0
|
|
|
|
|
|
close $dh; |
1849
|
0
|
0
|
|
|
|
|
if ($curdisk ne '') { |
1850
|
|
|
|
|
|
|
# the last empty line should have set $curdisk to '' |
1851
|
0
|
|
|
|
|
|
print STDERR "W: libvirt guestagent on $vm: end-before-end '$curdisk'\n"; |
1852
|
|
|
|
|
|
|
} |
1853
|
|
|
|
|
|
|
} |
1854
|
0
|
|
|
|
|
|
$libvirt->{$vm} = $v; |
1855
|
|
|
|
|
|
|
} |
1856
|
|
|
|
|
|
|
|
1857
|
0
|
|
|
|
|
|
return { 'libvirt' => $libvirt }; |
1858
|
|
|
|
|
|
|
} |
1859
|
|
|
|
|
|
|
|
1860
|
|
|
|
|
|
|
1; |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
########################################################################### |
1863
|
|
|
|
|
|
|
########################################################################### |
1864
|
|
|
|
|
|
|
########################################################################### |
1865
|
|
|
|
|
|
|
########################################################################### |
1866
|
|
|
|
|
|
|
package StorageDisplay::Collect; |
1867
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
sub dump_collect { |
1869
|
0
|
|
0
|
0
|
0
|
|
my $reader = shift // 'Local'; |
1870
|
0
|
|
|
|
|
|
my $collector = __PACKAGE__->new($reader, @_); |
1871
|
|
|
|
|
|
|
|
1872
|
0
|
|
|
|
|
|
my $info = $collector->collect(); |
1873
|
|
|
|
|
|
|
|
1874
|
1
|
|
|
1
|
|
672
|
use Data::Dumper; |
|
1
|
|
|
|
|
6616
|
|
|
1
|
|
|
|
|
141
|
|
1875
|
|
|
|
|
|
|
# sort keys |
1876
|
0
|
|
|
|
|
|
$Data::Dumper::Sortkeys = 1; |
1877
|
0
|
|
|
|
|
|
$Data::Dumper::Purity = 1; |
1878
|
|
|
|
|
|
|
|
1879
|
0
|
|
|
|
|
|
print Dumper($info); |
1880
|
|
|
|
|
|
|
#print Dumper(\%INC); |
1881
|
|
|
|
|
|
|
} |
1882
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
1; |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
__END__ |
1886
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
=pod |
1888
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
=encoding UTF-8 |
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
=head1 NAME |
1892
|
|
|
|
|
|
|
|
1893
|
|
|
|
|
|
|
StorageDisplay::Collect - modules required to collect data. |
1894
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
=head1 VERSION |
1896
|
|
|
|
|
|
|
|
1897
|
|
|
|
|
|
|
version 2.03 |
1898
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
Main class, allows one to register collectors and run them |
1900
|
|
|
|
|
|
|
(through the collect method) |
1901
|
|
|
|
|
|
|
|
1902
|
|
|
|
|
|
|
Collectors will be registered when their class is loaded |
1903
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
Wrapper around JSON:PP as old versions do not support the |
1905
|
|
|
|
|
|
|
boolean_value method. |
1906
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
Base (abstract) class to run command to collect infos |
1908
|
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
|
Only one instance should be created |
1910
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
# sub classes must implement open_cmd_pipe and open_cmd_pipe_root |
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
Run commands locally |
1914
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
Run commands through SSH |
1916
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
Record commands |
1918
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
Used to declare a class to be a collector. |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
The collector will be registered |
1922
|
|
|
|
|
|
|
|
1923
|
|
|
|
|
|
|
Base class for collectors |
1924
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
=head1 AUTHOR |
1926
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
Vincent Danjean <Vincent.Danjean@ens-lyon.org> |
1928
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1930
|
|
|
|
|
|
|
|
1931
|
|
|
|
|
|
|
This software is copyright (c) 2014-2023 by Vincent Danjean. |
1932
|
|
|
|
|
|
|
|
1933
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
1934
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
1935
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
=cut |