# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1236241161 -3600
# Node ID 0d30ea853889f148e98a0b12d0dc53f940849296

starting point: the current working setup

diff -r 000000000000 -r 0d30ea853889 README
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/README	Thu Mar 05 09:19:21 2009 +0100
@@ -0,0 +1,62 @@
+* Was muss getan werden? *
+
+1) Hochladen der Pakete nach incoming/
+
+2) ./bin/import
+
+3) ./bin/mkpool
+
+    Damit werden die Listen der Pakete erzeugt, die zu den einzelnen
+    Distributionen gehören (var/$DIST/*).
+
+    Anschließend wird sofort `apt-ftparchive' gestartet, das erwartet
+    die Listen dort, wo `mkpool'‥ sie erzeugt hat (→ etc/apt-ftparchive).
+
+    Mit der Option '--remove' löscht `bin/mkpool' Files, die nicht gebraucht werden,
+    aus dem Pool.
+
+
+Welche Dinge sind von Bedeutung?
+Was geht hier ab?
+
+1) Daten gelangen nach import/* (die Hiearchie hier ist egal, gegenwärtig wird
+   daraus die Hierarchie im Pool abgeleitet, was aber wiederum ziemlich egal ist.
+
+    *.changes
+	Dieses File Beschreibt, welche Files Teil des Uploads
+	waren.  In der Regel sind hier eine Reihe von *.deb (Binary-Pakete)
+	und ein *diff.gz (Patch) sowie ein *.dsc erwähnt.
+
+	Dieses *.dsc beschreibt, welche Files zur kompletten Quelle gehören
+	(normalerweise *.orig.tar.gz und *.diff.gz -- wobei möglicherweise das
+	.tar.gz nicht Bestandteil des Uploads war)
+
+	(mit Verweisen auf eine Reihe von *.deb (Binary) sowie
+	 auf ein *.dsc (welches wiederum Verweise auf die Source-Files
+	 enthält))
+
+2) Wenn die Daten im Import-Verzeichnis vollständig sind (ist noch zu implentieren), 
+   dann werden sie in den Pool verschoben.
+
+
+3) bin/mkpool scannt jetzt diese Files im Pool und erstellt darus die
+   File-Listen, die apt-ftparchive benötigt. Wenn mehrere Versionen des
+   selben Paketes in der selben Distribution vorliegen, dann werden
+   ältere Versionen durch neuere ersetzt.
+
+   Folgende Merkmale des .changes werden dafür ausgewertet:
+
+     Source:	    Paket-Quelle
+     Distribution:  Distribution (stable|testing|unstable|...)
+     Archtecture:   Architekturen (i386|...), wobei 'all' durch
+		    alle unterstützten Architekturen ersetzt wird
+		    (siehe Konfiguration)
+     Version:	    Version, wird dann mit 'dpkg --compare-versions'
+		    verglichen
+
+
+4) Ist das erledigt, werden aus den gefundenen Changes-Files die Listen
+   für apt-ftparchive bereitgestellt.
+
+
+# vim:tw=72 sts=4 sw=4 aw ai sm:
diff -r 000000000000 -r 0d30ea853889 bin/.perltidyrc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/.perltidyrc	Thu Mar 05 09:19:21 2009 +0100
@@ -0,0 +1,1 @@
+--paren-tightness=2
diff -r 000000000000 -r 0d30ea853889 bin/import
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/import	Thu Mar 05 09:19:21 2009 +0100
@@ -0,0 +1,109 @@
+#! /usr/bin/perl
+# © 2006 Heiko Schlittermann
+
+use strict;
+use warnings;
+use File::Find;
+use Cwd;
+use FindBin;
+use File::Basename;
+use File::Path;
+use AppConfig;
+
+use lib "$FindBin::RealBin/../lib";
+use Debian::ChangesFile;
+
+use constant CONF => (
+    { CASE => 1 },
+    "force" =>	{ ARGS => "!" },
+);
+
+sub processChanges;
+
+my $TIMESTAMP = "var/.import";
+my $POOLDIR = "pool";
+my $Cf = new AppConfig CONF or die;
+   $Cf->getopt or die;
+
+MAIN: {
+    my $cwd = cwd();
+
+    $POOLDIR = "$cwd/$POOLDIR" if substr($POOLDIR, 0, 1) ne "/";
+    $TIMESTAMP = "$cwd/$TIMESTAMP" if substr($TIMESTAMP, 0, 1) ne "/";
+
+    $Cf->force and unlink $TIMESTAMP;
+
+
+    my $last = (stat $TIMESTAMP)[9] || 0;
+    my $changed = 0;
+    my $wanted = sub { processChanges($last, \$changed) };
+
+	# Two! slashes
+	find({ wanted => $wanted}, "incoming//");
+
+    if ($changed) {
+	open(X, ">$TIMESTAMP");
+	print X $$;
+	close(X);
+    }
+
+}
+
+sub processChanges($$) {
+    my $last = shift;
+    my $touched = shift;
+
+    -f or return;
+    /\.changes$/ or return;
+    (stat $_)[9] >= $last or return;
+
+    my $current = $_;
+    my ($base) = $File::Find::dir =~ m!//(.*)!;
+
+    print "checking $File::Find::name\n" if -t STDIN;
+    my @import;
+
+    my $changes = new Debian::ChangesFile($_);
+
+    push @import, [$_, "$POOLDIR/$base/" . $_];
+
+    foreach ($changes->binaryFiles) {
+	print "\t", $_->file, "\n" if -t STDIN;
+	$_->check;
+	push @import, [$_->file, "$POOLDIR/$base/" . $_->file];
+    }
+
+    foreach ($changes->sourceFiles) {
+	print "\t", $_->file, "\n" if -t STDIN;
+	$_->check;
+	push @import, [$_->file, "$POOLDIR/$base/" . $_->file];
+	my $sources = new Debian::ControlFile $_;
+	foreach ($sources->files) {
+	    print "\t\t", $_->file, "\n" if -t STDIN;
+	    $_->check();
+	push @import, [$_->file, "$POOLDIR/$base/" . $_->file];
+	}
+    }
+
+    print "ok ($current)\n" if -t STDIN;
+
+    foreach (@import) {
+	my ($from, $to) = @$_;
+	my $dstdir = dirname($to);
+	-d $dstdir or mkpath($dstdir, 0, 0755) or die "Can't mkpath $dstdir: $!\n";
+	my $in = new IO::File $from or die "Can't open <$from: $!\n";
+	my $out = new IO::File ">$to.tmp" or die "Can't open >$to.tmp: $!\n";
+
+	local $/ = \4096;
+	$out->print($_) while <$in>;
+	$out->close;
+	$in->close;
+
+	utime((stat $from)[8, 9], "$to.tmp") or die "Can't change timestamps on $to: $!\n";
+	rename("$to.tmp", $to) or die "Can't rename $to.tmp -> $to: $!\n";
+	$$touched = 1;
+    }
+
+}
+
+# vim:sts=4 sw=4 aw ai sm:
diff -r 000000000000 -r 0d30ea853889 bin/mkpool
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/mkpool	Thu Mar 05 09:19:21 2009 +0100
@@ -0,0 +1,324 @@
+#! /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: