1 #!/usr/bin/perl

     2 

     3 use strict;

     4 

     5 use IO::File;

     6 use File::Find;

     7 use File::Basename;

     8 

     9 my $build_dir = "/home/apt/build";

    10 my $invalid_sections = "unknown";

    11 my $default_section = "misc";

    12 my $sign_with = 'me@debrep.vbox.hurz.is.schlittermann.de';

    13 my $sections = {

    14   '^nagios' => 'net',

    15   '^exi(acl|grey)$' => 'mail',

    16   '^ha-sync$' => 'admin',

    17   '^ca-certificates' => 'misc',

    18   '^firestart$' => 'admin',

    19   '^logbuch$' => 'admin',

    20   '^sitecp$' => 'web',

    21   '^texmf' => 'tex',

    22   '^schlittermann-apt-keys$' => 'net',

    23   '^update-serial$' => 'net'

    24 };

    25 

    26 my @tofix;

    27 -d $build_dir or mkdir $build_dir or die "Can't mkdir [$build_dir]: $!";

    28 chdir $build_dir or die "Can't chdir [$build_dir]: $!";

    29 

    30 #find(\&f, qw(/home/apt/incoming/));

    31 

    32 for my $cf (@tofix) {

    33   print "Attempting to fix Sections for [$cf] .. ";

    34   $cf =~ /^(.+\/)?(.+)_([^-]+)(-(.+))?_(.+).changes$/;

    35   my ($p, $v, $r, $a) = ($2, $3, $5, $6);

    36 

    37   my $ra = qx/dpkg --print-architecture/;

    38   chomp $ra;

    39   unless ($a eq $ra) {

    40     warn "skipping foreign arch [$a]\n";

    41     next;

    42   }

    43 

    44   (my $sf = $cf) =~ s/_[0-9a-z]+\.changes$/.dsc/;

    45   system("dpkg-source -x $sf") == 0 or warn "[dpkg-source -x $sf] failed: $?\n";

    46   chdir "$p-$v" or warn "Can't chdir [$p-$v]: $!\n";

    47   if ("$p-$v" =~ /nagios-plugin-ntp-1.0$/) {

    48     chmod 0755, "configure" or warn "Can't chmod 0755, [$p-$v/configure]: $!\n";

    49   }

    50   {

    51     local $/;

    52     my $fh = new IO::File "< debian/control" or warn "Can't open [< debian/control]: $!\n";

    53     my $c = <$fh>;

    54     close $fh or warn "Can't close [$fh]: $!\n";

    55     my $s;

    56     for (keys %{$sections}) {

    57       if ($p =~ /$_/) {

    58         $s = $sections->{$_};

    59         last;

    60       }

    61     }

    62     $s ||= $default_section;

    63     $c =~ s/(\n)?section:\s+$invalid_sections\n/${1}Section: $s\n/i;

    64     $fh = new IO::File "> debian/control" or warn "Can't open [> debian/control]: $!\n";

    65     print $fh $c;

    66     close $fh or warn "Can't close [$fh]: $!\n";

    67   }

    68     

    69   system("dpkg-buildpackage -k$sign_with -rfakeroot") == 0 or warn "[dpkg-buildpackage -k$sign_with -rfakeroot] failed: $?\n";

    70   chdir ".." or warn "Can't chdir [..]: $!\n";

    71   (my $uf = basename($cf)) =~ s/.changes$/.upload/;

    72   -e $uf and { unlink $uf or warn "Can't unlink [$uf]: $!\n" };

    73   system("dupload " . basename($cf)) == 0 or warn "[dupload $cf] failed: $?\n";

    74 

    75   print "finished\n";

    76 }

    77 

    78 =pod

    79 sub f {

    80 

    81   /\.changes$/ or return;

    82 

    83   my $f = $_;

    84   my $fh = new IO::File "< $f";

    85   warn "Can't open [< $f]: $!\n" unless defined $fh;

    86   while (<$fh>) {

    87     chomp;

    88     my $s;

    89     if (/([0-9a-fA-F]{32}) ([0-9]+) ([a-z]+) ([a-z]+) (.+)$/ && ($s = $3) =~ /$invalid_sections/) {

    90       push @tofix, $File::Find::name;

    91       close $fh or warn "Can't close [$fh]: $!\n";

    92       return;

    93     }

    94   }

    95   close $fh or warn "Can't close [$fh]: $!\n"; 

    96 } 

    97 =cut