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         for my $wait (@waiting) {
  30             my ($host, @futures) = @$wait;
  31             my @data = await_all @futures;
  32             $self->_log("Received all from group '$group' on '$host'");
  33             $self->_store($host, $group, +{ map %$_, @data });
  34         }
  35     }
  36     $self->_log('Done');
  37     return 1;
  38 }
  39
  40 sub introspectors {
  41     my ($self, $group) = @_;
  42     return $self->config->config_for_group($group)->{introspect};
  43 }
  44
  45 sub fetch {
  46     my ($self, $host, $group) = @_;
  47     my $spec = $self->introspectors($group);
  48     my (@sudo, @nosudo);
  49     push(@{ $spec->{$_}{sudo} ? \@sudo : \@nosudo}, [$_, $spec->{$_}])
  50         for sort keys %$spec;
  51     my @futures;
  52     if (@nosudo) {
  53         $self->_log("Without sudo: ", join ", ", map $_->[0], @nosudo);
  54         my $proxy = $self->_create_gatherer(
  55             host => $host,
  56             introspectors => [@nosudo],
  57         );
  58         push @futures, $proxy->start::gather_all;
  59     }
  60     if (@sudo) {
  61         $self->_log("With sudo: ", join ", ", map $_->[0], @nosudo);
  62         my $proxy = $self->_create_gatherer(
  63             sudo => 1,
  64             host => $host,
  65             introspectors => [@sudo],
  66         );
  67         push @futures, $proxy->start::gather_all;
  68     }
  69     return @futures;
  70 }
  71
  72 sub storage {
  73     my ($self, @path) = @_;
  74     my $storage = File::Tree::Snapshot->new(
  75         allow_empty  => 0,
  76         storage_path => join('/', $self->root, @path),
  77     );
  78     $storage->create
  79         unless $storage->exists;
  80     return $storage;
  81 }
  82
  83 sub _store {
  84     my ($self, $host, $group, $gathered) = @_;
  85     $self->_log("Storing data for group '$group' on '$host'");
  86     my $storage = $self->storage($host, $group);
  87     my $ok = eval {
  88         my @files;
  89         for my $class (sort keys %$gathered) {
  90             my $file = sprintf '%s.json', join '/',
  91                 map lc, map {
  92                     s{([a-z0-9])([A-Z])}{${1}_${2}}g;
  93                     $_;
  94                 } split m{::}, $class;
  95             my $fh = $storage->open('>:utf8', $file, mkpath => 1);
  96             my $full_path = $storage->file($file);
  97             $self->_log("Writing $full_path");
  98             print $fh encode_json($gathered->{$class});
  99             push @files, $full_path;
 100         }
 101         $self->_cleanup($storage, [@files]);
 102         $self->_log("Committing");
 103         $storage->commit;
 104     };
 105     unless ($ok) {
 106         $self->_log("Rolling back snapshot because of: ", $@ || 'unknown error');
 107         $storage->rollback;
 108         die $@;
 109     }
 110     return 1;
 111 }
 112
 113 sub _cleanup {
 114     my ($self, $storage, $known_files) = @_;
 115     my %known = map { ($_ => 1) } @$known_files;
 116     my @files = $storage->find_files('json');
 117     for my $file (@files) {
 118         next if $known{$file};
 119         $self->_log("Removing $file");
 120         unlink($file)
 121             or die "Unable to remove '$file': $!\n";
 122     }
 123     return 1;
 124 }
 125
 126 sub _create_gatherer {
 127     my ($self, %arg) = @_;
 128     return System::Introspector::Gatherer->new_from_spec(
 129         user          => $self->user,
 130         host          => $arg{host},
 131         sudo_user     => $arg{sudo} && $self->sudo_user,
 132         introspectors => $arg{introspectors},
 133     );
 134 }
 135
 136 1;
 137
 138 =head1 NAME
 139
 140 System::Introspector::State - Gather system state
 141
 142 =head1 SYNOPSIS
 143
 144     my $state = System::Introspector::State->new(
 145         root    => '/root/path',
 146         config  => $config_object,
 147     );
 148
 149     $state->gather;
 150
 151 =head1 DESCRIPTION
 152
 153 Gathers system introspection data based on configuration and stores
 154 it with a L<File::Tree::Snapshot> object.
 155
 156 =head1 ATTRIBUTES
 157
 158 =head2 config
 159
 160 A L<System::Introspector::Config>
 161
 162 =head2 root
 163
 164 Path to the storage root.
 165
 166 =head1 METHODS
 167
 168 =head2 gather
 169
 170     $state->gather;
 171
 172 Fetches all probe data and stores it in the tree below the L</root>.
 173
 174 =head1 SEE ALSO
 175
 176 =over
 177
 178 =item L<System::Introspector>
 179
 180 =back
 181
 182 =head1 COPYRIGHT
 183
 184 Copyright (c) 2012 the L<System::Introspector>
 185 L<AUTHOR|System::Introspector/AUTHOR>,
 186 L<CONTRIBUTORS|System::Introspector/CONTRIBUTORS> and
 187 L<SPONSORS|System::Introspector/SPONSORS>.
 188
 189 =head1 LICENSE
 190
 191 This library is free software and may be distributed under the same terms
 192 as perl itself.
 193
 194 =cut