#! /usr/bin/perl

# © 2006 2007 2008 Heiko Schlittermann <hs@schlittermann.de>


use strict;
use warnings;

use File::Find;
use FindBin;
use IO::File;
use Digest::MD5;
use Cwd;
use AppConfig;
use File::Temp;

use lib "$FindBin::RealBin/../lib";
use Debian::ChangesFile;
use Debian::ControlFile;
use Debian::DebFile;
use Debian::Repository;
use Debian::Dpkg;

chdir $ENV{HOME};

# LISTDIR - hier liegen nur die Filelisten, die apt-ftparchive verarbeiten
# muß, sie werden später nicht gebraucht
my $LISTDIR	= "/home/debian/var/dists";		 
my $TIMESTAMP	= "var/.pool";

# APTROOT - das, was dann als APT-Repository freigegeben wird, also
# sollte es dists/ und pool/ enthalten
my $APTROOT	= "/home/ftp/pub/apt2/debian-ius";

my $ORIGIN	= "schlittermann";			# für das Release-File
my @DISTS	= qw/stable testing unstable/;			
my @SECTIONS	= qw/main contrib non-free test/;
my @BINARCHS	= qw/i386 ia64 amd64/;
my @SRCARCHS	= qw/source/;

my @ARCHS = (@SRCARCHS, @BINARCHS);

my $Cf = new AppConfig (
    { CASE => 1 },
    "signed" =>             { ARGS => "!", DEFAULT => 1 },
    "remove-obsolete" =>    { ARGS => "!" },
    "verbose" =>	    { ARGS => ":i" },
    "stop" =>		    { ARGS => "=s", DEFAULT => "" },
    "force" =>		    { ARGS => "!" },
);

sub processChanges();
sub getChanges();

