#!/usr/bin/perl

#- Mandrake Distribution Checking.
#- Copyright (C) 1999 MandrakeSoft (fpons@mandrakesoft.com)
#-
#- This program is free software; you can redistribute it and/or modify
#- it under the terms of the GNU General Public License as published by
#- the Free Software Foundation; either version 2, or (at your option)
#- any later version.
#-
#- This program is distributed in the hope that it will be useful,
#- but WITHOUT ANY WARRANTY; without even the implied warranty of
#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#- GNU General Public License for more details.
#-
#- You should have received a copy of the GNU General Public License
#- along with this program; if not, write to the Free Software
#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

#- check a whole distribution RPMS, SRPMS, compss and contribs associated :
#-   rpms dependancy check (including provides), script usage.
#-   srpms checking with version.
#-   contrib rpms dependancy check with rpms, script usage.
#-   contrib srpms checkig with version.
#-   compss checking, doublons, packages extension and size.

#- options are :
#-   --rpms            : RPMS directory
#-   --srpms           : SRPMS directory
#-   --contrib-rpms    : contrib RPMS directory
#-   --contrib-srpms   : contrib SRPMS directory
#-   --compss          : compss file
use strict qw(subs vars refs);

#- base RPM tags to take into account.
my @rpmtags = qw(NAME VERSION RELEASE BUILDTIME SIZE COPYRIGHT ARCH);
my $formats; $formats .= $_ . '=%{' . $_ . '}\\n' foreach @rpmtags;

#- passtest arrays (contains function for test).
my @passtest = (
		\&pass_get_rpms,
		\&pass_check_compss,
		\&pass_check_categories_in_compss,
		\&pass_check_packages_in_compss,
		\&pass_check_filenames,
		\&pass_check_provides,
		\&pass_check_requires,
	       );

#- get basename for a file.
sub basename { $_[0] =~ /([^\/]*)$/ ? $1 : $_[0]; }

#- compare a version string.
sub version_compare {
    my ($a, $b) = @_;
    local $_;

    while ($a && $b) {
	my ($sb, $sa) =  map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a);
	$_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_;
    }
}

#- read information about a RPMS file.
sub read_rpms_info {
    my ($file) = @_;
    
    -f $file or die "cannot read $file";
    local *F;
    open F, "rpm -qp --queryformat \"$formats\" $file |" or die "cannot examine $file: $!";
    { FILE => $file, map { /^(\w*)=(.*)$/ } <F> }
}

#- check that NAME, VERSION, RELEASE, ARCH are coherent with package filename.
sub check_rpms_info_from_filename {
    my ($p) = @_;
    my $s;
    
    if ($p->{FILE} =~ /([^\/]*?)-([^-]*)-([^-]*)\.([^-]*)\.rpm$/) {
	do { $s .= ", " if $s;
	     $s .= "name($p->{NAME} and $1)" } if $p->{NAME} ne $1;
	do { $s .= ", " if $s;
	     $s .= "version($p->{VERSION} and $2)" } if $p->{VERSION} ne $2;
	do { $s .= ", " if $s;
	     $s .= "release($p->{RELEASE} and $3)" } if $p->{RELEASE} ne $3;
	do { $s .= ", " if $s;
	     $s .= "arch($p->{ARCH} and $4)" } if $p->{ARCH} ne $4;
	$s = "mismatch of $s on " . basename($p->{FILE}) if $s;
    } else {
	$s = "unable to parse filename " . basename($p->{FILE});
    }
    $s;
}

#- pass function for getting all RPMS and simple checking.
sub pass_get_rpms {
    my ($o) = @_;
    
    $o->{c}->("read RPMS directory $o->{rpms}, simple package checking.");
    -d $o->{rpms} or die "cannot read directory $o->{rpms}";
    
    local *D;
    opendir D, $o->{rpms};
    map {
	my $p = read_rpms_info("$o->{rpms}/$_");
	if ($p) {
	    if (exists $o->{PACKAGES}{$p->{NAME}}) {
		$o->{cerr}->("package $p->{NAME} from " . basename($p->{FILE}) . " already defined in " . basename($o->{PACKAGES}{$p->{NAME}}{FILE}));
	    } else {
		$o->{PACKAGES}{$p->{NAME}} = $p;
		local $_ = check_rpms_info_from_filename($p);
		$_ ? $o->{cwarn}->($_) : $o->{cok}->();
	    }
	} else {
	    $o->{cerr}->("package from file $_ is unreadable");
	}
    } grep { /\.rpm$/ } readdir D;
}

