lib/System/Introspector/State.pm

   1 package System::Introspector::State;
   2 use Moo;
   3 use File::Tree::Snapshot;
   4 use System::Introspector::Gatherer;
   5 use Object::Remote::Future qw( await_all );
   6
   7 use JSON::Diffable qw( encode_json );
   8
   9 has config => (is => 'ro', required => 1);
  10
  11 has root => (is => 'ro', required => 1);
  12
  13 sub user { $_[0]->config->user }
  14
  15 sub sudo_user { $_[0]->config->sudo_user }
  16
  17 sub _log { shift; printf "[%s] %s\n", scalar(localtime), join '', @_ }
  18
  19 sub gather {
  20     my ($self, @groups) = @_;
  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         }
  40     }
  41     $self->_log('Done');
  42     return 1;
  43 }
  44
  45 sub introspectors {
  46     my ($self, $group) = @_;
  47     return $self->config->config_for_group($group)->{introspect};
  48 }
  49
  50 sub fetch {
  51     my ($self, $host, $group) = @_;
  52     my $spec = $self->introspectors($group);
  53     my (@sudo, @nosudo);
  54     push(@{ $spec->{$_}{sudo} ? \@sudo : \@nosudo}, [$_, $spec->{$_}])
  55         for sort keys %$spec;
  56     my @futures;
  57     if (@nosudo) {
  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;
  64     }
  65     if (@sudo) {
  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;
  73     }
  74     return @futures;
  75 }
  76
  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;
  86 }
  87
  88 sub _store {
  89     my ($self, $host, $group, $gathered) = @_;
  90     $self->_log("Storing data for group '$group' on '$host'");
  91     my $storage = $self->storage($host, $group);
  92     my $ok = eval {
  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);
 101             my $full_path = $storage->file($file);
 102             $self->_log("Writing $full_path");
 103             print $fh encode_json($gathered->{$class});
 104             push @files, $full_path;
 105         }
 106         $self->_cleanup($storage, [@files]);
 107         $self->_log("Committing");
 108         $storage->commit;
 109     };
 110     unless ($ok) {
 111         $self->_log("Rolling back snapshot because of: ", $@ || 'unknown error');
 112         $storage->rollback;
 113         die $@;
 114     }
 115     return 1;
 116 }
 117
 118 sub _cleanup {
 119     my ($self, $storage, $known_files) = @_;
 120     my %known = map { ($_ => 1) } @$known_files;
 121     my @files = $storage->find_files('json');
 122     for my $file (@files) {
 123         next if $known{$file};
 124         $self->_log("Removing $file");
 125         unlink($file)
 126             or die "Unable to remove '$file': $!\n";
 127     }
 128     return 1;
 129 }
 130
 131 sub _create_gatherer {
 132     my ($self, %arg) = @_;
 133     return System::Introspector::Gatherer->new_from_spec(
 134         user          => $self->user,
 135         host          => $arg{host},
 136         sudo_user     => $arg{sudo} && $self->sudo_user,
 137         introspectors => $arg{introspectors},
 138     );
 139 }
 140
 141 1;
 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