MAIN: {

    $Cf->getopt or die;
    $Cf->verbose(1) if defined $Cf->verbose && $Cf->verbose == 0;
    $Cf->verbose(0) if not defined $Cf->verbose;

    $| = 1;

    # absolutize the paths
    $LISTDIR = cwd() . "/$LISTDIR" if $LISTDIR !~ /^\//;
    $APTROOT = cwd() . "/$APTROOT" if $APTROOT !~ /^\//;
    $TIMESTAMP = cwd() . "/$TIMESTAMP" if $TIMESTAMP !~ /^\//;

    if (!$Cf->force) {
	exit 0 if ((stat $TIMESTAMP)[9]||0) > ((stat "var/.import")[9]||0);
    }

    # create the dists/ hierarchy
    my $repos = new Debian::Repository {
	root => $APTROOT,
	origin => $ORIGIN,
	dists => \@DISTS,
	sections => \@SECTIONS,
	binary => \@BINARCHS,,
	source => \@SRCARCHS,
    };

    $repos->checkDirs(create => 1, umask => 022);

    chdir($_ = $repos->root) or die "Can't chdir to $_: $!\n";

    # Nun suchen wir die .changes-Files .... und verarbeiten 
    # diese.  Das muß erstmal getan werden, weil wir nur so wissen,
    # welches je Distribution/Architecture das jeweils neueste Paket
    # ist
    find({ wanted => sub { /\.changes$/ and processChanges(); }}, "pool/");
    print "\n" if -t STDIN;

    if ($Cf->stop eq "changes") {
	if ($Cf->verbose) {
	    while (my ($k, $chg) = getChanges()) { print "$k: ".$chg->key("version")."\n" }
	}
	exit 0;
    }

    # Nun gehen wir durch diese Liste der gefundenen Changes-Files
    # und erzeugen für jedes Paket einen Eintrag in der entsprechenden Liste
    # für das dann später loslaufende apt-ftparchive
    my (%LISTS, %KEEP);
    while (my ($k, $changes) = getChanges()) {
    #print "$k ($changes)\n";
    #next;

	my $distribution = $changes->key("distribution");
	print join(" " ,"$k:", $changes->keys(qw/source version/), $distribution, "\n")
	    if -t STDIN;

	$KEEP{$changes->path} = 1;

	# Binary files (brauchen eine etwas andere Behandlung als die etwas weiter
	# unten kommenden source Files
	foreach my $file ($changes->binaryFiles) {

	    # architectures is property of the each binary .deb file itself
	    my $deb = new Debian::DebFile $file;
	    my @archs = map { /^all$/ ? @BINARCHS : $_ } $deb->key("architecture");
	    my $component = $file->component;

	    foreach my $arch (@archs) {

		my $tag = "$distribution.$component.$arch.list";
		my $path = $file->path;

		print "\t" . $file->file . " -> $tag\n" if -t STDIN;

		$LISTS{$tag} = new IO::File $_ = ">$LISTDIR/$tag" or die "Can't open $_: $!\n"
		    unless exists $LISTS{$tag};

		$LISTS{$tag}->print("$path\n");

		$KEEP{$path} = 1;
	    }
	}

	foreach my $file ($changes->sourceFiles) {
	    my $dsc = new Debian::ControlFile $file;

	    my $path = $file->path;
	    my $component = $file->component;
	    my $tag = "$distribution.$component.source.list";

	    print "\t" . $file->file . " -> $tag\n" if -t STDIN;
	    
	    $LISTS{$tag} = new IO::File $_ = ">$LISTDIR/$tag" or die "Can't open $_: $!\n"
		unless exists $LISTS{$tag};

	    $LISTS{$tag}->print("$path\n");

	    $KEEP{$path} = ();
	    @KEEP{map { $_->path } $dsc->files} = ();
	}
    }

    # Nun wären wir mit den Listen eigentlich fertig, aber apt-ftparchive ist traurig, wenn
    # es eine Liste erwartet und es ist keine da. Also müssen wir auch für die Dinge, für die bisher
    # keine Liste angelegt wurde, diese Liste anlegen.
    # Da aktuell offenen Listen sowieso nicht mehr benötigt werden, schließen wir sie bei dieser
    # Gelegenheit gleich.

    foreach my $dist (@DISTS) { foreach my $sect (@SECTIONS) { foreach my $arch (@ARCHS) {
	    my $tag = "$dist.$sect.$arch.list";

	    my $fh;
	    if (exists $LISTS{$tag}) {
		$fh = $LISTS{$tag};
		delete $LISTS{$tag};
	    } else {
		$fh = new IO::File ">$LISTDIR/$tag";
	    }
	    $fh->close;
    } } }

    exit 0 if $Cf->stop eq "lists";

    ## jetzt sind die File-Listen fertig erstellt und es wird Zeit, apt-ftparchive
    # aufzurufen

    if (!-t STDIN) {
	open(SAVEOUT, ">&STDERR");
	open(STDERR, ">/dev/null");
    }

    system("apt-ftparchive", generate => "$ENV{HOME}/etc/apt-ftparchive");

    open(STDERR, ">&SAVEOUT") if !-t STDOUT;
    close(SAVEOUT);

    if ($?) {
	die "Problem running apt-ftparchive, exit was $?\n"
    }

    if ($Cf->signed) {
	my $pid = fork();

	if ($pid) {
	    waitpid($pid, 0);
	} 
	else {
	# Und nun die Release-Files
	# Wir haben zwar schon welche dort liegen (die entstehen beim Pool-Repository
	# einrichten, aber wenn wir mit Keys haben wollen, dann sind die dort nicht 
	# ausreichend.
	my $release_file = "Release";
	my $release_sig = "$release_file.gpg";
	foreach my $dist (@DISTS) {
		my $dir = "$APTROOT/dists/$dist";

		chdir $dir or die "Can't chdir to $dir: $!\n";

		if (-f $release_file) {
		    open(my $r, $release_file) or die "Can't open $release_file: $!\n";
		    $_ = join "", grep { /^\S+:\s*\S.*$/ && !/^Date:/i } <$r>;
		    close($r);

		    if (!/^Suite:/ms && /^Release:\s*(\S+)$/ms) {
			$_ .= "Suite: $1\n";
		    }
		}

		# apt-ftparchive -> tmpfile
		open(my $in, "apt-ftparchive release .|") or die "Problem running apt-ftparchive: $!\n";
		my $out = new File::Temp(DIR => ".") or die "Can't create tmp file: $!\n";
		print {$out} $_, grep !/ Release(?:\.gpg)?$/, <$in>; # das Release-File selbst ist da auch noch drin - weg damit
		close($in) or die "Problem after running apt-ftparchive: $! ($?)";
		close($out);

		# Signatur -> tmpfile
		my $sig = new File::Temp(DIR => ".");
		open($in, "gpg --sign --armor --detach-sign --output - " . $out->filename . "|") or die "Problem running gpg: $!\n";
		print {$sig} <$in>;
		close($in) or die "Problem after running gpg: $! ($?)\n";
		close($sig);

		# tmpfiles -> Wirklichkeit
		chmod(0644, $out->filename, $sig->filename);
		rename($out->filename, $release_file) or die "Can't rename @{[$out->filename()]} to $release_file: $!\n";
		rename($sig->filename, $release_sig) or die "Can't rename @{[$sig->filename()]} to $release_sig: $!\n";
	    }
	}
    }

    # Ok, und nun gehen wir noch mal durch den Baum und gucken nach Files, die nicht
    # mehr gebraucht werden
    find({wanted => sub {
	return if not -f;
	if (not exists $KEEP{$File::Find::name}) {
	    # leave some notice to the importer

	    if ($Cf->get("remove-obsolete")) {
		unlink $_ or die "Can't unlink $File::Find::name: $!\n";
		return;
	    }
	    print "-$File::Find::name\n" if -t STDIN;
	    return;
	}
	print " $File::Find::name\n" if -t STDIN;
    }}, "pool/");

    # print "TO BE REMOVED:\n", join  "\n", map { $_->{file} } @OBSOLETE;

    open(X, ">$TIMESTAMP") or die "$TIMESTAMP: $!";
    print X $$;
    close(X);
}

