#!/usr/bin/perl
# Copyright Gerben Wierda, 2001 
# See below for documentation. Or run with --help

use Getopt::Long;
GetOptions( "repair", "help", "nocleanup");

&help if ($opt_help);
sub help {
	&helpmsg;
	exit 0;
}

sub helpmsg {
    warn <<"__HELP_INFO";

Help information for $0

    Usage: $0 [--repair] [--help] [--nocleanup] pkg

    $0 is meant to check pkgs to see if they would damage your
    system.

    The following flags apply:
    --help, which displays this message and exits.
    --repair, which turns on repairing the permission and ownership
    differences. Normally, the program only warns.
    --nocleanup, this turns off the cleanup of temporary files. This
    is for debugging purposes. Debugging files may be found in /tmp. They
    will therefore be cleaned up at reboot.

    The program dies if it encounters a senseless comparison, e.g. if the
    original is a file and the copy is a directory (or other type mismatches).

    Normal use:
	$0 --repair SomeProgram.pkg

    $0 uses distcheck to do the actual check. Distcheck does not check files
    which are not already there. As a result, new files will always keep the
    (possibly strange) ownership and permissions they have in the archive.
    In other words: after you have run $0, the pkg will not change the
    ownership and permissions of existing directories and files, but there
    is no guarantuee that new files will have sensible ownership. Luckily,
    this is generally not dangerous. (Or more precisely, not more dangerous
    than installing files you don't know anything about anyway).

__HELP_INFO
}

# This script is a hack using global variables

$workdir = "/tmp/pkgdir.$$";

&setup_info;
&list_pax;
&unpax;
&distcheck;
&repax if $opt_repair;
&cleanup unless $opt_nocleanup;
exit 0;

sub setup_info {
	$pkg = $ARGV[0];
	if (-d $pkg and -r $pkg) {
		if ($pkg =~ /\//) {
			($dir, $basename, $ext) = $pkg =~ /(.*)\/([^\/]+)(\.pkg)/;
		}
		else {
			$dir = ".";
			($basename, $ext) = $pkg =~ /([^\/]+)(\.pkg)/;
		}
	}
	else {
		die "$pkg is not a valid pkg\n";
	}
	open( INFO, "$pkg/$basename.info") or die "$pkg is not a valid pkg\n";
	while (<INFO>) {
		if (/(^DefaultLocation)\s+(.+)/) {
			$defaultlocation = $2;
		}
		if (/(^Relocatable)\s+(.+)/) {
			$relocatable = $2;
		}
	}
	close INFO;
}

sub list_pax {
	open( PAXLIST, "gunzip <\"$pkg/$basename.pax.gz\"| pax|") or
		die "Cannot list paxfile\n";
	@paxlist = <PAXLIST>;
	close PAXLIST;
	@rootlist = grep( /^\//, @paxlist);
	die "There are root entries in pax, I cannot check or repair those\n"
		if @rootlist;
}

sub unpax {
	mkdir( $workdir) or die "Cannot create working directory $workdir\n";
	system( "gunzip <\"$pkg/$basename.pax.gz\" | (cd $workdir; pax -r -p e)") == 0
		or die "unpax failed\n";
}

sub distcheck {
	if ($opt_repair) {
		system( "distcheck --repair $workdir $defaultlocation") == 0
			or die "distcheck not found or distcheck found errors\n";
	}
	else {
		system( "distcheck $workdir $defaultlocation") == 0
			or die "distcheck not found or distcheck found errors\n";
	}
}

sub repax {
	system( "(cd $workdir; pax -w .) | gzip -9 >\"$pkg/$basename.pax.gz\"");
}

sub cleanup {
	system( "rm -rf $workdir") == 0
		or die "Cannot remove working directory $workdir\n";
}