diff -r 000000000000 -r 98411ab74262 bin/fix-sections --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/bin/fix-sections Fri Jul 03 15:23:10 2009 +0200 @@ -0,0 +1,97 @@ +#!/usr/bin/perl + +use strict; + +use IO::File; +use File::Find; +use File::Basename; + +my $build_dir = "/home/apt/build"; +my $invalid_sections = "unknown"; +my $default_section = "misc"; +my $sign_with = 'me@debrep.vbox.hurz.is.schlittermann.de'; +my $sections = { + '^nagios' => 'net', + '^exi(acl|grey)$' => 'mail', + '^ha-sync$' => 'admin', + '^ca-certificates' => 'misc', + '^firestart$' => 'admin', + '^logbuch$' => 'admin', + '^sitecp$' => 'web', + '^texmf' => 'tex', + '^schlittermann-apt-keys$' => 'net', + '^update-serial$' => 'net' +}; + +my @tofix; +-d $build_dir or mkdir $build_dir or die "Can't mkdir [$build_dir]: $!"; +chdir $build_dir or die "Can't chdir [$build_dir]: $!"; + +#find(\&f, qw(/home/apt/incoming/)); + +for my $cf (@tofix) { + print "Attempting to fix Sections for [$cf] .. "; + $cf =~ /^(.+\/)?(.+)_([^-]+)(-(.+))?_(.+).changes$/; + my ($p, $v, $r, $a) = ($2, $3, $5, $6); + + my $ra = qx/dpkg --print-architecture/; + chomp $ra; + unless ($a eq $ra) { + warn "skipping foreign arch [$a]\n"; + next; + } + + (my $sf = $cf) =~ s/_[0-9a-z]+\.changes$/.dsc/; + system("dpkg-source -x $sf") == 0 or warn "[dpkg-source -x $sf] failed: $?\n"; + chdir "$p-$v" or warn "Can't chdir [$p-$v]: $!\n"; + if ("$p-$v" =~ /nagios-plugin-ntp-1.0$/) { + chmod 0755, "configure" or warn "Can't chmod 0755, [$p-$v/configure]: $!\n"; + } + { + local $/; + my $fh = new IO::File "< debian/control" or warn "Can't open [< debian/control]: $!\n"; + my $c = <$fh>; + close $fh or warn "Can't close [$fh]: $!\n"; + my $s; + for (keys %{$sections}) { + if ($p =~ /$_/) { + $s = $sections->{$_}; + last; + } + } + $s ||= $default_section; + $c =~ s/(\n)?section:\s+$invalid_sections\n/${1}Section: $s\n/i; + $fh = new IO::File "> debian/control" or warn "Can't open [> debian/control]: $!\n"; + print $fh $c; + close $fh or warn "Can't close [$fh]: $!\n"; + } + + system("dpkg-buildpackage -k$sign_with -rfakeroot") == 0 or warn "[dpkg-buildpackage -k$sign_with -rfakeroot] failed: $?\n"; + chdir ".." or warn "Can't chdir [..]: $!\n"; + (my $uf = basename($cf)) =~ s/.changes$/.upload/; + -e $uf and { unlink $uf or warn "Can't unlink [$uf]: $!\n" }; + system("dupload " . basename($cf)) == 0 or warn "[dupload $cf] failed: $?\n"; + + print "finished\n"; +} + +=pod +sub f { + + /\.changes$/ or return; + + my $f = $_; + my $fh = new IO::File "< $f"; + warn "Can't open [< $f]: $!\n" unless defined $fh; + while (<$fh>) { + chomp; + my $s; + if (/([0-9a-fA-F]{32}) ([0-9]+) ([a-z]+) ([a-z]+) (.+)$/ && ($s = $3) =~ /$invalid_sections/) { + push @tofix, $File::Find::name; + close $fh or warn "Can't close [$fh]: $!\n"; + return; + } + } + close $fh or warn "Can't close [$fh]: $!\n"; +} +=cut