# Watchout: Wir sitzen im Verzeichnis mit dem betroffenen File!
# Darum übergeben wir noch den Prefix, damit wir das Verzeichnis später 
# wiederfinden.
{
    my %CHANGES;

sub processChanges() {
    my $changes = new Debian::ChangesFile($_, path => $File::Find::name);

    # Nun rausfinden, ob wir noch ältere Files haben, die können wir dann
    # getrost ignorieren

    # Zuerst laufen wir durch gucken suchen uns die aktuellsten .changes-Files
    # raus (key ist source+distribution+architecture)
    # Ein Problem haben wir: Wenn die Archtektur sich ändert:
    #	1.2 i386
    #   2.0 all
    # -> also müssen wir für jede(!) Architektur ein Tag haben und ein aktuellstes
    # File.  (Aber aus 'all' machen wir die Liste der uns bekannten Architekturen

    print join(" ", $changes->keys(qw/source distribution version architecture/)), "\n" if $Cf->verbose > 1;

    foreach my $tag (map { join "^", $changes->keys(qw/source distribution/), $_ } $changes->archs) {

	if (not exists($CHANGES{$tag})) {
	    $CHANGES{$tag} = $changes;
	    print "." if -t STDIN;
	    next;
	}

	my $a = $CHANGES{$tag}->key("version");
	my $b = $changes->key("version");

	#printf "$tag: $a gt $b %d\n", Debian::Dpkg::compareVersions($a, "ge", $b);

	if (Debian::Dpkg::compareVersions($a, "ge", $b)) {
	    print "-" if -t STDIN;
	    next;
	}

	$CHANGES{$tag} = $changes;
	print "+" if -t STDIN;
	print "replacing $tag $a => $b\n" if $Cf->verbose;
	
    }

    return;
} 

sub getChanges() { return each(%CHANGES); }


}

# vim:sts=4 sw=4 aw ai sm:
