#!/usr/bin/perl -w

# Copyright (c) 2005-2007  Peter Pentchev
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

=head1 NAME

sysgather - a configuration file mismanager

$Ringlet: sysgather.pl 1027 2007-02-27 09:47:40Z roam $

=head1 SYNOPSIS

  sysgather [-hnqvV] [-f file] command [package...]

=head1 DESCRIPTION

The B<sysgather> utility stores various collections of configuration files,
both for the system and for applications, in order to facilitate keeping
them under version control.

The configuration files are organized into collections, or packages.
Each package is defined by a section in the B<sysgather.conf> file.
An example of a package could be the base system configuration files
(most of the contents of the /etc directory), the Apache webserver
configuration files (httpd.conf, access.conf, mime.types, etc.), or
a user's dotfiles.

If the special value C<ALL> is specified as the only package name,
B<sysgather> operates on B<all> the groups defined on the C<groups>
line in the C<default> section of its configuration file.

The B<sysgather> utility processes two configuration files: a system-wide
one, located in F</usr/local/etc/sysgather.conf>, and a per-user file
containing additional definitions and overrides, located in each user's
home directory and named F<.sysgather.conf>.  If the per-user file exists,
any collections defined within it replace the corresponding collections
from the system-wide file, and any variables in the C<default> section
will also replace the corresponding variables from the system-wide file.

=head1 OPTIONS

=over 4

=item B<-f> I<file>

Specify the configuration file to use instead of the default
B</usr/local/etc/sysgather.conf>.

B<Note:> If this option is present, the F<~/.sysgather.conf> file
is B<not> processed after the specified configuration file.

=item B<-h>

Display usage information and exit.

=item B<-n>

For the B<diff>, B<get>, and B<put> commands, do not actually copy
any files or execute any system commands, but simply report what would
have been done.

=item B<-q>

Quiet operation - suppress informational and warning messages, only
complain about genuine error conditions.

=item B<-V>

Display the program version and exit.

=item B<-v>

Verbose operation - display progress messages during the program's work.

=back

=cut

use strict;

use Config::IniFiles;
use File::Basename qw/dirname/;
use File::Copy;
use Getopt::Std;

sub usage($);
sub version();
sub all_die($);
sub mkdir_p($);

sub cmd_diff($ @);
sub cmd_diff_source($ @);
sub cmd_get($ @);
sub cmd_put($ @);
sub cmd_source($ @);
sub cmd_usage($ @);
sub cmd_version($ @);

my ($quiet, $verbose) = (0, 0);

my %conf = (
	'conffile'	=> '/usr/local/etc/sysgather.conf',
	'conflocal'	=> $ENV{'HOME'}.'/.sysgather.conf',
	'confvars'	=> [ qw/diffcmd diffopts/ ],
	'diffcmd'	=> 'diff',
	'diffopts'	=> [ '-u', '-N' ],
	'installcmd'	=> 'install',
	'instopt_copy'	=> '-c',
	'instopt_owner'	=> '-o',
	'instopt_group'	=> '-g',
	'instopt_mode'	=> '-m',
	'collvars'	=> [ qw/basedir confdir srcdir files/ ],
	'noaction'	=> 0,
	'_process_all'	=> 0,
	'_process_home'	=> 1,
);

my %cmds = (
	'diff'		=> \&cmd_diff,
	'diffsource'	=> \&cmd_diff_source,
	'diffsrc'	=> \&cmd_diff_source,
	'get'		=> \&cmd_get,
	'help'		=> \&cmd_usage,
	'source'	=> \&cmd_source,
	'src'		=> \&cmd_source,
	'put'		=> \&cmd_put,
	'usage'		=> \&cmd_usage,
	'version'	=> \&cmd_version,
);

my %groups = ();

# The main program - parse command-line options and execute a command
MAIN:
{
	my (%opts, $cmd, @found);
	
	getopts('f:hnqvV', \%opts);
	# Trivial options
	usage(0) if $opts{'h'};
	version() if $opts{'V'};
	$quiet = 1 if $opts{'q'};
	$verbose = 1 if $opts{'v'};
	# And now for the real ones
	if ($opts{'f'}) {
		$conf{'conffile'} = $opts{'f'};
		$conf{'_process_home'} = 0;
	}
	$conf{'noaction'} = 1 if $opts{'n'};

	# Find and execute a command
	usage(1) unless (@ARGV);
	$cmd = shift @ARGV;
	if (exists($cmds{$cmd})) {
		@found = ($cmd);
	} else {
		@found = grep { /^\Q$cmd\E/ } sort keys %cmds;
		usage(1) unless @found == 1;
	}
	&{$cmds{$found[0]}}($found[0], @ARGV);
}

sub usage($)
{
	my ($err) = @_;
	my $s = "Usage: sysgather [-hnqvV] [-f file] command [package...]\n".
	    "\t-f file\tspecify the config file name;\n".
	    "\t-h\tdisplay usage information and exit;\n".
	    "\t-n\ttest mode, only display what would have been done;\n".
	    "\t-q\tquiet operation, only display genuine error messages;\n".
	    "\t-v\tverbose operation;\n".
	    "\t-V\tdisplay version information and exit.\n";

	if ($err) {
		print STDERR $s;
	} else {
		print $s;
	}
	exit($err);
}

sub version()
{
	print "sysgather version 1.0pre9\n";
	exit(0);
}

=head1 COMMANDS

The B<sysgather> utility recognizes the following commands:

=over 4

=item * B<diff>

Show the differences between the stored and current config files.

=cut

sub cmd_diff($ @)
{
	my ($cmd, @args) = @_;
	my ($pkg, $g, $f, $src, $dest);

	usage(1) unless (@args);
	readconf(\@args);
	# Sanity check
	foreach (@args) {
		die "Unknown package $_\n" if !defined($groups{$_});
	}

	# Ooookay, let's roll!
	foreach $pkg (@args) {
		print "Processing package $pkg...\n" if $verbose;
		$g = $groups{$pkg};
		if (! -d $g->{'confdir'}) {
			die "No config directory $g->{confdir} for $pkg\n";
		}
		if (! -d $g->{'basedir'}) {
			die "No base directory $g->{basedir} for $pkg\n";
		}

		foreach $f (split /\s+/, $g->{'files'}) {
			($src, $dest) = ($g->{'basedir'}.'/'.$f,
			    $g->{'confdir'}.'/'.$f);
			if (! -f $src) {
				print "No source file $src\n" if -f $dest;
				next;
			}
			if (! -f $dest && -f $src) {
				print "No destination file $dest\n";
				next;
			}
			my @sysargs = ($conf{'diffcmd'}, @{$conf{'diffopts'}},
			    $dest, $src);
			if ($conf{'noaction'}) {
				print join ' ', @sysargs, "\n";
				next;
			}
			system @sysargs;
		}
	}
}

=item * B<diffsource> (or B<diffsrc>)

Show the differences between the stored and current original (vendor)
versions of the config files.

=cut

sub cmd_diff_source($ @)
{
	my ($cmd, @args) = @_;
	my ($pkg, $g, $f, $src, $dest);

	usage(1) unless (@args);
	readconf(\@args);
	# Sanity check
	foreach (@args) {
		die "Unknown package $_\n" if !defined($groups{$_});
	}

	# Ooookay, let's roll!
	foreach $pkg (@args) {
		print "Processing package $pkg...\n" if $verbose;
		$g = $groups{$pkg};
		if ($g->{'srcdir'} eq 'NONE') {
			all_die "No source directory defined for $pkg\n"
			    unless $quiet;
			next;
		} elsif (! -d $g->{'srcdir'}) {
			die "No source directory $g->{srcdir} for $pkg\n";
		}
		if (! -d $g->{'confdir'}) {
			die "No config directory $g->{confdir} for $pkg\n";
		}

		foreach $f (split /\s+/, $g->{'files'}) {
			next unless exists $g->{$f};
			($src, $dest) = ($g->{'srcdir'}.'/'.$g->{$f},
			    $g->{'confdir'}.'/'.$f);
			if (! -f $src) {
				print "No source file $src\n" if -f $dest;
				next;
			}
			if (! -f $dest && -f $src) {
				print "No destination file $dest\n";
				next;
			}
			my @sysargs = ($conf{'diffcmd'}, @{$conf{'diffopts'}},
			    $dest, $src);
			if ($conf{'noaction'}) {
				print join ' ', @sysargs, "\n";
				next;
			}
			system @sysargs;
		}
	}
}

=item * B<get>

Fetch the current versions of the config files.

=cut

sub cmd_get($ @)
{
	my ($cmd, @args) = @_;
	my ($pkg, $g, $f, $src, $dest, $dir);

	usage(1) unless (@args);
	readconf(\@args);
	# Sanity check
	foreach (@args) {
		die "Unknown package $_\n" if !defined($groups{$_});
	}

	# Ooookay, let's roll!
	$dir = '.';
	foreach $pkg (@args) {
		print "Processing package $pkg...\n" if $verbose;
		$g = $groups{$pkg};
		mkdir_p $g->{'confdir'} or
		    die "Could not create $g->{confdir}: $!\n";
		if (! -d $g->{'basedir'}) {
			die "No base directory $g->{basedir} for $pkg\n";
		}

		foreach $f (split /\s+/, $g->{'files'}) {
			($src, $dest) = ($g->{'basedir'}.'/'.$f,
			    $g->{'confdir'}.'/'.$f);
			if (! -f $src) {
				warn "Skipping nonexistent $f ($src)\n"
				    unless $quiet;
				next;
			}
			if ($dir ne dirname $dest) {
				$dir = dirname $dest;
				print "New destination directory $dir\n"
				    if $verbose;
				mkdir_p $dir or
				    die "Could not create $dir: $!\n";
			}
			if ($conf{'noaction'}) {
				print "$src -> $dest\n";
				next;
			}
			print "$src -> $dest\n" if $verbose;
			copy($src, $dest) or
			    die "Copying $f ($src) to $dest: $!\n";
		}
	}
}

=item * B<help>

Display usage instructions and exit.

=cut

sub cmd_usage($ @)
{
	usage(0);
}

=item * B<put>

Install the working copies of the config files to their real locations.

=cut

sub cmd_put($ @)
{
	my ($cmd, @args) = @_;
	my ($pkg, $g, $f, $src, $dest, $res);
	my (@stat, @cmd);

	usage(1) unless (@args);
	readconf(\@args);
	# Sanity check
	foreach (@args) {
		die "Unknown package $_\n" if !defined($groups{$_});
	}

	# Ooookay, let's roll!
	foreach $pkg (@args) {
		print "Processing package $pkg...\n" if $verbose;
		$g = $groups{$pkg};
		if (! -d $g->{'confdir'}) {
			die "No config directory $g->{confdir} for $pkg\n";
		}
		if (! -d $g->{'basedir'}) {
			die "No base directory $g->{basedir} for $pkg\n";
		}

		foreach $f (split /\s+/, $g->{'files'}) {
			($src, $dest) = ($g->{'confdir'}.'/'.$f,
			    $g->{'basedir'}.'/'.$f);
			if (! -f $src) {
				warn "Skipping nonexistent $f ($src)\n"
				    unless $quiet;
				next;
			}
			if (! -f $dest) {
				warn "Skipping nonexistent $f ($dest)\n"
				    unless $quiet;
				next;
			}
			@stat = stat($dest);
			@cmd = ($conf{'installcmd'});
			if ($conf{'instopt_copy'}) {
				push @cmd, $conf{'instopt_copy'};
			}
			if ($conf{'instopt_owner'}) {
				push @cmd, $conf{'instopt_owner'}, $stat[4];
			}
			if ($conf{'instopt_group'}) {
				push @cmd, $conf{'instopt_group'}, $stat[5];
			}
			if ($conf{'instopt_mode'}) {
				push @cmd, $conf{'instopt_mode'},
				    sprintf '%lo', $stat[2] & 07777;
			}
			push @cmd, $src, $dest;
			if ($conf{'noaction'}) {
				print "'".join("' '", @cmd)."'\n";
				next;
			}
			print "$src -> $dest\n" if $verbose;
			$res = system @cmd;
			if ($res != 0) {
				warn "Could not install $f ($src)\n";
				next;
			}
		}
	}
}

=item * B<source> (or B<src>)

Fetch the original (vendor) versions of the config files.

=cut

sub cmd_source($ @)
{
	my ($cmd, @args) = @_;
	my ($pkg, $g, $f, $src, $dest, $dir);

	usage(1) unless (@args);
	readconf(\@args);
	# Sanity check
	foreach (@args) {
		die "Unknown package $_\n" if !defined($groups{$_});
	}

	# Ooookay, let's roll!
	$dir = '.';
	foreach $pkg (@args) {
		print "Processing package $pkg...\n" if $verbose;
		$g = $groups{$pkg};
		if ($g->{'srcdir'} eq 'NONE') {
			all_die "No source directory defined for $pkg\n"
			    unless $quiet;
			next;
		} elsif (! -d $g->{'srcdir'}) {
			die "No source directory $g->{srcdir} for $pkg\n";
		}
		mkdir_p $g->{'confdir'} or
		    die "Could not create $g->{confdir}: $!\n";

		foreach $f (split /\s+/, $g->{'files'}) {
			next unless exists $g->{$f};
			($src, $dest) = ($g->{'srcdir'}.'/'.$g->{$f},
			    $g->{'confdir'}.'/'.$f);
			if ($dir ne dirname $dest) {
				$dir = dirname $dest;
				print "New destination directory $dir\n"
				    if $verbose;
				mkdir_p $dir or
				    die "Could not create $dir: $!\n";
			}
			if ($conf{'noaction'}) {
				print "$src -> $dest\n";
				next;
			}
			print "$src -> $dest\n" if $verbose;
			copy($src, $dest) or
			    die "Copying $g->{$f} ($src) to $f ($dest): $!\n";
		}
	}
}

=item * B<version>

Display the program version and exit.

=cut

sub cmd_version($ @)
{
	version();
}

=back

=cut

# Various utility functions

# Read the configuration file and parse it into package collections

sub readconf(\@)
{
	my ($argref) = @_;
	my ($fname, $grp, $g, %c, %cfg) = ($conf{'conffile'});

	print "Parsing the configuration file...\n" if $verbose;
	if (!tie %c, 'Config::IniFiles',
	    (-file => $fname, -allowcontinue => 1)) {
		my $err = join "\n", "Could not read $fname",
		    @Config::IniFiles::errors;
		die "$err\n";
	}
	$cfg{$_} = $c{$_} for keys %c;
	untie %c;

	if ($conf{'_process_home'} && defined($conf{'conflocal'}) &&
	    -e $conf{'conflocal'} && tie %c, 'Config::IniFiles',
	    (-file => $conf{'conflocal'}, -allowcontinue => 1)) {
		$cfg{$_} = $c{$_} for grep { $_ ne 'default' } keys %c;
		if (exists($c{'default'})) {
			if (exists($cfg{'default'})) {
				$cfg{'default'}{$_} = $c{'default'}{$_} for
				    keys %{$c{'default'}};
			} else {
				$cfg{'default'} = $c{'default'};
			}
		}
	}

	if (!exists($cfg{'default'})) {
		die "The $fname file does not contain a 'default' section!\n";
	}
	if (!defined($cfg{'default'}{'groups'})) {
		die "No groups specified in the default section of $fname\n";
	}
	foreach (@{$conf{'confvars'}}) {
		my $val = $cfg{'default'}{$_};
		next unless defined $val;
		if (ref $conf{$_} eq '') {
			$conf{$_} = $val;
		} elsif (ref $conf{$_} eq 'ARRAY') {
			$conf{$_} = [ split /\s+/, $val ];
		} else {
			die "Internal error: attempting to replace a ".
			    ref($conf{$_})." config variable '$_'\n";
		}
	}
	foreach $grp (split /\s+/, $cfg{'default'}{'groups'}) {
		print "Parsing group $grp...\n" if $verbose;
		if (!exists($cfg{$grp})) {
			die "No $grp group in $fname\n";
		}
		$g = $cfg{$grp};
		foreach (@{$conf{'collvars'}}) {
			die "No $_ entry in group $grp\n" if !defined($g->{$_});
		}
		$groups{$grp} = $g;
	}
	print "Parsed ".scalar(keys %groups)." groups\n" if $verbose;
	if (defined($argref) && @{$argref} == 1 && ${$argref}[0] eq 'ALL') {
		print "Using all groups\n" if $verbose;
		@{$argref} = sort keys %groups;
		$conf{'_process_all'} = 1;
	}
}

# Die if processing specific packages; just warn if processing "ALL".

sub all_die($)
{
	my ($msg) = @_;

	if ($conf{'_process_all'}) {
		warn $msg;
	} else {
		die $msg;
	}
}

# Create a directory and its parent directories as necessary

sub mkdir_p($)
{
	my ($path) = @_;
	my (@comp);

	while ($path && $path ne dirname $path) {
		unshift @comp, $path;
		$path = dirname $path;
	}
	foreach (@comp) {
		next if -d;
		if ($conf{'noaction'}) {
			print "mkdir $_\n";
			next;
		}
		mkdir $_, 0777 or die "Could not create $_ for $path: $!\n";
	}
	return 1;
}

=head1 CONFIGURATION FILE SYNTAX

The configuration file for the B<sysgather> utility usually goes by the name
of B<sysgather.conf>.  It is separated into several sections, of which only
one is mandatory - the I<default> section.

=head2 THE I<default> SECTION

Currently, the I<default> section only contains one setting: the I<groups>
variable, a list of file collections for B<sysgather> to process.  For each
name in this list, B<sysgather> looks for a configuration file section by
the same name, and treats it as a file collection section.

=head2 FILE COLLECTION SECTIONS

A file collection is, simply put, a list of files to keep under version
control together.  Each collection is represented by a INI-style group - the
name of the group serves as the name of the collection.  There are two kinds
of variables within the group - collection properties and source file
specifications.

There are two modes of B<sysgather> operation - source files and actual
files.  The files listed in the C<files> property are the actual files
that will be kept track of.  For some of them, a source file may be
specified - an "original", vendor version.  This may be useful for
keeping track of local changes and merging the vendor modifications
across upgrades.

For each collection, the following configuration directives may be
specified:

=over 4

=item * basedir

The directory where the files from this collection will be stored by
sysgather.

=item * confdir

The directory where the actual files from this collection are to be
found on the system.

=item * srcdir

The directory where the source (vendor) copies of the files are to
be found on the system.

If a package does not provide default versions of any files, the
C<srcdir> property may be specified as C<NONE> and B<sysgather> will
refuse to execute the C<source> and C<diffsource> commands on this
collection.

=item * files

The actual files comprising this collection.  Those may be specified as
simple filenames within C<confdir>, paths relative to C<confdir>, or
absolute paths.

=back

For each of the actual files listed in the C<files> directive, a source
file may be specified.  This is done by defining a C<property> with
the same name as the actual file, the value of which is the name of
the source file relative to C<srcdir>.

For an example, please consult the various configuration files in
the F</usr/local/share/examples/sysgather/> directory, as well as
the sample F<sysgather.conf> file provided with the B<sysgather>
distribution.

=head1 FILES

=over 4

=item F</usr/local/etc/sysgather.conf>

The default configuration file, unless overridden by the B<-f> command-line
option.

=item F<~/.sysgather.conf>

The per-user configuration file, located in the home directory of the
account invoking B<sysgather>.  The contents of this file is merged with
the contents of the system-wide file as described above.

=item F</usr/local/share/examples/sysgather/*.conf>

Sample configuration files.

=back

=head1 EXAMPLES

Grab the base system's default configuration files for an import into
a version control system:

  sysgather source sys-fbsd5

Fetch the currently-used versions of the system files and the Apache
webserver configuration for a check-in into the version control system:

  sysgather get sys-fbsd5 apache

Display the differences between the stored files and the currently active
Apache configuration:

  sysgather diff apache

Put the stored configuration files (presumably after a version control
check-in) as the active configuration for the Apache webserver:

  sysgather put apache

=head1 BUGS

=over 4

=item *

There is no B<-O> I<option=value> command-line option.

=item *

This documentation is much too sketchy.

=item *

There is no test suite.

=back

=head1 HISTORY

The B<sysgather> utility was written by Peter Pentchev in 2005.

=head1 AUTHOR

Peter Pentchev E<lt>roam@ringlet.netE<gt>