start of logging support; created role for probes
Tyler Riddle [Tue, 4 Sep 2012 23:48:15 +0000 (16:48 -0700)]
21 files changed:
lib/System/Introspector/Gatherer.pm
lib/System/Introspector/Gatherer/Bridge.pm
lib/System/Introspector/Logger.pm [new file with mode: 0644]
lib/System/Introspector/Logger/Local.pm [new file with mode: 0644]
lib/System/Introspector/Logger/Probe.pm [new file with mode: 0644]
lib/System/Introspector/Logger/Remote.pm [new file with mode: 0644]
lib/System/Introspector/Probe/DiskUsage.pm
lib/System/Introspector/Probe/FileHandles.pm
lib/System/Introspector/Probe/Groups.pm
lib/System/Introspector/Probe/Host.pm
lib/System/Introspector/Probe/Hosts.pm
lib/System/Introspector/Probe/MountPoints.pm
lib/System/Introspector/Probe/Perls.pm
lib/System/Introspector/Probe/Processes.pm
lib/System/Introspector/Probe/Puppet.pm
lib/System/Introspector/Probe/ResolvConf.pm
lib/System/Introspector/Probe/Sudoers.pm
lib/System/Introspector/Probe/Users.pm
lib/System/Introspector/Role/Probe.pm [new file with mode: 0644]
lib/System/Introspector/State.pm
lib/System/Introspector/Util.pm

index 36a8288..8cd708c 100644 (file)
@@ -4,15 +4,19 @@ use Object::Remote;
 use Object::Remote::Future;
 use System::Introspector::Gatherer::Bridge;
 use Module::Runtime qw( use_module );
