bin/wb-edos-builddebcheck

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2008 Ralf Treinen <treinen@debian.org>
   4 # This program is free software: you can redistribute it and/or modify it under
   5 # the terms of the GNU General Public License as published by the Free Software
   6 # Foundation, version 2 of the License.
   7
   8 $debug=0;
   9
  10 # the prefix used to encode source packages
  11 $sourceprefix="source---";
  12
  13 $architecture="";
  14 $binexplain=0;
  15 $edosoptions = "-failures -explain -quiet";
  16 while ( $arg = shift @ARGV ) {
  17     if ( $arg eq '-a' || $arg eq '--architecture' ) {
  18         if ($#ARGV == -1) {
  19             die "-a option needs a value";
  20         } else {
  21             $architecture = shift @ARGV;
  22         }
  23     } elsif ( $arg =~ "--binexplain" || $arg =~ "-be" ) {
  24         $binexplain = 1;
  25     } elsif ( $arg =~ /^-.*/ ) {
  26         die "unrecognized option: $arg";
  27     } else {
  28         last;
  29     }
  30 }
  31
  32 if ($#ARGV != 0) {
  33     die "Usage: edos-debbuildcheck [options] Packages Sources"
  34 } else {
  35     $packagefile = $arg;
  36     $sourcesfile = shift(@ARGV);
  37 }
  38
  39 if ($debug) {
  40     print "Arch: $architecture\n";
  41     print "Packages: $packagefile\n";
  42     print "Sources:  $sourcesfile\n";
  43     print "Edos options: $edosoptions\n";
  44 }
  45
  46 # check that all stanzas in the binary package file have the same
  47 # architecture.
  48 $packagearch="";
  49 open(P,$packagefile);
  50 while (<P>) {
  51     next unless /^Architecture/;
  52     next if /^Architecture:\s*all/;
  53     /Architecture:\s*([^\s]*)/;
  54     if ($packagearch eq "") {
  55         $packagearch = $1;
  56     } elsif ( $packagearch ne $1) {
  57         die "Package file contains different architectures: $packagearch, $1";
  58     }
  59 }
  60 close P;
  61
  62 if ( $architecture eq "" ) {
  63     if ( $packagearch eq "" ) {
  64         die "No architecture option given, " .
  65             "and no non-all architecture found in the Packages file";
  66     } else {
  67         $architecture = $packagearch;
  68     }
  69 } else {
  70     if ( $packagearch ne "" & $architecture ne $packagearch) {
  71         die "Architecture option is $architecture ".
  72             "but the package file contains architecture $packagearch";
  73     }
  74 }
  75
  76 open(RESULT,"cat $sourcesfile".
  77      "| edos-debcheck $edosoptions '-base FILE' $packagefile |");
  78
  79 $sourcestanza=0;
  80 $explanation="";
  81 $binpackage="";
  82
  83 while (<RESULT>) {
  84     if (/^\s+/) {
  85         if ($sourcestanza) {
  86             s/^(\s*)$sourceprefix(.*)depends on/$1$2build-depends on/o;
  87             s/^(\s*)$sourceprefix(.*) and (.*) conflict/$1$2 build-conflicts with $3/o;
  88             print;
  89             if (/depends on ([^\s]*) .*\{.*\}/) {
  90                 push(@binqueue,$1);
  91             }
  92         } else {
  93             $explanation .= $_;
  94         }
  95     } else {
  96         if ($sourcestanza) {
  97             print "\n";
  98             $sourcestanza=0;
  99         }
 100         if ($binpackage ne ""){
 101             $binfailures{$binpackage} = $explanation;
 102             $binpackage="";
 103         }
 104         if (/^$sourceprefix(.*) \(.*\): FAILED/o) {
 105             print "Package: $1\n";
 106             print "Failed-Why:\n";
 107             $sourcestanza=1;
 108         } elsif (/^([^\s]*) .*: FAILED/) {
 109             $binpackage=$1;
 110             $explanation=$_;
 111             $explanation.=<RESULT>;
 112             $sourcestanza=0;
 113         } else {
 114             # we have someting strange here
 115             $sourcestanza=0;
 116         }
 117     }
 118 }
 119
 120 close RESULT;
 121
 122 if ($binexplain) {
 123     while (@binqueue) {
 124         $p=pop(@binqueue);
 125         $v=$binfailures{$p};
 126         next unless defined $v;
 127         $binfailures{$p}="";
 128         print "$v" if $v ne "";
 129         if ($v=~/depends on ([^\s]*) .*\{.*\}/) {
 130             push(@binqueue,$1);
 131         }
 132     }
 133 }
 134