Commit | Line | Data |
60e1cc39 |
1 | package System::Introspector::State; |
2 | use Moo; |
b079a95d |
3 | use File::Tree::Snapshot; |
60e1cc39 |
4 | use System::Introspector::Gatherer; |
949dba9c |
5 | use Object::Remote::Future qw( await_all ); |
60e1cc39 |
6 | |
0a11cf83 |
7 | use JSON::Diffable qw( encode_json ); |
8 | |
60e1cc39 |
9 | has config => (is => 'ro', required => 1); |
10 | |
b079a95d |
11 | has root => (is => 'ro', required => 1); |
60e1cc39 |
12 | |
b079a95d |
13 | sub user { $_[0]->config->user } |
60e1cc39 |
14 | |
b079a95d |
15 | sub sudo_user { $_[0]->config->sudo_user } |
a5e1e1c6 |
16 | |
949dba9c |
17 | sub _log { shift; printf "[%s] %s\n", scalar(localtime), join '', @_ } |
18 | |
b079a95d |
19 | sub gather { |
20 | my ($self, @groups) = @_; |
949dba9c |
21 | $self->_log('Start'); |
22 | for my $group (@groups) { |
23 | my @waiting; |
24 | for my $host ($self->config->hosts) { |
25 | $self->_log("Beginning to fetch group '$group' on '$host'"); |
26 | push @waiting, [$host, $self->fetch($host, $group)]; |
27 | } |
28 | $self->_log("Now waiting for results"); |
29 | my @results = map { |
30 | my ($host, @futures) = @$_; |
31 | my $done = [$host, await_all @futures]; |
32 | $self->_log("Received all from group '$group' on '$host'"); |
33 | $done; |
34 | } @waiting; |
35 | $self->_log("All gathered for group '$group'"); |
36 | for my $result (@results) { |
37 | my ($host, @data) = @$result; |
38 | $self->_store($host, $group, +{ map %$_, @data }); |
39 | } |
b079a95d |
40 | } |
949dba9c |
41 | $self->_log('Done'); |
b079a95d |
42 | return 1; |
43 | } |
a5e1e1c6 |
44 | |
b079a95d |
45 | sub introspectors { |
46 | my ($self, $group) = @_; |
47 | return $self->config->config_for_group($group)->{introspect}; |
48 | } |
60e1cc39 |
49 | |
60e1cc39 |
50 | sub fetch { |
b079a95d |
51 | my ($self, $host, $group) = @_; |
52 | my $spec = $self->introspectors($group); |
a5e1e1c6 |
53 | my (@sudo, @nosudo); |
54 | push(@{ $spec->{$_}{sudo} ? \@sudo : \@nosudo}, [$_, $spec->{$_}]) |
55 | for sort keys %$spec; |
949dba9c |
56 | my @futures; |
a5e1e1c6 |
57 | if (@nosudo) { |
949dba9c |
58 | $self->_log("Without sudo: ", join ", ", map $_->[0], @nosudo); |
59 | my $proxy = $self->_create_gatherer( |
60 | host => $host, |
61 | introspectors => [@nosudo], |
62 | ); |
63 | push @futures, $proxy->start::gather_all; |
a5e1e1c6 |
64 | } |
65 | if (@sudo) { |
949dba9c |
66 | $self->_log("With sudo: ", join ", ", map $_->[0], @nosudo); |
67 | my $proxy = $self->_create_gatherer( |
68 | sudo => 1, |
69 | host => $host, |
70 | introspectors => [@sudo], |
71 | ); |
72 | push @futures, $proxy->start::gather_all; |
60e1cc39 |
73 | } |
949dba9c |
74 | return @futures; |
60e1cc39 |
75 | } |
76 | |
b079a95d |
77 | sub storage { |
78 | my ($self, @path) = @_; |
79 | my $storage = File::Tree::Snapshot->new( |
80 | allow_empty => 0, |
81 | storage_path => join('/', $self->root, @path), |
82 | ); |
83 | $storage->create |
84 | unless $storage->exists; |
85 | return $storage; |
60e1cc39 |
86 | } |
87 | |
88 | sub _store { |
949dba9c |
89 | my ($self, $host, $group, $gathered) = @_; |
e56ead13 |
90 | $self->_log("Storing data for group '$group' on '$host'"); |
949dba9c |
91 | my $storage = $self->storage($host, $group); |
92 | my $ok = eval { |
b079a95d |
93 | my @files; |
94 | for my $class (sort keys %$gathered) { |
95 | my $file = sprintf '%s.json', join '/', |
96 | map lc, map { |
97 | s{([a-z0-9])([A-Z])}{${1}_${2}}g; |
98 | $_; |
99 | } split m{::}, $class; |
100 | my $fh = $storage->open('>:utf8', $file, mkpath => 1); |
949dba9c |
101 | my $full_path = $storage->file($file); |
102 | $self->_log("Writing $full_path"); |
b079a95d |
103 | print $fh encode_json($gathered->{$class}); |
949dba9c |
104 | push @files, $full_path; |
b079a95d |
105 | } |
106 | $self->_cleanup($storage, [@files]); |
949dba9c |
107 | $self->_log("Committing"); |
b079a95d |
108 | $storage->commit; |
949dba9c |
109 | }; |
110 | unless ($ok) { |
111 | $self->_log("Rolling back snapshot because of: ", $@ || 'unknown error'); |
112 | $storage->rollback; |
113 | die $@; |
60e1cc39 |
114 | } |
60e1cc39 |
115 | return 1; |
116 | } |
117 | |
118 | sub _cleanup { |
b079a95d |
119 | my ($self, $storage, $known_files) = @_; |
60e1cc39 |
120 | my %known = map { ($_ => 1) } @$known_files; |
b079a95d |
121 | my @files = $storage->find_files('json'); |
60e1cc39 |
122 | for my $file (@files) { |
123 | next if $known{$file}; |
949dba9c |
124 | $self->_log("Removing $file"); |
60e1cc39 |
125 | unlink($file) |
126 | or die "Unable to remove '$file': $!\n"; |
127 | } |
128 | return 1; |
129 | } |
130 | |
131 | sub _create_gatherer { |
a5e1e1c6 |
132 | my ($self, %arg) = @_; |
133 | return System::Introspector::Gatherer->new_from_spec( |
949dba9c |
134 | user => $self->user, |
135 | host => $arg{host}, |
136 | sudo_user => $arg{sudo} && $self->sudo_user, |
137 | introspectors => $arg{introspectors}, |
a5e1e1c6 |
138 | ); |
60e1cc39 |
139 | } |
140 | |
141 | 1; |
cd5c3d43 |
142 | |
143 | =head1 NAME |
144 | |
145 | System::Introspector::State - Gather system state |
146 | |
147 | =head1 SYNOPSIS |
148 | |
149 | my $state = System::Introspector::State->new( |
150 | host => 'foo.example.com', |
151 | storage => $storage_obj, |
152 | config => { |
153 | introspect => [qw( ProbeName )], |
154 | }, |
155 | ); |
156 | |
157 | my $data = $state->fetch; |
158 | $state->fetch_and_store; |
159 | |
160 | =head1 DESCRIPTION |
161 | |
162 | Gathers system introspection data based on configuration and stores |
163 | it with a L<File::Tree::Snapshot> object. |
164 | |
165 | =head1 ATTRIBUTES |
166 | |
167 | =head2 config |
168 | |
169 | A hash reference containing a C<introspect> key with an array reference |
170 | value containing a list of probe names without the |
171 | C<System::Introspector::Probe::> prefix. This attribute is required. |
172 | |
173 | =head2 host |
174 | |
175 | An optional hostname. If no hostname is supplied, the local configuration |
176 | data will be fetched. |
177 | |
178 | =head2 storage |
179 | |
180 | A L<File::Tree::Snapshot> object. |
181 | |
182 | =head1 METHODS |
183 | |
184 | =head2 fetch |
185 | |
186 | my $data = $state->fetch; |
187 | |
188 | Fetches all probe data. |
189 | |
190 | =head2 fetch_and_store |
191 | |
192 | $state->fetch_and_store; |
193 | |
194 | Fetches all probe data and stores it in the L</storage>. |
195 | |
196 | =cut |