#- pass function for checking consistency of compss file
sub pass_check_compss {
    my ($o) = @_;

    $o->{c}->("read compss file, check consistency.");
    return unless $o->{compss};
    -r $o->{compss} or die "cannot read compss file $o->{compss}";

    my ($cat);
    local *F;
    open F, $o->{compss};
    while (<F>) {
	chomp;
	if (/^([^\s]+)/) {
	    if ($o->{COMPSS}{$1}) {
		$o->{cerr}->("multiple definition of category $1 at line $. in compss");
	    } else {
		$o->{COMPSS}{$1} = {};
		$cat = $1;
		$o->{cok}->();
	    }
	} elsif (/\s+([^\s]+)/ && defined $cat) {
	    if ($o->{PACKAGES}{$1}) {
		$o->{PACKAGES}{$1}{COMPSS} ||= [];
		if (exists $o->{COMPSS}{$cat}{$1}) {
		    $o->{cerr}->("multiple definition of package $1 in category $cat at line $. in compss");
		} else {
		    $o->{COMPSS}{$cat}{$1} = undef;
		    push @{$o->{PACKAGES}{$1}{COMPSS}}, $o->{COMPSS}{$cat};
		    $o->{cok}->();
		}
	    } else {
		$o->{cwarn}->("undefined package $1 at line $. in compss");
	    }
	} elsif (/^\s*$/) {
	    $cat = undef;
	    $o->{cok}->();
	} else {
	    $o->{cerr}->("error at line $. in compss");
	}
    }
}

#- search for categories in compss.
sub pass_check_categories_in_compss {
    my ($o) = @_;

    $o->{c}->("check for empty categories in compss file.");
    return unless $o->{COMPSS};

    foreach (keys %{$o->{COMPSS}}) {
	if ($o->{COMPSS}{$_}) {
	    $o->{cok}->();
	} else {
	    $o->{cwarn}->("category $_ is empty in compss");
	}
    }
}

#- search for package which have not been described in compss.
sub pass_check_packages_in_compss {
    my ($o) = @_;

    $o->{c}->("check all defined packages are referenced in compss file.");
    return unless $o->{COMPSS};
    
    foreach (values %{$o->{PACKAGES}}) {
	if ($_->{COMPSS}) {
	    $o->{cok}->();
	} else {
	    $o->{cwarn}->("package $_->{NAME} is not in compss");
	}
    }
}

#- pass function for filenames checking, avoiding doublons of different files.
sub pass_check_filenames {
    my ($o) = @_;
    
    $o->{c}->("check files of all RPMS, avoid multiple different definition of files.");
    
    foreach (values %{$o->{PACKAGES}}) {
	my $p = $_;
	my %files;
	
	local *F;
	open F, "rpm -qpl --dump $p->{FILE} |" or die "cannot examine $p->{FILE}";
	while (<F>) {
	    chomp;
	    my @d = split(/ /, $_);
	    my $k = join(' ', @d[3,4,5,6,10]);
	    if (exists $o->{FILENAMES}{$d[0]} && $o->{FILENAMES}{$d[0]}[1] ne $k) {
		my $filenames = $files{basename($o->{FILENAMES}{$d[0]}[0]{FILE})} ||= [];
		push @{$filenames}, $d[0];
	    } else {
		$o->{FILENAMES}{$d[0]} = [$p, $k] unless exists $o->{FILENAMES}{$d[0]};
	    }
	}
	
	#- print summary informations on conflicts.
	if (%files) {
	    my $s = "conflict between " . basename($p->{FILE} . " ...");
	    foreach (keys %files) {
		my @filenames = @{$files{$_}};
		$s .= "\n        ... and $_ on ". scalar @filenames ." file(s)";
		if (scalar @filenames < 10) {
		    $s .= ":";
		    foreach (@filenames) {
			$s .= "\n          $_";
		    }
		} else {
		    $s .= ".";
		}
	    }
	    $o->{cerr}->($s);
	} else {
	    $o->{cok}->();
	}
    }
}

#- pass function for provides checking.
sub pass_check_provides {
    my ($o) = @_;
    
    $o->{c}->("check provides of all RPMS, check multiple provides.");
    
    foreach (values %{$o->{PACKAGES}}) {
	my $p = $_;
	my %files;

	local *F;
	open F, "rpm -qp --provides $p->{FILE} |" or die "cannot examine $p->{FILE}";
	while (<F>) {
	    chomp;
	    s/^(.*?)\s*$/$1/;
	    if (exists $o->{PROVIDES}{$_}) {
		unless ($o->{MULTIPLE_PROVIDES}{$_}) {
		    $o->{MULTIPLE_PROVIDES}{$_} = 1;
		    $o->{PROVIDES}{$_} = [ $o->{PROVIDES}{$_} ];
		}
		$o->{MULTIPLE_PROVIDES}{$_}++;
		push @{$o->{PROVIDES}{$_}}, $p;
	    } else {
		$o->{PROVIDES}{$_} = $p;
	    }
	}
    }

    foreach (keys %{$o->{PROVIDES}}) {
	if ($o->{MULTIPLE_PROVIDES}{$_}) {
	    my $s = "$_ is provided $o->{MULTIPLE_PROVIDES}{$_} times by :";
	    $s .= "\n          ". basename($_->{FILE}) foreach @{$o->{PROVIDES}{$_}};
	    $o->{cwarn}->($s);
	} else {
	    $o->{cok}->();
	}
    }
}

#- pass function for requires checking.
sub pass_check_requires {
    my ($o) = @_;
    
    $o->{c}->("check requires of all RPMS, check dependancies.");
    
    foreach (values %{$o->{PACKAGES}}) {
	my $p = $_;
	my %files;

	local *F;
	open F, "rpm -qp --requires $p->{FILE} |" or die "cannot examine $p->{FILE}";
	while (<F>) {
	    chomp;
	    s/\s*$//;
	    if (/^(.*?) (>|>=|=|<=|<) ([^-]*)(?:-(.*))?/) {
		#- this is a require with a package name and version.
		my ($name, $op, $version, $release) = ($1, $2, $3, $4);
		$op = '==' if $op eq '=';

		if ($o->{PACKAGES}{$name}) {
		    my ($ins_version, $ins_release) = ($o->{PACKAGES}{$name}{VERSION}, $o->{PACKAGES}{$name}{RELEASE});
		    my $cmp_version = eval "version_compare(\"$ins_version\", \"$version\")" || 0;

		    if (($release && $cmp_version == 0 && eval "version_compare(\"$ins_release\", \"$release\") $op 0") ||
			eval "$cmp_version $op 0") {
			$o->{cok}->();
		    } else {
			$o->{cerr}->(basename($p->{FILE}) ." requires package $name with version $op $version".
				     ($release && "-$release") .", only have ". $ins_version . ($release && "-$ins_release"));
		    }
		} else {
		    $o->{cerr}->(basename($p->{FILE}) ." requires package $name which is not available.");
		}
	    } else {
		#- this is a require of a provide, package name or filename.
		if ($o->{PROVIDES}{$_}) {
		    if ($o->{MULTIPLE_PROVIDES}{$_}) {
			$o->{cwarn}->(basename($p->{FILE}) ." requires multiple provides $_");
		    } else {
			$o->{cok}->();
		    }
		} elsif ($o->{PACKAGES}{$_} || $o->{FILENAMES}{$_}) {
		    $o->{cok}->();
		} else {
		    $o->{cerr}->(basename($p->{FILE}) ." requires property $_ which is not available.");
		}
	    }
	}
    }
}

#- main program.
sub main {
    my %o;
    
    while (@_) {
	local $_ = shift;
	$_ eq '--rpms' and do { $o{rpms} = shift; next };
	$_ eq '--srpms' and do { $o{srpms} = shift; next };
	$_ eq '--contrib-rpms' and do { $o{contrib_rpms} = shift; next };
	$_ eq '--contrib-srpms' and do { $o{contrib_srpms} = shift; next };
	$_ eq '--compss' and do { $o{compss} = shift; next };
	die "usage: $0 --rpms <d> --srpms <d> --contrib-rpms <d> --contrib-srpms <d> --compss <f>";
    }
    
    #- perform all test, $i is used for pass numbering.
    print "Starting tests...";
    my $i = 1;
    foreach (@passtest) {
	my ($count_ok, $count_warn, $count_err) = (0, 0, 0);
	
	$o{c} = sub { print "\nPASS$i: @_" if @_ };
	$o{cok} = sub { ++$count_ok; print "\nPASS$i: @_" if @_ };
	$o{cwarn} = sub { ++$count_warn; print "\nPASS$i: warning: @_" if @_ };
	$o{cerr} = sub { ++$count_err; print "\nPASS$i: error: @_" if @_ };
	
	eval { &$_(\%o) };
	if ($@) {
	    $o{c}->("exiting due to fatal: $@");
	    exit 1;
	}
	if ($count_ok < 0 || $count_warn < 0 || $count_err < 0) {
	    $o{c}->("fatal test result integrity, exiting.");
	    exit 1;
	}
	$o{c}->("completed [ok=$count_ok, warn=$count_warn, error=$count_err]\n");
	++$i;
    }
}

#- execute the tests.
main(@ARGV);