#!/usr/bin/perl -w

=head1 NAME

autoapt - Automatically manipulate the Debian packages on a host.

=head1 SYNOPSIS

  autoapt [options] --filename foo.conf --classes=aa:bb:cc

  Help Options:
   --debug      Write debug information to /tmp/autoapt.log
   --verbose    Show useful debugging information.
   --help       Show this scripts help information.
   --manual     Read this scripts manual.

  General Options:
   --classes    The classes which are defined.
   --filename   The configuration file to read.
   --hostname   Set the hostname to match against.
   --timeout=N  Specify the timeout for external commands, in seconds.

=cut



=head1 OPTIONS

=over 8

=item B<--classes>
The classes defined by CFEngine for this host, which are colon-seperated.

=item B<--filename>
The filename of the configuration file to read.

=item B<--help>
Show the brief help information.

=item B<--hostname>
Set the hostname of the new instance.

=item B<--manual>
Read the manual, with examples.

=item B<--timeout>
Specify the timeout period to wait for external commands to finish within.  This is specified in seconds.

=item B<--verbose>
Display diagnostics during execution.

=back

=cut


=head1 DESCRIPTION

  autoapt is a simple script which will allow you to install, remove
 or check the versions of Debian packages upon a number of hosts.

  Whilst it isn't terribly useful upon a single host it can be very
 useful when distributed to a number of hosts by a system such as
 CFEngine - since it allows you to force the installation, removal,
 or upgrade, of packages from a single host upon a number of systems.

=cut


=head1 CONFIGURATION

  The script is configured via the use of a number of files describing
 packages to be updated.

  The configuration file may contain comments which begin with the
 hash '#' character.  Otherwise the format is 'host: packages'.

  'hostname' may either by a host which means that line applies to the
 given host, or '*' to apply to all hosts.

  'packages' is a space-seperated list of packages which should be
 installed, removed, or version checked.

  The following is an example configuration file:

=for example begin

  #
  # Install 'less', 'screen', 'sudo', and 'vim' on all systems.
  #
  *: less screen sudo vim

  #
  # Make sure the 'nvi' package is removed from all hosts.
  #
  *: -nvi

  #
  # If package foo is installed, and has a version different to
  # 1.2.3 then upgrade it.
  *: foo=1.2.3

=for example end

  Note that when adding a version-checked package it will only
 be upgraded if it is installed.  This is the preferred way to
 handle security updates, etc.

=cut

=head1 AUTHOR


 Steve
 --
 http://www.steve.org.uk/

 $Id: autoapt.pl.txt,v 1.2 2007-01-28 20:17:29 steve Exp $

=cut


=head1 LICENSE

Copyright (c) 2006 by Steve Kemp.  All rights reserved.

This module is free software;
you can redistribute it and/or modify it under
the same terms as Perl itself.
The LICENSE file contains the full text of the license.

=cut


use strict;
use warnings;
use English;
use Getopt::Long;
use Pod::Usage;
use Sys::Hostname;


#
#  Global configuration options.
#
my %CONFIG ;

#
#  Default options
#
$CONFIG{'filename'} = '';
$CONFIG{'debug'}    = 0;
$CONFIG{'timeout'}  = 300;
$CONFIG{'classes'}  = $ENV{'CFALLCLASSES'};


#
#  Make sure we have a sane environment setup.
#
$ENV{PATH}	      = "/bin:/sbin:/usr/bin:/usr/sbin";
$ENV{DEBIAN_FRONTEND} = "noninteractive";


#
#  Test that the user is root.  This is required to run apt-get.
#
if ( $EFFECTIVE_USER_ID != 0 )
{
    print <<E_O_ROOT;
  In order to use this script you must be running with root privileges.
E_O_ROOT

    exit;
}


#
#  Parse our command line arguments.
#
parseCommandLineArguments();


#
#  Don't update factotum
#
exit if ( $CONFIG{'hostname'} =~ /fact/i );

#
#  Make sure we have a configuration file.
#
if ( ! -e $CONFIG{'filename'} )
{
    print "Filename argument is mandatory\n";
    exit;
}

#
#  Make sure we recieved some classes.
#
if ( ! length( $CONFIG{'classes'} ) )
{
    print "Classes aren't set. Error\n";
    exit;
}


#
#  Log our classes, for debugging purposes
#
logClasses() if ( $CONFIG{'debug'} );


#
#  Process each file we were given on the command line.
#
$CONFIG{'verbose'} && print "Reading file: $CONFIG{'filename'}\n\n";
processFile( $CONFIG{'filename'} );


#
#  All done.
#
exit;






=head2 parseCommandLineArguments

  Parse the command line arguments which might be present.

=cut

sub parseCommandLineArguments
{
    my $HELP	= 0;
    my $MANUAL	= 0;

    #  Parse options.
    #
    GetOptions(
               "classes=s"  => \$CONFIG{'classes'},
               "debug"      => \$CONFIG{'debug'},
               "filename=s" => \$CONFIG{'filename'},
	       "help"       => \$HELP,
	       "hostname=s" => \$CONFIG{'hostname'},
	       "manual"     => \$MANUAL,
	       "timeout=i"  => \$CONFIG{'timeout'},
	       "verbose"    => \$CONFIG{'verbose'},
	      );

    pod2usage(1) if $HELP;
    pod2usage(-verbose => 2 ) if $MANUAL;


    #
    # Find the hostname of the current machine if one wasn't specified on
    # the command line.
    #
    if ( !defined( $CONFIG{'hostname'} ) )
    {
        $CONFIG{'hostname'} = getHostname();
    }
}





=head2 readPackages

  Read the configuration file specified and build up a list of
 packags to be installed, removed and version-checked upon this host.

=cut

sub readPackages
{
    my ( $filename ) = ( @_ );

    my @pkgs  = ();

    open(CONFIG, "<", $filename) or die "Can't open file $filename): $!";
    while (<CONFIG>)
    {
	chomp();

	# Strip empty lines and comments
	next if( /^\s*$/);
	next if( /^\s*\#/);

	# Split into host + packages.
	my ($f, $r) = split(/:/);

	#
	#  Add the package(s) to the list if it is a wildcard line.
	#
	if ( $f eq "*" )
	{
	    push @pkgs, (split(' ', $r));
	    next;
	}

	#
	#  If the line starts with $ then it is a host group.
	#
	if ( $f =~ /^\$(.*)/ )
	{
	    my $group = $1;

	    #
	    #  Test for group membership
	    #
	    if ( isMachineInGroup( $group ) )
	    {
		push @pkgs, (split(' ', $r));
	    }
	}
	#
	# Otherwise add the package(s) to the list if they are
	# for *this* host.
	#
	next if( !$CONFIG{'hostname'} or ($f ne $CONFIG{'hostname'}));
	push @pkgs, (split(' ', $r));
    }
    close(CONFIG);

    #
    #  Now we have an array for the machine, and we need to tell
    # if those packages are to be added or removed.
    #
    my @add    = ();
    my @remove = ();
    my @verchk = ();

    foreach my $p ( @pkgs )
    {
	if ( $p =~ /^-(.*)/ )
	{
	    #
	    #  Leading '-' means to remova
	    #
	    push @remove, $1;
	}
	elsif ( $p =~ /=/ )
	{
	    #
	    # '=' implies version check.
	    #
	    push @verchk, $p;
	}
	else
	{
	    #
	    # Otherwise it must be a package to add.
	    #
	    push @add, $p;
	}
    }

    #
    # Return the arrays as references.
    #
    return( \@add, \@remove, \@verchk );
}





=head2 runCommand

  Run an external command, with a sane timeout period.

  If the command files then we'll abort and exit the script.

=cut

sub runCommand
{
    my ( $command ) = ( @_ );

    my $error = eval {

        #
        #  Setup a timeout
        #
	local $SIG{ALRM} = sub { die "$command timed out after $CONFIG{'timeout'} secs"; };

        #
        #  Prepare the timout.
        #
	alarm($CONFIG{'timeout'});

        #
        #  Run the command
        #
	print "Running: $command\n" if $CONFIG{'verbose'};
	my $retval = system($command);

        #
        #  Cancel the timout
        #
	alarm(0);

        #
        #  Show an error unless we're ignore it.
        #
	if ($retval)
        {
	    die "$command failed: $retval";
	}

        #
        #  We worked
        #
	return 0;
    };

    #
    #  Failure of eval?
    #
    if ( $@ )
    {
	die "Error: $@";
    }
}




=head2 installPackages

  Take the array of package names we're given and install them.

=cut

sub installPackages
{
    my ( @pkgs ) = ( @_ );

    #
    #  Remove duplications
    #
    my %saw;
    @pkgs = grep(!$saw{$_}++, @pkgs);

    #
    #  Install any packages which require installation.
    #
    my $apt_install = qq(/usr/bin/apt-get -y -q -q install -o "DPkg::Options::=--force-confold");
    my $command = join(" ", $apt_install, @pkgs);
    runCommand( $command );
}





=head2 removePackages

  Remove a list of packages from the current host.

=cut

sub removePackages
{
    my ( @pkgs ) = ( @_ );

    #
    #  Remove duplications
    #
    my %saw;
    @pkgs = grep(!$saw{$_}++, @pkgs);


    #
    #  Remove any packages which require removal.
    #
    my $command = join(" ", "dpkg --purge", @pkgs, "2>/dev/null");
    runCommand( $command );
}





=head2 versionCheckPackages

  Check the version of the given package.  If it is installed, and the
 version doesn't match what we have then upgrade.

=cut

sub versionCheckPackages
{
    my ( @pkgs ) = ( @_ );

    #
    #  Remove duplications
    #
    my %saw;
    @pkgs = grep(!$saw{$_}++, @pkgs);

    #
    #  For each package specified
    #
    foreach my $p ( @pkgs )
    {
	#
	#  Split up into the package name + version number.
	#
	if ( $p =~ /(.*)=(.*)/ )
	{
	    my $package = $1;
	    my $version = $2;

            #
            #  Test to see if the package is installed.
            #
            my $inst_check = `dpkg --list $package 2>/dev/null| grep ^ii | wc -l`;
            chomp( $inst_check );
            next if (! $inst_check );


	    #
	    # Get the version of the package, now that we're sure it 
            # is installed.
	    #
	    my $installed = `dpkg-query -W --showformat='\${Version}' $package 2>/dev/null`;
	    chomp( $installed );

	    #
	    #  If that worked.
	    #
	    if ( length( $installed ) )
	    {
		#
		# And the version doesn't match what we expect.
		#
		if ( $installed ne $version )
		{
		    #
		    # Upgrade the package, since the version isn't
		    # what we require.
		    #
		    my $apt_install = qq(/usr/bin/apt-get -y -q -q install -o "DPkg::Options::=--force-confold");
		    my $command = $apt_install . " " . $package . " 2>/dev/null";
		    runCommand( $command );
		}
		else
		{
		    print "Package $package already version $version - skipping\n" if $CONFIG{'verbose'};
		}
	    }
	    else
	    {
		print "Couldn't find version for '$package' - skipping\n" if $CONFIG{'verbose'};
	    }
	}
    }
}





=head2 getHostname

  Return the local hostname, minus any domain name which might
 be present.

=cut

sub getHostname
{
    my $host = hostname();
    if (!$host)
    {
	print "ERROR: can't get hostname.\n";
	exit 0;
    }

    # strip trailing newline.
    chomp($host);

    # strip any domain name which might be present.
    if ( $host =~ m/(\w+)/)
    {
	$host = $1;
	print "# Using hostname: $host\n" if $CONFIG{'verbose'};
    }

    return( $host );
}



=head2 isMachineInGroup

  Test to see whether the current machine is in a given CFEngine group.

  We do this by parsing the /etc/cfengine/cfagent.conf file, which is 
 assumed to be present.

=cut

sub isMachineInGroup
{
    my ( $group ) = ( @_ );

    #
    #  Show what we're doing
    #
    $CONFIG{'verbose'} && print "Testing to see if machine $CONFIG{'hostname'} is in group '$group'\n";

    #
    #  Split each of the classes up, and test for membership.
    #
    foreach my $g ( split( /:/, $CONFIG{'classes'} ) )
    {
        if ( lc($group) eq lc( $g ) )
        {
            $CONFIG{'verbose'} && print "It is\n";
            return 1;
        }
    }

    $CONFIG{'verbose'} && print "Machine not in group\n";
    return 0;
}



=head2 logClasses

  Log any classes we were called with.

=cut

sub logClasses
{
    open( LOGFILE, ">/tmp/skx.log" ) or return;
    foreach my $group ( split( /:/, $CONFIG{'classes'} ) )
    {
        print LOGFILE $group . "\n";
    }
    close( LOGFILE );
}



=head2 processFile

  Read in the given configuration file and use it.

=cut

sub processFile
{
    my( $file ) = ( @_ );

    if ( ! -e $file )
    {
        $CONFIG{'verbose'} && print "File not found: $file\n";
        return;
    }


    #
    # Read the list of packages to be added/removed/tested upon this host.
    #
    my ($additions,$removals,$versions)  = readPackages( $file );

    #
    #  Convert from references to arrays.
    #
    my @add      = @$additions;
    my @remove   = @$removals;
    my @vercheck = @$versions;

    #
    # Make sure that at least one of those lines has contents.
    #
    if ( (! (@add))    &&
         (! (@remove)) &&
         (! (@vercheck))
       )
    {
        print "No packages to install/remove/version check for $CONFIG{'hostname'} or *.\n";
        return;
    }


    #
    #  Show diagnostics
    #
    if ( $CONFIG{'verbose'} )
    {
        print "Adding  : ", scalar(@add), " Pkgs: ", join(',', @add), "\n";
        print "Removing: ", scalar(@remove), " Pkgs: ", join(',', @remove), "\n";
        print "Vercheck: ", scalar(@vercheck), " Pkgs: ", join(',', @vercheck), "\n";
    }

    #
    #  Install packages, if any were scheduled for installation.
    #
    installPackages( @add ) if ( scalar(@add));

    #
    #  Remove the packages scheduled for removal.
    #
    removePackages( @remove ) if ( scalar(@remove));

    #
    #  Version check packages if any were specified.
    #
    versionCheckPackages( @vercheck ) if ( scalar(@vercheck) );

}