#!/usr/bin/perl -wT
#
# $Id: lrrd-client.in,v 1.25 2003/12/10 15:30:02 jimmyo Exp $
#
# $Log: lrrd-client.in,v $
# Revision 1.25  2003/12/10 15:30:02  jimmyo
# Set path before trying to get hostname
#
# Revision 1.24  2003/12/10 15:11:40  jimmyo
# A couple of bugfixes.
#
# Revision 1.23  2003/11/17 09:23:08  jimmyo
# Fix taint checking for getting hostname
#
# Revision 1.22  2003/11/17 09:20:09  jimmyo
# Fix for machines which don't have "host".
#
# Revision 1.21  2003/11/07 17:43:16  jimmyo
# Cleanups and log entries
#
#

package MyPackage;

use strict;
use vars qw(@ISA);
use Getopt::Long;
use Net::Server::Fork; # any personality will do

@ISA = qw(Net::Server::Fork);
my @ORIG_ARGV = @ARGV;
my %services;
my %nodes;
my $servicedir="/etc/lrrd/client.d";
my $sconfdir="/etc/lrrd/client-conf.d";
my $conffile="/etc/lrrd/client.conf";
my $FQDN="";
my $do_usage = 0;
my $DEBUG = 0;
my $do_version = 0;
my $VERSION="0.9.9r5";
my $defuser = getpwnam ("nobody");
my $defgroup= getgrnam ("lrrd");
my $paranoia= 0;
my %sconf  = ();

$do_usage=1  unless 
GetOptions ( "config=s"     => \$conffile,
             "debug!"       => \$DEBUG,
             "version!"     => \$do_version,
             "paranoia!"    => \$paranoia,
             "help"         => \$do_usage );

if ($do_usage)
{
    print "Usage: $0 [options]

Options:
    --help              View this message.
    --config <file>     Use <file> as configuration file. 
                        [/etc/lrrd/client.conf]
    --[no]paranoia      Only run plugins owned by root. Check permissions.
                        [--noparanoia]
    --debug             View debug messages.
    --version           View version information.

";
    exit 0;
}

if ($do_version)
{
	print "lrrd-client (lrrd-client) version $VERSION.
Written by Audun Ytterdal, Jimmy Olsen, Tore Anderson / Linpro AS

Copyright (C) 2002-2003
This is free software released under the GNU Public License. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
";
	exit 0;
}

# Reset ARGV (for HUPing)
@ARGV = @ORIG_ARGV;

# Check permissions of configuration

if (!&check_perms ($servicedir) or !&check_perms ($conffile))
{
	die "Fatal error. Bailing out.";
}

if (! -f $conffile) {
  print "ERROR: Cannot open $conffile\n";
  exit 1;
}

# A hack to overide the hostname if everyhing thing else fails
open FILE,$conffile or die "Cannot open $conffile\n";
while (<FILE>) {
  chomp;
  s/#.*//;                # no comments
  s/^\s+//;               # no leading white
  s/\s+$//;               # no trailing white
  next unless length;     # anything left?
  /(^\w*)\s+(.*)/;
  if (($1 eq "host_name" or $1 eq "hostname") and $2)
  {
      $FQDN=$2;
  }
  elsif (($1 eq "default_plugin_user" or $1 eq "default_client_user") and $2)
  {
      my $tmpid = $2;
      my $defuser = &get_uid ($tmpid);
      if (! defined ($defuser))
      {
	  die "Default user defined in \"$conffile\" does not exist ($tmpid)";
      }
  }
  elsif (($1 eq "default_plugin_group" or $1 eq "default_client_group") and $2)
  {
      my $tmpid = $2;
      $defgroup = &get_gid ($tmpid);
      if (! defined ($defgroup))
      {
	  die "Default group defined in \"$conffile\" does not exist ($tmpid)";
      }
  }
  elsif (($1 eq "paranoia") and defined $2)
  {
	  if ("$2" eq "no" or "$2" eq "false" or "$2" eq "off" or "$2" eq "0")
	  {
		  $paranoia = 0;
	  }
	  else
	  {
		  $paranoia = 1;
	  }
  }
}

$FQDN ||= &get_fq_hostname;

$ENV{FQDN}=$FQDN;

&load_services;

MyPackage->run(conf_file => $conffile,
	       pid_file => "/var/run/lrrd/lrrd-client.pid");
exit;




### over-ridden subs below

sub show_version {
  print "lrrd client on $FQDN version: $VERSION\n"
}

sub show_nodes {
  for my $node (keys %nodes) {
    print "$node\n";
  }
  print ".\n";
}

sub get_fq_hostname {
    my $hostname;
    eval {
        require Net::Domain;
        $hostname = Net::Domain::hostfqdn();
    };
    return $hostname if $hostname;

	# I _know_ the path is "insecure". Force it anyway (we're
	# using taint checking for other purposes. If the admin
	# wants to play with the PATH, let her/him do it.
	$ENV{PATH} =~ /^(.*)$/;
	$ENV{PATH} = $1;

    $hostname = `hostname`;  # Fall$
    chomp($hostname);
    $hostname =~ s/\s//g;
    return $hostname;
}

sub load_services {
    if (opendir (DIR,$sconfdir))
    {
	for my $file (grep { -f "$sconfdir/$_" } readdir (DIR))
	{
	    next if $file =~ m/^\./; # Hidden files
	    next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
	    $file = $1; # Not tainted anymore.
	    if (!&load_auth_file ($sconfdir, $file, \%sconf))
	    {
		warn "Something wicked happened while reading \"$servicedir/$file\". Check the previous log lines for spesifics.";
	    }
	}
	closedir (DIR);
    }
    
    opendir (DIR,$servicedir) || die "Cannot open plugindir: $servicedir $!";
    for my $file (grep { -f "$servicedir/$_" } readdir(DIR)) {
	next if $file =~ m/^\./; # Hidden files
	next if $file =~ m/.conf$/; # Config files
	next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
	$file = $1; # Not tainted anymore.
	next if (! -x "$servicedir/$file"); # File not executeable
	print "file: '$file'\n" if $DEBUG;
	$services{$file}=1;
	my @rows = &run_service($file,"config");
	my $node = &get_var (\%sconf, $file, 'host_name') || $FQDN;

	for my $row (@rows) {
	  print "row: $row\n" if $DEBUG;
	  if ($row =~ m/^host_name (.+)$/) {
	    print "Found host_name, using it\n" if $DEBUG;
	    $node = $1;
	  }
	}
	$nodes{$node}{$file}=1;
    }
    closedir DIR;
}

sub print_service {
  my (@lines) = @_;
  for my $line (@lines) {
    print "$line\n";
  }
  print ".\n";
}

sub list_services {
    my $node = $_[0] || $FQDN;
    print join " ", keys %{$nodes{$node}};
    print "\n";
}


sub reap_children {
  my ($child) = @_;
  return unless $child;
  my @children = (split ('\n', `/usr/bin/pgrep -P $child`), $child); 
  if (@children) 
    { 
      print ("# timeout pid ", join (' ', @children), "\n"); 
      close CHILD; 
      kill (1, @children); sleep 2; 
      kill (9, @children);
    } 
}

sub run_service {
  my ($service,$command) = @_;
  $command ||="";
  my @lines = ();;
  my $timed_out = 0;
  if ($services{$service}) {
    my $child = 0;
    local $SIG{ALRM} = sub { 
      $timed_out = 1; 
    };

    if ($child = open (CHILD, "-|")) {
      alarm(10);
      while(<CHILD>) {
	push @lines,$_;
	if( $timed_out ) {
	  reap_children($child);
	  return ();
	}
      }
      close CHILD;
    }
    else {
      if ($child == 0) {
        # Setting environment
	$sconf{$service}{user}    = &get_var (\%sconf, $service, 'user');
	$sconf{$service}{group}   = &get_var (\%sconf, $service, 'group');
	$sconf{$service}{command} = &get_var (\%sconf, $service, 'command');
	&get_var (\%sconf, $service, 'env', \%{$sconf{$service}{env}});
	
	# Giving up gid egid uid euid
	my $u  = (defined $sconf{$service}{'user'}?
		$sconf{$service}{'user'}:
		$defuser);
	my $g  = (defined $sconf{$service}{'group'}?
		$sconf{$service}{'group'}:
		$defgroup);
	my $gs = "$g $g" .
	    ($sconf{$service}{'group'}?" $sconf{$service}{group}":"");

	print "# Want to run as euid/egid $u/$g\n" if $DEBUG;

	$( = $g    unless $g == 0;
	$) = $gs   unless $g == 0;
	$< = $u    unless $u == 0;
	$> = $u    unless $u == 0;

	if ($> != $u or $g != (split (' ', $)))[0])
	{
	    print "# Can't drop privileges. Bailing out. (wanted uid=",
	    ($sconf{$service}{'user'} || $defuser), " gid=\"",
	    $gs, "\"($g), got uid=$> gid=\"$)\"(", (split (' ', $)))[0], ").\n";
	    exit 1;
	}
	print "# Running as uid/gid/euid/egid $</$(/$>/$)\n" if $DEBUG;
	if (!&check_perms ("$servicedir/$service"))
	{
	    print "# Error: unsafe permissions. Bailing out.";
	    exit 1;
	}

	# Setting environment...
	if (exists $sconf{$service}{'env'} and
			defined $sconf{$service}{'env'})
	{
	    foreach my $key (keys %{$sconf{$service}{'env'}})
	    {
		print "Setting environment $key=$sconf{$service}{env}{$key}\n" if $DEBUG;
		$ENV{"$key"} = $sconf{$service}{'env'}{$key};
	    }
	}
	if (exists $sconf{$service}{'command'} and 
		defined $sconf{$service}{'command'})
	{
	    my @run = ();
	    foreach my $t (@{$sconf{$service}{'command'}})
	    {
		if ($t =~ /^%c$/)
		{
		    push (@run, "$servicedir/$service", $command);
		}
		else
		{
		    push (@run, $t);
		}
	    }
	    print STDERR "About to run \"", join (' ', @run), "\"\n" if $DEBUG;
	    print "About to run \"", join (' ', @run), "\"\n" if $DEBUG;
	    exec (@run) if @run;
	}
	else
	{
	    # I _know_ the path is "insecure". Force it anyway (we've
	    # dropped privs, and we want to allow setting path for
	    # scripts before running lrrd-client
	    $ENV{PATH} =~ /^(.*)$/;
	    $ENV{PATH} = $1;

	    exec ("$servicedir/$service", $command);
	}
      }
      else {
	print "# Unable to fork.\n";
	print STDERR "Unable to fork.\n";
      }
    }
    wait;
    alarm(0);
  }
  else {
    print "# Unknown service\n";
  }
  chomp @lines;
  return (@lines);
}

sub process_request {
  my $self = shift;
  print "# lrrd client at $FQDN\n";
  local $SIG{ALRM} = sub { die "timeout" };
  alarm(10);
  while( <STDIN> ){
    alarm(30);
    chomp;
    if (m/^list\s*([0-9a-zA-Z\.\-]+)?/) {
      &list_services($1);
    }
    elsif (/^quit/ || /^\./) {
      exit 1;
    }
    elsif (/^version/) {
      &show_version;
	}
    elsif (/^nodes/) {
      &show_nodes;
    }
    elsif (/^fetch\s?(\S*)/) {
      print_service (&run_service($1)) 
    }
    elsif (/^config\s?(\S*)/) {
      print_service (&run_service($1,"config"));
    } else  {
      print "# Unknown command. Try list, nodes, config, fetch, version or quit\n";
    }
  }
}

sub get_uid
{
    my $user = shift;
    return undef if (!defined $user);

    if ($user !~ /\d/)
    {
	$user = getpwnam ($user);
    }
    return $user;
}

sub get_gid
{
    my $group = shift;
    return undef if (!defined $group);

    if ($group !~ /\d/)
    {
	$group = getgrnam ($group);
    }
    return $group;
}

sub load_auth_file 
{
    my ($dir, $file, $sconf) = @_;
    my $service = $file;

    if (!defined $dir or !defined $file or !defined $sconf)
    {
	return undef;
    }

    return undef if (!&check_perms ($dir));
    return undef if (!&check_perms ("$dir/$file"));

    if (!open (IN, "$dir/$file"))
    {
	warn "Could not open file \"$dir/$file\" for reading ($!), skipping plugin\n";
	return undef;
    }
    while (<IN>)
    {
	chomp;
	s/#.*$//;
	next unless /\S/;
	s/\s+$//g;
	print "DEBUG: Config: $service: $_\n" if $DEBUG;
	if (/^\s*\[([^\]]+)\]\s*$/)
	{
	    $service = $1;
	}
	elsif (/^\s*user\s+(\w+)\s*$/)
	{
	    my $tmpid = $1;
	    $sconf->{$service}{'user'} = &get_uid ($tmpid);
	    print "DEBUG: Config: $service->uid = ", $sconf->{$service}{'user'}, "\n" if $DEBUG;
	    if (!defined $sconf->{$service}{'user'})
	    {
		warn "User \"$tmpid\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
		return undef;
	    }
	}
	elsif (/^\s*group\s+(\w+)\s*$/)
	{
	    my $tmpid = $1;
	    $sconf->{$service}{'group'} = &get_gid ($tmpid);
	    print "DEBUG: Config: $service->gid = ", $sconf->{$service}{'user'}, "\n" if $DEBUG;
	    if (!defined $sconf->{$service}{'group'})
	    {
		warn "Group \"$tmpid\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
		return undef;
	    }
	}
	elsif (/^\s*command\s+(.+)\s*$/)
	{
	    @{$sconf->{$service}{'command'}} = split (/\s+/, $1);
	}
	elsif (/^\s*host_name\s+(.+)\s*$/)
	{
	    $sconf->{$service}{'host_name'} = $1;
	}
	elsif (/^\s*env\s+([^=\s]+)\s*=\s*(.+)$/)
	{
	    $sconf->{$service}{'env'}{$1} = $2;
	    print "Saving $service->env->$1 = $2...\n" if $DEBUG;
	    warn "Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"env $1=$2\" should be rewritten to \"env.$1 $2\").";
	}
	elsif (/^\s*env\.(\S+)\s+(.+)$/)
	{
	    $sconf->{$service}{'env'}{$1} = $2;
	    print "Saving $service->env->$1 = $2...\n" if $DEBUG;
	}
	elsif (/^\s*(\w+)\s+(.+)$/)
	{
	    $sconf->{$service}{'env'}{"lrrd_$1"} = $2;
	    print "Saving $service->env->lrrd_$1 = $2...\n" if $DEBUG;
	    warn "Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"$1 $2\" should be rewritten to \"env lrrd_$1=$2\").";
	}
	elsif (/\S/)
	{
	    warn "Warning: Unknown config option in \"$dir/$file\" under \"[$service]\": $_";
	}

    }
    close (IN);

    return 1;
}

sub check_perms
{
    my $target = shift;
    my @stat;
    return undef if (!defined $target);
	return 1 if (!$paranoia);

    if (! -e "$target")
    {
	warn "Failed to check permissions on nonexistant target: \"$target\"";
	return undef;
    }

    @stat = stat ($target);
    if (!$stat[4] == 0 or
	($stat[5] != 0 and $stat[2] & 00020) or
	($stat[2] & 00002))
    {
	warn "Warning: \"$target\" has dangerous permissions (", sprintf ("%04o", $stat[2] & 07777), ").";
	return 0;
    }

    if (-f "$target") # Check dir as well
    {
	(my $dirname = $target) =~ s/[^\/]+$//;
	return &check_perms ($dirname);
    }

    return 1;
}

sub get_var
{
    my $sconf   = shift;
    my $name    = shift;
    my $var     = shift;
    my $env     = shift;

    if ($var eq 'env' and !defined $env)
    {
	%{$env} = ();
    }
    
    if ($var ne 'env' and exists $sconf->{$name}{$var})
    {
	return $sconf->{$name}{$var};
    }
    # Deciding environment
    foreach my $wildservice (grep (/\*$/, reverse sort keys %{$sconf}))
    {
	(my $tmpservice = $wildservice) =~ s/\*$//;
	next unless ($name =~ /^$tmpservice/);
	print "Checking $wildservice...\n" if $DEBUG;

	if ($var eq 'env')
	{
	    if (exists $sconf->{$wildservice}{'env'})
	    {
		foreach my $key (keys %{$sconf->{$wildservice}{'env'}})
		{
		    if (! exists $sconf->{$name}{'env'}{$key})
		    {
			$sconf->{$name}{'env'}{$key} = $sconf->{$wildservice}{'env'}{$key};
			print "Saving $wildservice->$key\n" if $DEBUG;
		    }
		}
	    }
	}
	else
	{
	    if (! exists $sconf->{$name}{$var} and
		    exists $sconf->{$wildservice}{$var})
	    {
		return ($sconf->{$wildservice}{$var});
	    }
	}
    }
    return $env;
}

1;

=head1 NAME

lrrd-client - A daemon to gather information in cooperation with lrrd-server

=head1 SYNOPSIS

lrrd-client [--options]

=head1 OPTIONS

=over 5

=item B<< --config <configfile> >>

Use E<lt>fileE<gt> as configuration file. [/etc/lrrd/client.conf]

=item B< --[no]paranoia >

Only run plugins owned by root. Check permissions as well. [--noparanoia]

=item B< --help >

View this help message.

=item B< --debug >

View debug messages.

=back

=head1 DESCRIPTION

LRRD-client is the client in a server/client pair that graph, htmlifies
and optionaly warns nagios about data it gathers. It's designed to let
it be very easy to graph new datasources.

Lrrd-client is a small perlscript listening to port 4949 using
Net::Server. It reads all the plugins in /etc/lrrd/lrrd-client.d on
startup. The client accepts the following commands:

=over 5

=item B<< list [node] >>

list available plugins for host. If no hostname is specified, list plugins
on host running lrrd-client

=item B<< nodes >>

List nodes that has plugins in this lrrd-client.

=item B<< config <plugin> >>

output plugin configuration

=item B<< fetch <plugin> >>

output plugin values

=item B<< version >>

Print versionstring

=item B<< quit >>

disconnect

=back

=head2 Plugins

These plugins can be in you language of choice: bash, perl, python, C. The
plugins can be run in two modes: with and without the "config"-parameter. When
run with "config" as parameter, the plugin should output the configuration of
the graph. When run without parameters, the plugin should output just values

	# /etc/lrrd/client.d/load config
	host_name 
	graph_title Load average
	graph_args --base 1000 -l 0
	graph_vlabel load
	load.label load
	load.draw LINE2
	load.warning 10
	load.critical 120

	# /etc/lrrd/client.d/load
	load.value 0.43

For more information, see the documentation section at L<http://lrrd.sf.net/>.

=head1 FILES

	/etc/lrrd/client.conf
	/etc/lrrd/client.d/*
	/etc/lrrd/client-conf.d/*
	/var/run/lrrd/lrrd-client.pid
	/var/log/lrrd/lrrd-client

=head1 VERSION

This is lrrd-client v0.9.9r5

=head1 AUTHORS

Audun Ytterdal, Jimmy Olsen, and Tore Anderson.

=head1 BUGS

lrrd-client does, as of now, not check the syntax of the configuration file.

Please report other bugs in the bug tracker at L<http://lrrd.sf.net/>.

=head1 COPYRIGHT

Copyright  2002 Audun Ytterdal, Jimmy Olsen, and Tore Anderson / Linpro AS.

This is free software; see the source for copying conditions. There is
NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.

This program is released under the GNU General Public License

=cut

# vim:syntax=perl