+use System::Introspector::Logger qw( :log );
 
 has introspectors => (is => 'ro', required => 1);
 
 sub gather_all {
     my ($self) = @_;
     my %report;
+        
     for my $spec (@{ $self->introspectors }) {
         my ($base, $args) = @$spec;
-        $report{$base} = use_module("System::Introspector::Probe::$base")
+        my $module = "System::Introspector::Probe::$base";
+        log_trace { "Using '$module' for this gather" };
+        $report{$base} = use_module($module)
             ->new($args)
             ->gather;
     }
index ffe357c..6efc985 100644 (file)
@@ -2,6 +2,7 @@ package System::Introspector::Gatherer::Bridge;
 use Object::Remote;
 use Object::Remote::Future;
 use Moo;
+use System::Introspector::Logger::Remote qw( set_logger ); 
 
 has remote_spec => (is => 'ro', required => 1);
 has remote_class => (is => 'ro', required => 1);
@@ -10,6 +11,12 @@ has remote => (is => 'lazy');
 
 sub _build_remote {
     my ($self) = @_;
+    my $logger = System::Introspector::Logger::Remote->new({ env_prefix => 'SYSTEM_INTROSPECTOR_LOG' }); 
+    
+    #TODO: this doesn't work because it's not respected on the
+    #remote side
+    set_logger($logger); 
+    
     return $self->remote_class
         ->new::on($self->remote_spec, $self->remote_args);
 }
diff --git a/lib/System/Introspector/Logger.pm b/lib/System/Introspector/Logger.pm
new file mode 100644 (file)
index 0000000..45d26a4
--- /dev/null
@@ -0,0 +1,15 @@
+use strictures 1; 
+
+BEGIN { $ENV{SYSTEM_INTROSPECTOR_LOG_UPTO} = "TRACE" unless exists $ENV{SYSTEM_INTROSPECTOR_LOG_UPTO} };
+
+package System::Introspector::Logger;
+
+use base qw(Log::Contextual);
+use System::Introspector::Logger::Local;
+
+sub arg_default_logger { $_[1] || System::Introspector::Logger::Local->new({
+      env_prefix => 'SYSTEM_INTROSPECTOR_LOG',
+}) };
+
+
+1; 
\ No newline at end of file
diff --git a/lib/System/Introspector/Logger/Local.pm b/lib/System/Introspector/Logger/Local.pm
new file mode 100644 (file)
index 0000000..c3d432f
--- /dev/null
@@ -0,0 +1,18 @@
+use strictures 1; 
+
+package System::Introspector::Logger::Local; 
+
+use base qw ( Log::Contextual::WarnLogger );
+
+sub _log {
+  my $self    = shift;
+  my $level   = shift;
+  my $message = join( "\n", @_ );
+  my @timedata = localtime;
+  my $time = sprintf("%0.2i:%0.2i:%0.2i", $timedata[2], $timedata[1], $timedata[0]);
+  $message .= "\n" unless $message =~ /\n$/;
+  warn "[local $level $time] $message";
+}
+
+1;
+
diff --git a/lib/System/Introspector/Logger/Probe.pm b/lib/System/Introspector/Logger/Probe.pm
new file mode 100644 (file)
index 0000000..3065c03
--- /dev/null
@@ -0,0 +1,14 @@
+use strictures 1; 
+
+BEGIN { $ENV{SYSTEM_INTROSPECTOR_PROBE_LOG_UPTO} = "TRACE" unless exists $ENV{SYSTEM_INTROSPECTOR_PROBE_LOG_UPTO} };
+
+package System::Introspector::Logger::Probe; 
+
+use base qw(System::Introspector::Logger);
+use System::Introspector::Logger::Remote;
+
+sub arg_package_logger { $_[1] || System::Introspector::Logger::Remote->new({
+      env_prefix => 'SYSTEM_INTROSPECTOR_PROBE_LOG',
+}) };
+
+1; 
\ No newline at end of file
diff --git a/lib/System/Introspector/Logger/Remote.pm b/lib/System/Introspector/Logger/Remote.pm
new file mode 100644 (file)
index 0000000..1e9a2c0
--- /dev/null
@@ -0,0 +1,31 @@
+use strictures 1; 
+
+package System::Introspector::Logger::Remote; 
+
+use base qw ( System::Introspector::Logger::Local );
+
+sub new {
+       my ($class, $args) = @_; 
+       my $spec = delete($args->{remote_spec});
+       my $self = $class->SUPER::new($args); 
+       
+       die "must specify 'remote_spec' of machine in arguments to new()" unless defined $spec; 
+       
+       $self->{si}->{remote_spec} = $spec; 
+       
+       return $self; 
+               
+}
+
+sub _log {
+  my $self    = shift;
+  my $level   = shift;
+  my $message = join( "\n", @_ );
+  my $time = localtime; 
+  my $remote = $self->{si}->{remote_spec};
+  $message .= "\n" unless $message =~ /\n$/;
+  warn "[remote:$remote $level $time] $message";
+}
+
+1;
+
index be908c2..e15de2c 100644 (file)
@@ -6,6 +6,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 sub gather {
     my ($self) = @_;
     return transform_exceptions {
index 0f17745..2c5ec2b 100644 (file)
@@ -6,6 +6,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 has lsof_command => (is => 'ro', default => sub { 'lsof' });
 
 sub gather {
index 44cd6ce..4ed4f90 100644 (file)
@@ -6,8 +6,11 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 sub gather {
     my ($self) = @_;
+        
     return transform_exceptions {
         my %group;
         my $fh = $self->_open_group_file;
@@ -24,6 +27,7 @@ sub gather {
                 users   => $users,
             };
         }
+
         return { groups => \%group };
     };
 }
index 6fc2528..0358d5e 100644 (file)
@@ -8,6 +8,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 has hostname_file => (is => 'ro', default => sub {'/etc/hostname' });
 
 sub gather {
index 1ff7f73..5f1bd4d 100644 (file)
@@ -6,6 +6,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 has hosts_file => (
     is      => 'ro',
     default => sub { '/etc/hosts' },
index 2a68a30..0423c62 100644 (file)
@@ -6,6 +6,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 sub gather {
     my ($self) = @_;
     return {
index e898711..432b397 100644 (file)
@@ -12,6 +12,8 @@ has root => (
     default => sub { '/' },
 );
 
+with 'System::Introspector::Role::Probe';
+
 sub gather {
     my ($self) = @_;
     return transform_exceptions {
index 8f711e4..8e11add 100644 (file)
@@ -1,11 +1,14 @@
 package System::Introspector::Probe::Processes;
 use Moo;
 
+with 'System::Introspector::Role::Probe';
+
 use System::Introspector::Util qw(
     handle_from_command
     transform_exceptions
 );
 
+
 # args is automatically included, since it has to be last
 my @Included = qw(
     blocked
@@ -44,6 +47,7 @@ my @Included = qw(
 sub gather {
     my ($self) = @_;
     my @names = (@Included, 'args');
+        
     return transform_exceptions {
         my $pipe = $self->_open_ps_pipe;
         my $spec = <$pipe>;
index 5cd141f..3f0b1c8 100644 (file)
@@ -6,6 +6,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 has classes_file => (
     is      => 'ro',
     default => sub { '/var/lib/puppet/state/classes.txt' },
index 16b7a26..aff40a7 100644 (file)
@@ -6,6 +6,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 has resolv_conf_file => (
     is      => 'ro',
     default => sub { '/etc/resolv.conf' },
index 9db49ac..1fc3277 100644 (file)
@@ -8,6 +8,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+with 'System::Introspector::Role::Probe';
+
 has sudoers_file => (
     is      => 'ro',
     default => sub { '/etc/sudoers' },
index 7e31df7..b844a69 100644 (file)
@@ -10,6 +10,8 @@ use System::Introspector::Util qw(
     handle_from_file
 );
 
+with 'System::Introspector::Role::Probe';
+
 has passwd_file => (is => 'ro', default => sub { '/etc/passwd' });
 
 sub gather {
diff --git a/lib/System/Introspector/Role/Probe.pm b/lib/System/Introspector/Role/Probe.pm
new file mode 100644 (file)
index 0000000..246ad83
--- /dev/null
@@ -0,0 +1,23 @@
+use strictures 1; 
+
+package System::Introspector::Role::Probe; 
+
+use System::Introspector::Logger qw( :log );
+
+use Moo::Role;
+
+requires 'gather';
+
+before gather => sub { 
+       my ($self) = @_; 
+       
+       log_trace { "gather() invoked on instance of " . ref($self) };
+};
+
+after gather => sub {
+       my ($self) = @_;        
+       
+       log_trace { "gather() has completed on instance of " . ref($self) }; 
+};
+
+1; 
\ No newline at end of file
index 7d49312..50512f7 100644 (file)
@@ -3,8 +3,8 @@ use Moo;
 use File::Tree::Snapshot;
 use System::Introspector::Gatherer;
 use Object::Remote::Future qw( await_all );
-
 use JSON::Diffable qw( encode_json );
+use System::Introspector::Logger qw( :log );
 
 has config => (is => 'ro', required => 1);
 
@@ -14,26 +14,27 @@ sub user { $_[0]->config->user }
 
 sub sudo_user { $_[0]->config->sudo_user }
 
-sub _log { shift; printf "[%s] %s\n", scalar(localtime), join '', @_ }
-
 sub gather {
     my ($self, @groups) = @_;
-    $self->_log('Start');
+    log_debug { "Starting to gather results" };
     for my $group (@groups) {
         my @waiting;
         for my $host ($self->config->hosts) {
-            $self->_log("Beginning to fetch group '$group' on '$host'");
+            log_trace { "Adding group '$group' on '$host' to waiting list" };
             push @waiting, [$host, $self->fetch($host, $group)];
         }
-        $self->_log("Now waiting for results");
+        log_debug { sprintf("Waiting for results to become available for %i groups", scalar(@waiting)) };
         for my $wait (@waiting) {
             my ($host, @futures) = @$wait;
+            
+            log_trace { "Waiting for futures on host '$host'" };
+            
             my @data = await_all @futures;
-            $self->_log("Received all from group '$group' on '$host'");
+            log_trace { "Received all from group '$group' on '$host'" };
             $self->_store($host, $group, +{ map %$_, @data });
         }
-    }
-    $self->_log('Done');
+    }   
+    log_debug { "Completed gathering results" };
     return 1;
 }
 
@@ -48,9 +49,10 @@ sub fetch {
     my (@sudo, @nosudo);
     push(@{ $spec->{$_}{sudo} ? \@sudo : \@nosudo}, [$_, $spec->{$_}])
         for sort keys %$spec;
-    my @futures;
+    my @futures; 
+    log_debug { sprintf("Fetching results for '%s': sudo:%i nosudo:%i", $host, scalar(@sudo), scalar(@nosudo)) };   
     if (@nosudo) {
-        $self->_log("Without sudo: ", join ", ", map $_->[0], @nosudo);
+        log_trace { "Preparing to fetch without sudo: " . join ", ", map $_->[0], @nosudo };
         my $proxy = $self->_create_gatherer(
             host => $host,
             introspectors => [@nosudo],
@@ -58,7 +60,7 @@ sub fetch {
         push @futures, $proxy->start::gather_all;
     }
     if (@sudo) {
-        $self->_log("With sudo: ", join ", ", map $_->[0], @nosudo);
+        log_trace { "Preparing to fetch with sudo: ", join ", ", map $_->[0], @nosudo };
         my $proxy = $self->_create_gatherer(
             sudo => 1,
             host => $host,
@@ -66,6 +68,8 @@ sub fetch {
         );
         push @futures, $proxy->start::gather_all;
     }
+    
+    log_trace { sprintf("Fetching resulted in %i futures being created", scalar(@futures)) };
     return @futures;
 }
 
@@ -82,7 +86,7 @@ sub storage {
 
 sub _store {
     my ($self, $host, $group, $gathered) = @_;
-    $self->_log("Storing data for group '$group' on '$host'");
+    log_debug { "Storing data for group '$group' on '$host'" };
     my $storage = $self->storage($host, $group);
     my $ok = eval {
         my @files;
@@ -94,16 +98,16 @@ sub _store {
                 } split m{::}, $class;
             my $fh = $storage->open('>:utf8', $file, mkpath => 1);
             my $full_path = $storage->file($file);
-            $self->_log("Writing $full_path");
+            log_trace { "Writing state to '$full_path'" };
             print $fh encode_json($gathered->{$class});
             push @files, $full_path;
         }
         $self->_cleanup($storage, [@files]);
-        $self->_log("Committing");
+        log_trace { "Comitting stored data" };
         $storage->commit;
     };
     unless ($ok) {
-        $self->_log("Rolling back snapshot because of: ", $@ || 'unknown error');
+        log_error { "Rolling back snapshot because of: " . $@ || 'unknown error' };
         $storage->rollback;
         die $@;
     }
@@ -114,9 +118,10 @@ sub _cleanup {
     my ($self, $storage, $known_files) = @_;
     my %known = map { ($_ => 1) } @$known_files;
     my @files = $storage->find_files('json');
+       log_debug { "Cleaning up" };
     for my $file (@files) {
         next if $known{$file};
-        $self->_log("Removing $file");
+        log_trace { "Removing $file" };
         unlink($file)
             or die "Unable to remove '$file': $!\n";
     }
index 8681b28..a2940c5 100644 (file)
@@ -7,6 +7,7 @@ use IPC::Open2;
 use File::Spec;
 use Scalar::Util qw( blessed );
 use Capture::Tiny qw( capture_stderr );
+use Log::Contextual qw( :log );
 
 our @EXPORT_OK = qw(
     handle_from_command