- split dep and rpm parts into submodules
authorMichael Schröder <mls@suse.de>
Thu, 1 Mar 2007 15:01:23 +0000 (15:01 +0000)
committerMichael Schröder <mls@suse.de>
Thu, 1 Mar 2007 15:01:23 +0000 (15:01 +0000)
- renamed a couple of functions
- fix debsort bug

Build.pm
Build/Deb.pm [new file with mode: 0644]
Build/Rpm.pm [new file with mode: 0644]
build
createrpmdeps
debsort
expanddeps
init_buildsystem
substitutedeps

index 2c7ee54..bd465c1 100644 (file)
--- a/Build.pm
+++ b/Build.pm
@@ -6,6 +6,9 @@ our $expand_dbg;
 use strict;
 use Digest::MD5;
 
+use Build::Rpm;
+use Build::Deb;
+
 my $std_macros = q{
 %define ix86 i386 i486 i586 i686 athlon
 %define arm armv4l armv4b armv5l armv5b armv5tel armv5teb
@@ -68,7 +71,7 @@ sub read_config {
     }
   }
   my @spec;
-  read_spec($config, \@newconfig, \@spec);
+  Build::Rpm::parse($config, \@newconfig, \@spec);
   $config->{'preinstall'} = [];
   $config->{'runscripts'} = [];
   $config->{'required'} = [];
@@ -226,7 +229,7 @@ sub get_runscripts {
 
 ###########################################################################
 
-sub readrpmdeps {
+sub readdeps {
   my ($config, $pkgidp, @depfiles) = @_;
 
   my %provides = ();
@@ -293,7 +296,7 @@ sub readrpmdeps {
   $config->{'requiresh'} = \%requires;
 }
 
-sub forgetrpmdeps {
+sub forgetdeps {
   my $config;
   delete $config->{'providesh'};
   delete $config->{'requiresh'};
@@ -418,903 +421,30 @@ sub add_all_providers {
 
 ###########################################################################
 
-sub expr {
-  my $expr = shift;
-  my $lev = shift;
-
-  $lev ||= 0;
-  my ($v, $v2);
-  $expr =~ s/^\s+//;
-  my $t = substr($expr, 0, 1);
-  if ($t eq '(') {
-    ($v, $expr) = expr(substr($expr, 1), 0);
-    return undef unless defined $v;
-    return undef unless $expr =~ s/^\)//;
-  } elsif ($t eq '!') {
-    ($v, $expr) = expr(substr($expr, 1), 0);
-    return undef unless defined $v;
-    $v = 0 if $v && $v eq '\"\"';
-    $v =~ s/^0+/0/ if $v;
-    $v = !$v;
-  } elsif ($t eq '-') {
-    ($v, $expr) = expr(substr($expr, 1), 0);
-    return undef unless defined $v;
-    $v = -$v;
-  } elsif ($expr =~ /^([0-9]+)(.*?)$/) {
-    $v = $1;
-    $expr = $2;
-  } elsif ($expr =~ /^([a-zA-Z_0-9]+)(.*)$/) {
-    $v = "\"$1\"";
-    $expr = $2;
-  } elsif ($expr =~ /^(\".*?\")(.*)$/) {
-    $v = $1;
-    $expr = $2;
-  } else {
-    return;
-  }
-  while (1) {
-    $expr =~ s/^\s+//;
-    if ($expr =~ /^&&/) {
-      return ($v, $expr) if $lev > 1;
-      ($v2, $expr) = expr(substr($expr, 2), 1);
-      return undef unless defined $v2;
-      $v &&= $v2;
-    } elsif ($expr =~ /^\|\|/) {
-      return ($v, $expr) if $lev > 1;
-      ($v2, $expr) = expr(substr($expr, 2), 1);
-      return undef unless defined $v2;
-      $v ||= $v2;
-    } elsif ($expr =~ /^>=/) {
-      return ($v, $expr) if $lev > 2;
-      ($v2, $expr) = expr(substr($expr, 2), 2);
-      return undef unless defined $v2;
-      $v = (($v =~ /^\"/) ? $v ge $v2 : $v >= $v2) ? 1 : 0;
-    } elsif ($expr =~ /^>/) {
-      return ($v, $expr) if $lev > 2;
-      ($v2, $expr) = expr(substr($expr, 1), 2);
-      return undef unless defined $v2;
-      $v = (($v =~ /^\"/) ? $v gt $v2 : $v > $v2) ? 1 : 0;
-    } elsif ($expr =~ /^<=/) {
-      return ($v, $expr) if $lev > 2;
-      ($v2, $expr) = expr(substr($expr, 2), 2);
-      return undef unless defined $v2;
-      $v = (($v =~ /^\"/) ? $v le $v2 : $v <= $v2) ? 1 : 0;
-    } elsif ($expr =~ /^</) {
-      return ($v, $expr) if $lev > 2;
-      ($v2, $expr) = expr(substr($expr, 1), 2);
-      return undef unless defined $v2;
-      $v = (($v =~ /^\"/) ? $v lt $v2 : $v < $v2) ? 1 : 0;
-    } elsif ($expr =~ /^==/) {
-      return ($v, $expr) if $lev > 2;
-      ($v2, $expr) = expr(substr($expr, 2), 2);
-      return undef unless defined $v2;
-      $v = (($v =~ /^\"/) ? $v eq $v2 : $v == $v2) ? 1 : 0;
-    } elsif ($expr =~ /^!=/) {
-      return ($v, $expr) if $lev > 2;
-      ($v2, $expr) = expr(substr($expr, 2), 2);
-      return undef unless defined $v2;
-      $v = (($v =~ /^\"/) ? $v ne $v2 : $v != $v2) ? 1 : 0;
-    } elsif ($expr =~ /^\+/) {
-      return ($v, $expr) if $lev > 3;
-      ($v2, $expr) = expr(substr($expr, 1), 3);
-      return undef unless defined $v2;
-      $v += $v2;
-    } elsif ($expr =~ /^-/) {
-      return ($v, $expr) if $lev > 3;
-      ($v2, $expr) = expr(substr($expr, 1), 3);
-      return undef unless defined $v2;
-      $v -= $v2;
-    } elsif ($expr =~ /^\*/) {
-      ($v2, $expr) = expr(substr($expr, 1), 4);
-      return undef unless defined $v2;
-      $v *= $v2;
-    } elsif ($expr =~ /^\//) {
-      ($v2, $expr) = expr(substr($expr, 1), 4);
-      return undef unless defined $v2 && 0 + $v2;
-      $v /= $v2;
-    } else {
-      return ($v, $expr);
-    }
-  }
-}
-
-sub read_spec {
-  my ($config, $specfile, $xspec, $ifdeps) = @_;
-
-  my $packname;
-  my $packvers;
-  my $packrel;
-  my $exclarch;
-  my @subpacks;
-  my @packdeps;
-  my $hasnfb;
-  my %macros;
-  my $ret = {};
-
-  my $specdata;
-  local *SPEC;
-  if (ref($specfile) eq 'GLOB') {
-    *SPEC = $specfile;
-  } elsif (ref($specfile) eq 'ARRAY') {
-    $specdata = [ @$specfile ];
-  } elsif (!open(SPEC, '<', $specfile)) {
-    warn("$specfile: $!\n");
-    $ret->{'error'} = "open $specfile: $!";
-    return $ret;
-  }
-  my @macros = @{$config->{'macros'}};
-  my $skip = 0;
-  my $main_preamble = 1;
-  my $inspec = 0;
-  my $hasif = 0;
-  while (1) {
-    my $line;
-    if (@macros) {
-      $line = shift @macros;
-      $hasif = 0 unless @macros;
-    } elsif ($specdata) {
-      $inspec = 1;
-      last unless @$specdata;
-      $line = shift @$specdata;
-      if (ref $line) {
-       $line = $line->[0]; # verbatim line
-        push @$xspec, $line if $xspec;
-        $xspec->[-1] = [ $line, undef ] if $xspec && $skip;
-       next;
-      }
-    } else {
-      $inspec = 1;
-      $line = <SPEC>;
-      last unless defined $line;
-      chomp $line;
-    }
-    push @$xspec, $line if $inspec && $xspec;
-    if ($line =~ /^#\s*neededforbuild\s*(\S.*)$/) {
-      next if $hasnfb;
-      $hasnfb = $1;
-      next;
-    }
-    if ($line =~ /^\s*#/) {
-      next unless $line =~ /^#!BuildIgnore/;
-    }
-    my $expandedline = '';
-    if (!$skip) {
-      my $tries = 0;
-      while ($line =~ /^(.*?)%(\{([^\}]+)\}|[\?\!]*[0-9a-zA-Z_]+|%|\()(.*?)$/) {
-       if ($tries++ > 1000) {
-         $line = 'MACRO';
-         last;
-       }
-       $expandedline .= $1;
-       $line = $4;
-       my $macname = defined($3) ? $3 : $2;
-       my $macorig = $2;
-       my $mactest = 0;
-       if ($macname =~ /^\!\?/ || $macname =~ /^\?\!/) {
-         $mactest = -1;
-       } elsif ($macname =~ /^\?/) {
-         $mactest = 1;
-       }
-       $macname =~ s/^[\!\?]+//;
-       $macname =~ s/ .*//;
-       my $macalt;
-       ($macname, $macalt) = split(':', $macname, 2);
-       if ($macname eq '%') {
-         $expandedline .= '%';
-         next;
-       } elsif ($macname eq '(') {
-         $line = 'MACRO';
-         last;
-       } elsif ($macname eq 'define') {
-         if ($line =~ /^\s*([0-9a-zA-Z_]+)(\([^\)]*\))?\s*(.*?)$/) {
-           my $macname = $1;
-           my $macargs = $2;
-           my $macbody = $3;
-           $macbody = undef if $macargs;
-           $macros{$macname} = $macbody;
-         }
-         $line = '';
-         last;
-       } elsif ($macname eq 'defined' || $macname eq 'with' || $macname eq 'undefined' || $macname eq 'without' || $macname eq 'bcond_with' || $macname eq 'bcond_without') {
-         my @args;
-         if ($macorig =~ /^\{(.*)\}$/) {
-           @args = split(' ', $1);
-           shift @args;
-         } else {
-           @args = split(' ', $line);
-           $line = '';
-         }
-         next unless @args;
-         if ($macname eq 'bcond_with') {
-           $macros{"with_$args[0]"} = 1 if exists $macros{"_with_$args[0]"};
-           next;
-         }
-         if ($macname eq 'bcond_without') {
-           $macros{"with_$args[0]"} = 1 unless exists $macros{"_without_$args[0]"};
-           next;
-         }
-         $args[0] = "with_$args[0]" if $macname eq 'with' || $macname eq 'without';
-         $line = ((exists($macros{$args[0]}) ? 1 : 0) ^ ($macname eq 'undefined' || $macname eq 'without' ? 1 : 0)).$line;
-       } elsif (exists($macros{$macname})) {
-         if (!defined($macros{$macname})) {
-           $line = 'MACRO';
-           last;
-         }
-         $macalt = $macros{$macname} unless defined $macalt;
-         $macalt = '' if $mactest == -1;
-         $line = "$macalt$line";
-       } elsif ($mactest) {
-         $macalt = '' if !defined($macalt) || $mactest == 1;
-         $line = "$macalt$line";
-       } else {
-         $expandedline .= "%$macorig";
-       }
-      }
-    }
-    $line = $expandedline . $line;
-    if ($line =~ /^\s*%else\b/) {
-      $skip = 1 - $skip if $skip < 2;
-      next;
-    }
-    if ($line =~ /^\s*%endif\b/) {
-      $skip-- if $skip;
-      next;
-    }
-    $skip++ if $skip && $line =~ /^\s*%if/;
-
-    if ($skip) {
-      $xspec->[-1] = [ $xspec->[-1], undef ] if $xspec;
-      $$ifdeps = 1 if $ifdeps && ($line =~ /^(BuildRequires|BuildConflicts|\#\!BuildIgnore):\s*(\S.*)$/i);
-      next;
-    }
-
-    if ($line =~ /^\s*%ifarch(.*)$/) {
-      my $arch = $macros{'_target_cpu'} || 'unknown';
-      my @archs = grep {$_ eq $arch} split(/\s+/, $1);
-      $skip = 1 if !@archs;
-      $hasif = 1;
-      next;
-    }
-    if ($line =~ /^\s*%ifnarch(.*)$/) {
-      my $arch = $macros{'_target_cpu'} || 'unknown';
-      my @archs = grep {$_ eq $arch} split(/\s+/, $1);
-      $skip = 1 if @archs;
-      $hasif = 1;
-      next;
-    }
-    if ($line =~ /^\s*%ifos(.*)$/) {
-      my $os = $macros{'_target_os'} || 'unknown';
-      my @oss = grep {$_ eq $os} split(/\s+/, $1);
-      $skip = 1 if !@oss;
-      $hasif = 1;
-      next;
-    }
-    if ($line =~ /^\s*%ifnos(.*)$/) {
-      my $os = $macros{'_target_os'} || 'unknown';
-      my @oss = grep {$_ eq $os} split(/\s+/, $1);
-      $skip = 1 if @oss;
-      $hasif = 1;
-      next;
-    }
-    if ($line =~ /^\s*%if(.*)$/) {
-      my ($v, $r) = expr($1);
-      $v = 0 if $v && $v eq '\"\"';
-      $v =~ s/^0+/0/ if $v;
-      $skip = 1 unless $v;
-      $hasif = 1;
-      next;
-    }
-    if ($main_preamble && ($line =~ /^Name:\s*(\S+)/i)) {
-      $packname = $1;
-      $macros{'name'} = $packname;
-    }
-    if ($main_preamble && ($line =~ /^Version:\s*(\S+)/i)) {
-      $packvers = $1;
-      $macros{'version'} = $packvers;
-    }
-    if ($main_preamble && ($line =~ /^Release:\s*(\S+)/i)) {
-      $packrel = $1;
-      $macros{'release'} = $packrel;
-    }
-    if ($main_preamble && ($line =~ /^ExclusiveArch:\s*(.*)/i)) {
-      $exclarch ||= [];
-      push @$exclarch, split(' ', $1);
-    }
-    if ($main_preamble && ($line =~ /^(BuildRequires|BuildConflicts|\#\!BuildIgnore):\s*(\S.*)$/i)) {
-      my $what = $1;
-      my $deps = $2;
-      $$ifdeps = 1 if $ifdeps && $hasif;
-      my @deps = $deps =~ /([^\s\[\(,]+)(\s+[<=>]+\s+[^\s\[,]+)?(\s+\[[^\]]+\])?[\s,]*/g;
-      if (defined($hasnfb)) {
-        next unless $xspec;
-        if ((grep {$_ eq 'glibc' || $_ eq 'rpm' || $_ eq 'gcc' || $_ eq 'bash'} @deps) > 2) {
-          # ignore old generetad BuildRequire lines.
-         $xspec->[-1] = [ $xspec->[-1], undef ];
-        }
-        next;
-      }
-      my $replace = 0;
-      my @ndeps = ();
-      while (@deps) {
-       my ($pack, $vers, $qual) = splice(@deps, 0, 3);
-       if (defined($qual)) {
-          $replace = 1;
-          my $arch = $macros{'_target_cpu'} || '';
-          my $proj = $macros{'_target_project'} || '';
-         $qual =~ s/^\s*\[//;
-         $qual =~ s/\]$//;
-         my $isneg = 0;
-         my $bad;
-         for my $q (split('[\s,]', $qual)) {
-           $isneg = 1 if $q =~ s/^\!//;
-           $bad = 1 if !defined($bad) && !$isneg;
-           if ($isneg) {
-             if ($q eq $arch || $q eq $proj) {
-               $bad = 1;
-               last;
-             }
-           } elsif ($q eq $arch || $q eq $proj) {
-             $bad = 0;
-           }
-         }
-         next if $bad;
-       }
-       push @ndeps, $pack;
-      }
-      $replace = 1 if grep {/^-/} @ndeps;
-      if ($what ne 'BuildRequires') {
-       push @packdeps, map {"-$_"} @ndeps;
-       next;
-      }
-      push @packdeps, @ndeps;
-      next unless $xspec && $inspec;
-      if ($replace) {
-       my @cndeps = grep {!/^-/} @ndeps;
-       if (@cndeps) {
-          $xspec->[-1] = [ $xspec->[-1], "BuildRequires:  ".join(' ', @cndeps) ];
-       } else {
-          $xspec->[-1] = [ $xspec->[-1], ''];
-       }
-      }
-      next;
-    }
-
-    if ($line =~ /^\s*%package\s+(-n\s+)?(\S+)/) {
-      if ($1) {
-       push @subpacks, $2;
-      } else {
-       push @subpacks, "$packname-$2" if defined $packname;
-      }
-    }
-
-    if ($line =~ /^\s*%(package|prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)/) {
-      $main_preamble = 0;
-    }
-  }
-  close SPEC unless ref $specfile;
-  if (defined($hasnfb)) {
-    if (!@packdeps) {
-      @packdeps = split(' ', $hasnfb);
-    }
-  }
-  unshift @subpacks, $packname;
-  $ret->{'name'} = $packname;
-  $ret->{'version'} = $packvers;
-  $ret->{'release'} = $packrel if defined $packrel;
-  $ret->{'subpacks'} = \@subpacks;
-  $ret->{'exclarch'} = $exclarch if defined $exclarch;
-  $ret->{'deps'} = \@packdeps;
-  return $ret;
-}
-
-###########################################################################
-
-sub read_dsc {
-  my ($bconf, $fn) = @_;
-  my $ret;
-  my @control;
-  if (ref($fn) eq 'ARRAY') {
-    @control = @$fn;
-  } else {
-    local *F;
-    if (!open(F, '<', $fn)) {
-      $ret->{'error'} = "$fn: $!";
-      return $ret;
-    }
-    @control = <F>;
-    close F;
-    chomp @control;
-  }
-  splice(@control, 0, 3) if @control > 3 && $control[0] =~ /^-----BEGIN/;
-  my $name;
-  my $version;
-  my @deps;
-  while (@control) {
-    my $c = shift @control;
-    last if $c eq '';   # new paragraph
-    my ($tag, $data) = split(':', $c, 2);
-    next unless defined $data;
-    $tag = uc($tag);
-    while (@control && $control[0] =~ /^\s/) {
-      $data .= "\n".substr(shift @control, 1);
-    }
-    $data =~ s/^\s+//s;
-    $data =~ s/\s+$//s;
-    if ($tag eq 'VERSION') {
-      $version = $data;
-      $version =~ s/-[^-]+$//;
-    } elsif ($tag eq 'SOURCE') {
-      $name = $data;
-    } elsif ($tag eq 'BUILD-DEPENDS') {
-      my @d = split(/,\s*/, $data);
-      s/\s.*// for @d;
-      push @deps, @d;
-    } elsif ($tag eq 'BUILD-CONFLICTS' || $tag eq 'BUILD-IGNORE') {
-      my @d = split(/,\s*/, $data);
-      s/\s.*// for @d;
-      push @deps, map {"-$_"} @d;
-    }
-  }
-  $ret->{'name'} = $name;
-  $ret->{'version'} = $version;
-  $ret->{'deps'} = \@deps;
-  return $ret;
-}
-
-###########################################################################
-
-my %rpmstag = (
-  "SIGTAG_SIZE"    => 1000,     # /*!< internal Header+Payload size in bytes. */
-  "SIGTAG_MD5"     => 1004,     # /*!< internal MD5 signature. */
-  "NAME"           => 1000,
-  "VERSION"        => 1001,
-  "RELEASE"        => 1002,
-  "EPOCH"          => 1003,
-  "ARCH"           => 1022,
-  "OLDFILENAMES"   => 1027,
-  "SOURCERPM"      => 1044,
-  "PROVIDENAME"    => 1047,
-  "REQUIREFLAGS"   => 1048,
-  "REQUIRENAME"    => 1049,
-  "REQUIREVERSION" => 1050,
-  "NOSOURCE"       => 1051,
-  "NOPATCH"        => 1052,
-  "PROVIDEFLAGS"   => 1112,
-  "PROVIDEVERSION" => 1113,
-  "DIRINDEXES"     => 1116,
-  "BASENAMES"      => 1117,
-  "DIRNAMES"       => 1118,
-);
-
-sub rpmq {
-  my ($rpm, @stags) = @_;
-
-  my @sigtags = grep {/^SIGTAG_/} @stags;
-  @stags = grep {!/^SIGTAG_/} @stags;
-  my $dosigs = @sigtags && !@stags;
-  @stags = @sigtags if $dosigs;
-
-  my $need_filenames = grep { $_ eq 'FILENAMES' } @stags;
-  push @stags, 'BASENAMES', 'DIRNAMES', 'DIRINDEXES', 'OLDFILENAMES' if $need_filenames;
-  @stags = grep { $_ ne 'FILENAMES' } @stags if $need_filenames;
-
-  my %stags = map {0 + ($rpmstag{$_} || $_) => $_} @stags; 
-
-  my ($magic, $sigtype, $headmagic, $cnt, $cntdata, $lead, $head, $index, $data, $tag, $type, $offset, $count);
-
-  local *RPM;
-  if (ref($rpm) eq 'ARRAY') {
-    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $rpm->[0]);
-    if ($headmagic != 0x8eade801) {
-      warn("Bad rpm\n");
-      return ();
-    }
-    if (length($rpm->[0]) < 16 + $cnt * 16 + $cntdata) {
-      warn("Bad rpm\n");
-      return ();
-    }
-    $index = substr($rpm->[0], 16, $cnt * 16);
-    $data = substr($rpm->[0], 16 + $cnt * 16, $cntdata);
-  } else {
-    if (ref($rpm) eq 'GLOB') {
-      *RPM = *$rpm;
-    } elsif (!open(RPM, '<', $rpm)) {
-      warn("$rpm: $!\n");
-      return ();
-    }
-    if (read(RPM, $lead, 96) != 96) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-    ($magic, $sigtype) = unpack('N@78n', $lead);
-    if ($magic != 0xedabeedb || $sigtype != 5) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-    if (read(RPM, $head, 16) != 16) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
-    if ($headmagic != 0x8eade801) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-    if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-    $cntdata = ($cntdata + 7) & ~7;
-    if (read(RPM, $data, $cntdata) != $cntdata) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-  }
-
-  my %res = ();
-  if (@sigtags && !$dosigs) {
-    %res = &rpmq(["$head$index$data"], @sigtags);
-  }
-  if (ref($rpm) eq 'ARRAY' && !$dosigs && @stags && @$rpm > 1) {
-    my %res2 = &rpmq([ $rpm->[1] ], @stags);
-    %res = (%res, %res2);
-    return %res;
-  }
-  if (ref($rpm) ne 'ARRAY' && !$dosigs && @stags) {
-    if (read(RPM, $head, 16) != 16) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
-    if ($headmagic != 0x8eade801) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-    if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-    if (read(RPM, $data, $cntdata) != $cntdata) {
-      warn("Bad rpm $rpm\n");
-      close RPM unless ref($rpm);
-      return ();
-    }
-  }
-  close RPM unless ref($rpm);
-
-  return %res unless @stags;
-
-  while($cnt-- > 0) {
-    ($tag, $type, $offset, $count, $index) = unpack('N4a*', $index);
-    $tag = 0+$tag;
-    if ($stags{$tag}) {
-      eval {
-        my $otag = $stags{$tag};
-        if ($type == 0) {
-          $res{$otag} = [ '' ];
-        } elsif ($type == 1) {
-          $res{$otag} = [ unpack("\@${offset}c$count", $data) ];
-        } elsif ($type == 2) {
-          $res{$otag} = [ unpack("\@${offset}c$count", $data) ];
-        } elsif ($type == 3) {
-          $res{$otag} = [ unpack("\@${offset}n$count", $data) ];
-        } elsif ($type == 4) {
-          $res{$otag} = [ unpack("\@${offset}N$count", $data) ];
-        } elsif ($type == 5) {
-          $res{$otag} = [ undef ];
-        } elsif ($type == 6) {
-          $res{$otag} = [ unpack("\@${offset}Z*", $data) ];
-        } elsif ($type == 7) {
-          $res{$otag} = [ unpack("\@${offset}a$count", $data) ];
-        } elsif ($type == 8 || $type == 9) {
-          my $d = unpack("\@${offset}a*", $data);
-          my @res = split("\0", $d, $count + 1);
-          $res{$otag} = [ splice @res, 0, $count ];
-        } else {
-          $res{$otag} = [ undef ];
-        }
-      };
-      if ($@) {
-        warn("Bad rpm $rpm: $@\n");
-        return ();
-      }
-    }
-  }
-
-  if ($need_filenames) {
-    if ($res{'OLDFILENAMES'}) {
-      $res{'FILENAMES'} = [ @{$res{'OLDFILENAMES'}} ];
-    } else {
-      my $i = 0;
-      $res{'FILENAMES'} = [ map {"$res{'DIRNAMES'}->[$res{'DIRINDEXES'}->[$i++]]$_"} @{$res{'BASENAMES'}} ];
-    }
-  }
-
-  return %res;
-}
-
-sub rpmq_add_flagsvers {
-  my $res = shift;
-  my $name = shift;
-  my $flags = shift;
-  my $vers = shift;
-
-  return unless $res;
-  my @flags = @{$res->{$flags} || []};
-  my @vers = @{$res->{$vers} || []};
-  for (@{$res->{$name}}) {
-    if (@flags && ($flags[0] & 0xe) && @vers) {
-      $_ .= ' ';
-      $_ .= '<' if $flags[0] & 2;
-      $_ .= '>' if $flags[0] & 4;
-      $_ .= '=' if $flags[0] & 8;
-      $_ .= " $vers[0]";
-    }
-    shift @flags;
-    shift @vers;
-  }
+sub parse {
+  my ($cf, $fn, @args) = @_;
+  return Build::Rpm::parse($cf, $fn, @args) if $fn =~ /\.spec$/;
+  return Build::Deb::parse($cf, $fn, @args) if $fn =~ /\.dsc$/;
+  return undef;
 }
 
-sub rpm_verscmp_part {
-  my ($s1, $s2) = @_;
-  if (!defined($s1)) {
-    return defined($s2) ? -1 : 0;
-  }
-  return 1 if !defined $s2;
-  return 0 if $s1 eq $s2;
-  while (1) {
-    $s1 =~ s/^[^a-zA-Z0-9]+//;
-    $s2 =~ s/^[^a-zA-Z0-9]+//;
-    my ($x1, $x2, $r);
-    if ($s1 =~ /^([0-9]+)(.*?)$/) {
-      $x1 = $1;
-      $s1 = $2;
-      $s2 =~ /^([0-9]*)(.*?)$/;
-      $x2 = $1;
-      $s2 = $2;
-      return 1 if $x2 eq '';
-      $x1 =~ s/^0+//;
-      $x2 =~ s/^0+//;
-      $r = length($x1) - length($x2) || $x1 cmp $x2;
-    } elsif ($s1 ne '' && $s2 ne '') {
-      $s1 =~ /^([a-zA-Z]*)(.*?)$/;
-      $x1 = $1;
-      $s1 = $2;
-      $s2 =~ /^([a-zA-Z]*)(.*?)$/;
-      $x2 = $1;
-      $s2 = $2;
-      return -1 if $x1 eq '' || $x2 eq '';
-      $r = $x1 cmp $x2;
-    }
-    return $r if $r;
-    if ($s1 eq '') {
-      return $s2 eq '' ? 0 : -1;
-    }
-    return 1 if $s2 eq ''
-  }
-}
-
-sub rpm_verscmp {
-  my ($s1, $s2) = @_;
-
-  return 0 if $s1 eq $s2;
-  my ($e1, $v1, $r1) = $s1 =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
-  $e1 = 0 unless defined $e1;
-  $r1 = '' unless defined $r1;
-  my ($e2, $v2, $r2) = $s2 =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
-  $e2 = 0 unless defined $e2;
-  $r2 = '' unless defined $r2;
-  if ($e1 ne $e2) {
-    my $r = rpm_verscmp_part($e1, $e2);
-    return $r if $r;
-  }
-  if ($v1 ne $v2) {
-    my $r = rpm_verscmp_part($v1, $v2);
-    return $r if $r;
-  }
-  if ($r1 ne $r2) {
-    return rpm_verscmp_part($r1, $r2);
-  }
-  return 0;
-}
-
-###########################################################################
-
-my $have_zlib;
-eval {
-  require Compress::Zlib;
-  $have_zlib = 1;
-};
-
-sub ungzip {
-  my $data = shift;
-  local (*TMP, *TMP2);
-  open(TMP, "+>", undef) or die("could not open tmpfile\n");
-  syswrite TMP, $data;
-  sysseek(TMP, 0, 0);
-  my $pid = open(TMP2, "-|");
-  die("fork: $!\n") unless defined $pid;
-  if (!$pid) {
-    open(STDIN, "<&TMP");
-    exec 'gunzip';
-    die("gunzip: $!\n");
-  }
-  close(TMP);
-  $data = '';
-  1 while sysread(TMP2, $data, 1024, length($data)) > 0;
-  close(TMP2) || die("gunzip error");
-  return $data;
-}
-
-sub debq {
-  my ($fn) = @_;
-
-  local *DEBF;
-  if (ref($fn) eq 'GLOB') {
-      *DEBF = *$fn;
-  } elsif (!open(DEBF, '<', $fn)) {
-    warn("$fn: $!\n");
-    return ();
-  }
-  my $data = '';
-  sysread(DEBF, $data, 4096);
-  if (length($data) < 8+60) {
-    warn("$fn: not a debian package\n");
-    close DEBF unless ref $fn;
-    return ();
-  }
-  if (substr($data, 0, 8+16) ne "!<arch>\ndebian-binary   ") {
-    close DEBF unless ref $fn;
-    return ();
-  }
-  my $len = substr($data, 8+48, 10);
-  $len += $len & 1;
-  if (length($data) < 8+60+$len+60) {
-    my $r = 8+60+$len+60 - length($data);
-    $r -= length($data);
-    if ((sysread(DEBF, $data, $r < 4096 ? 4096 : $r, length($data)) || 0) < $r) {
-      warn("$fn: unexpected EOF\n");
-      close DEBF unless ref $fn;
-      return ();
-    }
-  }
-  $data = substr($data, 8 + 60 + $len);
-  if (substr($data, 0, 16) ne 'control.tar.gz  ') {
-    warn("$fn: control.tar.gz is not second ar entry\n");
-    close DEBF unless ref $fn;
-    return ();
-  }
-  $len = substr($data, 48, 10);
-  if (length($data) < 60+$len) {
-    my $r = 60+$len - length($data);
-    if ((sysread(DEBF, $data, $r, length($data)) || 0) < $r) {
-      warn("$fn: unexpected EOF\n");
-      close DEBF unless ref $fn;
-      return ();
-    }
-  }
-  close DEBF unless ref($fn);
-  $data = substr($data, 60, $len);
-  my $controlmd5 = Digest::MD5::md5_hex($data);        # our header signature
-  if ($have_zlib) {
-    $data = Compress::Zlib::memGunzip($data);
-  } else {
-    $data = ungzip($data);
-  }
-  if (!$data) {
-    warn("$fn: corrupt control.tar.gz file\n");
-    return ();
-  }
-  my $control;
-  while (length($data) >= 512) {
-    my $n = substr($data, 0, 100);
-    $n =~ s/\0.*//s;
-    my $len = oct('00'.substr($data, 124,12));
-    my $blen = ($len + 1023) & ~511;
-    if (length($data) < $blen) {
-      warn("$fn: corrupt control.tar.gz file\n");
-      return ();
-    }
-    if ($n eq './control') {
-      $control = substr($data, 512, $len);
-      last;
-    }
-    $data = substr($data, $blen);
-  }
-  my %res;
-  my @control = split("\n", $control);
-  while (@control) {
-    my $c = shift @control;
-    last if $c eq '';   # new paragraph
-    my ($tag, $data) = split(':', $c, 2);
-    next unless defined $data;
-    $tag = uc($tag);
-    while (@control && $control[0] =~ /^\s/) {
-      $data .= "\n".substr(shift @control, 1);
-    }
-    $data =~ s/^\s+//s;
-    $data =~ s/\s+$//s;
-    $res{$tag} = $data;
-  }
-  $res{'CONTROL_MD5'} = $controlmd5;
-  return %res;
-}
-
-###########################################################################
-
-sub querybinary {
+sub query {
   my ($binname, $withevra) = @_;
   my $handle = $binname;
   if (ref($binname) eq 'ARRAY') {
     $handle = $binname->[1];
     $binname = $binname->[0];
   }
-  if ($binname =~ /\.rpm$/) {
-    my %res = rpmq($handle, qw{NAME SOURCERPM NOSOURCE NOPATCH SIGTAG_MD5 PROVIDENAME PROVIDEFLAGS PROVIDEVERSION REQUIRENAME REQUIREFLAGS REQUIREVERSION}, ($withevra ? qw{EPOCH VERSION RELEASE ARCH}: ()));
-    return undef unless %res;
-    my $src = $res{'SOURCERPM'}->[0];
-    $src = '' unless defined $src;
-    $src =~ s/-[^-]*-[^-]*\.[^\.]*\.rpm//;
-    my $data = {
-      name => $res{'NAME'}->[0],
-      hdrmd5 => unpack('H32', $res{'SIGTAG_MD5'}->[0]),
-      provides => [ grep {!/^rpmlib\(/ && !/^\//} @{$res{'PROVIDENAME'} || []} ],
-      requires => [ grep {!/^rpmlib\(/ && !/^\//} @{$res{'REQUIRENAME'} || []} ],
-    };
-    $data->{'source'} = $src if $src ne '';
-    if ($withevra) {
-      my $arch = $res{'ARCH'}->[0];
-      $arch = $res{'NOSOURCE'} || $res{'NOPATCH'} ? 'nosrc' : 'src' unless $src ne '';
-      $data->{'version'} = $res{'VERSION'}->[0];
-      $data->{'release'} = $res{'RELEASE'}->[0];
-      $data->{'arch'} = $arch;
-      $data->{'epoch'} = $res{'EPOCH'}->[0] if exists $res{'EPOCH'};
-    }
-    return $data;
-  } elsif ($binname =~ /\.deb$/) {
-    my %res = debq($handle);
-    return undef unless %res;
-    my $name = $res{'PACKAGE'};
-    my $src = $name;
-    $src = $res{'SOURCE'} if $res{'SOURCE'};
-    my @provides = split(',\s*', $res{'PROVIDES'} || '');
-    s/\s.*// for @provides;    #for now
-    push @provides, $name unless grep {$_ eq $name} @provides;
-    my @depends = split(',\s*', $res{'DEPENDS'} || '');
-    my @predepends = split(',\s*', $res{'PRE-DEPENDS'} || '');
-    push @depends, @predepends;
-    s/\s.*// for @provides;    #for now
-    s/\|\s*/\|/g for @depends; #for now
-    s/\s[^\|]*//g for @depends;        #for now
-    my $data = {
-      name => $name,
-      hdrmd5 => $res{'CONTROL_MD5'},
-      provides => \@provides,
-      requires => \@depends,
-    };
-    $data->{'source'} = $src if $src ne '';
-    if ($withevra) {
-      if ($res{'VERSION'} =~ /^(.*)-(.*?)$/) {
-        $data->{'version'} = $1;
-        $data->{'release'} = $2;
-      } else {
-        $data->{'version'} = $res{'VERSION'};
-      }
-      $data->{'arch'} = $res{'ARCHITECTURE'};
-    }
-    return $data;
-  } else {
-    return undef;
-  }
+  return Build::Rpm::query($handle, $withevra) if $binname =~ /\.rpm$/;
+  return Build::Deb::query($handle, $withevra) if $binname =~ /\.deb$/;
+  return undef;
+}
+
+sub queryhdrmd5 {
+  my ($binname) = @_;
+  return Build::Rpm::queryhdrmd5($binname) if $binname =~ /\.rpm$/;
+  return Build::Deb::queryhdrmd5($binname) if $binname =~ /\.deb$/;
+  return undef;
 }
 
 1;
diff --git a/Build/Deb.pm b/Build/Deb.pm
new file mode 100644 (file)
index 0000000..11be8d0
--- /dev/null
@@ -0,0 +1,263 @@
+
+package Build::Deb;
+
+use strict;
+use Digest::MD5;
+
+my $have_zlib;
+eval {
+  require Compress::Zlib;
+  $have_zlib = 1;
+};
+
+sub parse {
+  my ($bconf, $fn) = @_;
+  my $ret;
+  my @control;
+  if (ref($fn) eq 'ARRAY') {
+    @control = @$fn;
+  } else {
+    local *F;
+    if (!open(F, '<', $fn)) {
+      $ret->{'error'} = "$fn: $!";
+      return $ret;
+    }
+    @control = <F>;
+    close F;
+    chomp @control;
+  }
+  splice(@control, 0, 3) if @control > 3 && $control[0] =~ /^-----BEGIN/;
+  my $name;
+  my $version;
+  my @deps;
+  while (@control) {
+    my $c = shift @control;
+    last if $c eq '';   # new paragraph
+    my ($tag, $data) = split(':', $c, 2);
+    next unless defined $data;
+    $tag = uc($tag);
+    while (@control && $control[0] =~ /^\s/) {
+      $data .= "\n".substr(shift @control, 1);
+    }
+    $data =~ s/^\s+//s;
+    $data =~ s/\s+$//s;
+    if ($tag eq 'VERSION') {
+      $version = $data;
+      $version =~ s/-[^-]+$//;
+    } elsif ($tag eq 'SOURCE') {
+      $name = $data;
+    } elsif ($tag eq 'BUILD-DEPENDS') {
+      my @d = split(/,\s*/, $data);
+      s/\s.*// for @d;
+      push @deps, @d;
+    } elsif ($tag eq 'BUILD-CONFLICTS' || $tag eq 'BUILD-IGNORE') {
+      my @d = split(/,\s*/, $data);
+      s/\s.*// for @d;
+      push @deps, map {"-$_"} @d;
+    }
+  }
+  $ret->{'name'} = $name;
+  $ret->{'version'} = $version;
+  $ret->{'deps'} = \@deps;
+  return $ret;
+}
+
+sub ungzip {
+  my $data = shift;
+  local (*TMP, *TMP2);
+  open(TMP, "+>", undef) or die("could not open tmpfile\n");
+  syswrite TMP, $data;
+  sysseek(TMP, 0, 0);
+  my $pid = open(TMP2, "-|");
+  die("fork: $!\n") unless defined $pid;
+  if (!$pid) {
+    open(STDIN, "<&TMP");
+    exec 'gunzip';
+    die("gunzip: $!\n");
+  }
+  close(TMP);
+  $data = '';
+  1 while sysread(TMP2, $data, 1024, length($data)) > 0;
+  close(TMP2) || die("gunzip error");
+  return $data;
+}
+
+sub debq {
+  my ($fn) = @_;
+
+  local *DEBF;
+  if (ref($fn) eq 'GLOB') {
+      *DEBF = *$fn;
+  } elsif (!open(DEBF, '<', $fn)) {
+    warn("$fn: $!\n");
+    return ();
+  }
+  my $data = '';
+  sysread(DEBF, $data, 4096);
+  if (length($data) < 8+60) {
+    warn("$fn: not a debian package\n");
+    close DEBF unless ref $fn;
+    return ();
+  }
+  if (substr($data, 0, 8+16) ne "!<arch>\ndebian-binary   ") {
+    close DEBF unless ref $fn;
+    return ();
+  }
+  my $len = substr($data, 8+48, 10);
+  $len += $len & 1;
+  if (length($data) < 8+60+$len+60) {
+    my $r = 8+60+$len+60 - length($data);
+    $r -= length($data);
+    if ((sysread(DEBF, $data, $r < 4096 ? 4096 : $r, length($data)) || 0) < $r) {
+      warn("$fn: unexpected EOF\n");
+      close DEBF unless ref $fn;
+      return ();
+    }
+  }
+  $data = substr($data, 8 + 60 + $len);
+  if (substr($data, 0, 16) ne 'control.tar.gz  ') {
+    warn("$fn: control.tar.gz is not second ar entry\n");
+    close DEBF unless ref $fn;
+    return ();
+  }
+  $len = substr($data, 48, 10);
+  if (length($data) < 60+$len) {
+    my $r = 60+$len - length($data);
+    if ((sysread(DEBF, $data, $r, length($data)) || 0) < $r) {
+      warn("$fn: unexpected EOF\n");
+      close DEBF unless ref $fn;
+      return ();
+    }
+  }
+  close DEBF unless ref($fn);
+  $data = substr($data, 60, $len);
+  my $controlmd5 = Digest::MD5::md5_hex($data);        # our header signature
+  if ($have_zlib) {
+    $data = Compress::Zlib::memGunzip($data);
+  } else {
+    $data = ungzip($data);
+  }
+  if (!$data) {
+    warn("$fn: corrupt control.tar.gz file\n");
+    return ();
+  }
+  my $control;
+  while (length($data) >= 512) {
+    my $n = substr($data, 0, 100);
+    $n =~ s/\0.*//s;
+    my $len = oct('00'.substr($data, 124,12));
+    my $blen = ($len + 1023) & ~511;
+    if (length($data) < $blen) {
+      warn("$fn: corrupt control.tar.gz file\n");
+      return ();
+    }
+    if ($n eq './control') {
+      $control = substr($data, 512, $len);
+      last;
+    }
+    $data = substr($data, $blen);
+  }
+  my %res;
+  my @control = split("\n", $control);
+  while (@control) {
+    my $c = shift @control;
+    last if $c eq '';   # new paragraph
+    my ($tag, $data) = split(':', $c, 2);
+    next unless defined $data;
+    $tag = uc($tag);
+    while (@control && $control[0] =~ /^\s/) {
+      $data .= "\n".substr(shift @control, 1);
+    }
+    $data =~ s/^\s+//s;
+    $data =~ s/\s+$//s;
+    $res{$tag} = $data;
+  }
+  $res{'CONTROL_MD5'} = $controlmd5;
+  return %res;
+}
+
+sub query {
+  my ($handle, $withevra) = @_;
+
+  my %res = debq($handle);
+  return undef unless %res;
+  my $name = $res{'PACKAGE'};
+  my $src = $name;
+  $src = $res{'SOURCE'} if $res{'SOURCE'};
+  my @provides = split(',\s*', $res{'PROVIDES'} || '');
+  s/\s.*// for @provides;      #for now
+  push @provides, $name unless grep {$_ eq $name} @provides;
+  my @depends = split(',\s*', $res{'DEPENDS'} || '');
+  my @predepends = split(',\s*', $res{'PRE-DEPENDS'} || '');
+  push @depends, @predepends;
+  s/\s.*// for @provides;      #for now
+  s/\|\s*/\|/g for @depends;   #for now
+  s/\s[^\|]*//g for @depends;  #for now
+  my $data = {
+    name => $name,
+    hdrmd5 => $res{'CONTROL_MD5'},
+    provides => \@provides,
+    requires => \@depends,
+  };
+  $data->{'source'} = $src if $src ne '';
+  if ($withevra) {
+    if ($res{'VERSION'} =~ /^(.*)-(.*?)$/) {
+      $data->{'version'} = $1;
+      $data->{'release'} = $2;
+    } else {
+      $data->{'version'} = $res{'VERSION'};
+    }
+    $data->{'arch'} = $res{'ARCHITECTURE'};
+  }
+  return $data;
+}
+
+sub queryhdrmd5 {
+  my ($bin) = @_; 
+
+  local *F; 
+  open(F, '<', $bin) || die("$bin: $!\n");
+  my $data = ''; 
+  sysread(F, $data, 4096);
+  if (length($data) < 8+60) {
+    warn("$bin: not a debian package\n");
+    close F;
+    return undef; 
+  }   
+  if (substr($data, 0, 8+16) ne "!<arch>\ndebian-binary   ") {
+    warn("$bin: not a debian package\n");
+    close F;
+    return undef; 
+  }   
+  my $len = substr($data, 8+48, 10);
+  $len += $len & 1;
+  if (length($data) < 8+60+$len+60) {
+    my $r = 8+60+$len+60 - length($data);
+    $r -= length($data);
+    if ((sysread(F, $data, $r < 4096 ? 4096 : $r, length($data)) || 0) < $r) {
+      warn("$bin: unexpected EOF\n");
+      close F;
+      return undef; 
+    }   
+  }   
+  $data = substr($data, 8 + 60 + $len);
+  if (substr($data, 0, 16) ne 'control.tar.gz  ') {
+    warn("$bin: control.tar.gz is not second ar entry\n");
+    close F;
+    return undef; 
+  }   
+  $len = substr($data, 48, 10);
+  if (length($data) < 60+$len) {
+    my $r = 60+$len - length($data);
+    if ((sysread(F, $data, $r, length($data)) || 0) < $r) {
+      warn("$bin: unexpected EOF\n");
+      close F;
+      return undef; 
+    }   
+  }   
+  close F;
+  $data = substr($data, 60, $len);
+  return Digest::MD5::md5_hex($data);
+}
+
+1;
diff --git a/Build/Rpm.pm b/Build/Rpm.pm
new file mode 100644 (file)
index 0000000..ec72db5
--- /dev/null
@@ -0,0 +1,742 @@
+
+package Build::Rpm;
+
+use strict;
+
+sub expr {
+  my $expr = shift;
+  my $lev = shift;
+
+  $lev ||= 0;
+  my ($v, $v2);
+  $expr =~ s/^\s+//;
+  my $t = substr($expr, 0, 1);
+  if ($t eq '(') {
+    ($v, $expr) = expr(substr($expr, 1), 0);
+    return undef unless defined $v;
+    return undef unless $expr =~ s/^\)//;
+  } elsif ($t eq '!') {
+    ($v, $expr) = expr(substr($expr, 1), 0);
+    return undef unless defined $v;
+    $v = 0 if $v && $v eq '\"\"';
+    $v =~ s/^0+/0/ if $v;
+    $v = !$v;
+  } elsif ($t eq '-') {
+    ($v, $expr) = expr(substr($expr, 1), 0);
+    return undef unless defined $v;
+    $v = -$v;
+  } elsif ($expr =~ /^([0-9]+)(.*?)$/) {
+    $v = $1;
+    $expr = $2;
+  } elsif ($expr =~ /^([a-zA-Z_0-9]+)(.*)$/) {
+    $v = "\"$1\"";
+    $expr = $2;
+  } elsif ($expr =~ /^(\".*?\")(.*)$/) {
+    $v = $1;
+    $expr = $2;
+  } else {
+    return;
+  }
+  while (1) {
+    $expr =~ s/^\s+//;
+    if ($expr =~ /^&&/) {
+      return ($v, $expr) if $lev > 1;
+      ($v2, $expr) = expr(substr($expr, 2), 1);
+      return undef unless defined $v2;
+      $v &&= $v2;
+    } elsif ($expr =~ /^\|\|/) {
+      return ($v, $expr) if $lev > 1;
+      ($v2, $expr) = expr(substr($expr, 2), 1);
+      return undef unless defined $v2;
+      $v ||= $v2;
+    } elsif ($expr =~ /^>=/) {
+      return ($v, $expr) if $lev > 2;
+      ($v2, $expr) = expr(substr($expr, 2), 2);
+      return undef unless defined $v2;
+      $v = (($v =~ /^\"/) ? $v ge $v2 : $v >= $v2) ? 1 : 0;
+    } elsif ($expr =~ /^>/) {
+      return ($v, $expr) if $lev > 2;
+      ($v2, $expr) = expr(substr($expr, 1), 2);
+      return undef unless defined $v2;
+      $v = (($v =~ /^\"/) ? $v gt $v2 : $v > $v2) ? 1 : 0;
+    } elsif ($expr =~ /^<=/) {
+      return ($v, $expr) if $lev > 2;
+      ($v2, $expr) = expr(substr($expr, 2), 2);
+      return undef unless defined $v2;
+      $v = (($v =~ /^\"/) ? $v le $v2 : $v <= $v2) ? 1 : 0;
+    } elsif ($expr =~ /^</) {
+      return ($v, $expr) if $lev > 2;
+      ($v2, $expr) = expr(substr($expr, 1), 2);
+      return undef unless defined $v2;
+      $v = (($v =~ /^\"/) ? $v lt $v2 : $v < $v2) ? 1 : 0;
+    } elsif ($expr =~ /^==/) {
+      return ($v, $expr) if $lev > 2;
+      ($v2, $expr) = expr(substr($expr, 2), 2);
+      return undef unless defined $v2;
+      $v = (($v =~ /^\"/) ? $v eq $v2 : $v == $v2) ? 1 : 0;
+    } elsif ($expr =~ /^!=/) {
+      return ($v, $expr) if $lev > 2;
+      ($v2, $expr) = expr(substr($expr, 2), 2);
+      return undef unless defined $v2;
+      $v = (($v =~ /^\"/) ? $v ne $v2 : $v != $v2) ? 1 : 0;
+    } elsif ($expr =~ /^\+/) {
+      return ($v, $expr) if $lev > 3;
+      ($v2, $expr) = expr(substr($expr, 1), 3);
+      return undef unless defined $v2;
+      $v += $v2;
+    } elsif ($expr =~ /^-/) {
+      return ($v, $expr) if $lev > 3;
+      ($v2, $expr) = expr(substr($expr, 1), 3);
+      return undef unless defined $v2;
+      $v -= $v2;
+    } elsif ($expr =~ /^\*/) {
+      ($v2, $expr) = expr(substr($expr, 1), 4);
+      return undef unless defined $v2;
+      $v *= $v2;
+    } elsif ($expr =~ /^\//) {
+      ($v2, $expr) = expr(substr($expr, 1), 4);
+      return undef unless defined $v2 && 0 + $v2;
+      $v /= $v2;
+    } else {
+      return ($v, $expr);
+    }
+  }
+}
+
+sub parse {
+  my ($config, $specfile, $xspec) = @_;
+
+  my $packname;
+  my $packvers;
+  my $packrel;
+  my $exclarch;
+  my @subpacks;
+  my @packdeps;
+  my $hasnfb;
+  my %macros;
+  my $ret = {};
+  my $ifdeps;
+
+  my $specdata;
+  local *SPEC;
+  if (ref($specfile) eq 'GLOB') {
+    *SPEC = *$specfile;
+  } elsif (ref($specfile) eq 'ARRAY') {
+    $specdata = [ @$specfile ];
+  } elsif (!open(SPEC, '<', $specfile)) {
+    warn("$specfile: $!\n");
+    $ret->{'error'} = "open $specfile: $!";
+    return $ret;
+  }
+  my @macros = @{$config->{'macros'}};
+  my $skip = 0;
+  my $main_preamble = 1;
+  my $inspec = 0;
+  my $hasif = 0;
+  while (1) {
+    my $line;
+    if (@macros) {
+      $line = shift @macros;
+      $hasif = 0 unless @macros;
+    } elsif ($specdata) {
+      $inspec = 1;
+      last unless @$specdata;
+      $line = shift @$specdata;
+      if (ref $line) {
+       $line = $line->[0]; # verbatim line
+        push @$xspec, $line if $xspec;
+        $xspec->[-1] = [ $line, undef ] if $xspec && $skip;
+       next;
+      }
+    } else {
+      $inspec = 1;
+      $line = <SPEC>;
+      last unless defined $line;
+      chomp $line;
+    }
+    push @$xspec, $line if $inspec && $xspec;
+    if ($line =~ /^#\s*neededforbuild\s*(\S.*)$/) {
+      next if defined $hasnfb;
+      $hasnfb = $1;
+      next;
+    }
+    if ($line =~ /^\s*#/) {
+      next unless $line =~ /^#!BuildIgnore/;
+    }
+    my $expandedline = '';
+    if (!$skip) {
+      my $tries = 0;
+      while ($line =~ /^(.*?)%(\{([^\}]+)\}|[\?\!]*[0-9a-zA-Z_]+|%|\()(.*?)$/) {
+       if ($tries++ > 1000) {
+         $line = 'MACRO';
+         last;
+       }
+       $expandedline .= $1;
+       $line = $4;
+       my $macname = defined($3) ? $3 : $2;
+       my $macorig = $2;
+       my $mactest = 0;
+       if ($macname =~ /^\!\?/ || $macname =~ /^\?\!/) {
+         $mactest = -1;
+       } elsif ($macname =~ /^\?/) {
+         $mactest = 1;
+       }
+       $macname =~ s/^[\!\?]+//;
+       $macname =~ s/ .*//;
+       my $macalt;
+       ($macname, $macalt) = split(':', $macname, 2);
+       if ($macname eq '%') {
+         $expandedline .= '%';
+         next;
+       } elsif ($macname eq '(') {
+         $line = 'MACRO';
+         last;
+       } elsif ($macname eq 'define') {
+         if ($line =~ /^\s*([0-9a-zA-Z_]+)(\([^\)]*\))?\s*(.*?)$/) {
+           my $macname = $1;
+           my $macargs = $2;
+           my $macbody = $3;
+           $macbody = undef if $macargs;
+           $macros{$macname} = $macbody;
+         }
+         $line = '';
+         last;
+       } elsif ($macname eq 'defined' || $macname eq 'with' || $macname eq 'undefined' || $macname eq 'without' || $macname eq 'bcond_with' || $macname eq 'bcond_without') {
+         my @args;
+         if ($macorig =~ /^\{(.*)\}$/) {
+           @args = split(' ', $1);
+           shift @args;
+         } else {
+           @args = split(' ', $line);
+           $line = '';
+         }
+         next unless @args;
+         if ($macname eq 'bcond_with') {
+           $macros{"with_$args[0]"} = 1 if exists $macros{"_with_$args[0]"};
+           next;
+         }
+         if ($macname eq 'bcond_without') {
+           $macros{"with_$args[0]"} = 1 unless exists $macros{"_without_$args[0]"};
+           next;
+         }
+         $args[0] = "with_$args[0]" if $macname eq 'with' || $macname eq 'without';
+         $line = ((exists($macros{$args[0]}) ? 1 : 0) ^ ($macname eq 'undefined' || $macname eq 'without' ? 1 : 0)).$line;
+       } elsif (exists($macros{$macname})) {
+         if (!defined($macros{$macname})) {
+           $line = 'MACRO';
+           last;
+         }
+         $macalt = $macros{$macname} unless defined $macalt;
+         $macalt = '' if $mactest == -1;
+         $line = "$macalt$line";
+       } elsif ($mactest) {
+         $macalt = '' if !defined($macalt) || $mactest == 1;
+         $line = "$macalt$line";
+       } else {
+         $expandedline .= "%$macorig";
+       }
+      }
+    }
+    $line = $expandedline . $line;
+    if ($line =~ /^\s*%else\b/) {
+      $skip = 1 - $skip if $skip < 2;
+      next;
+    }
+    if ($line =~ /^\s*%endif\b/) {
+      $skip-- if $skip;
+      next;
+    }
+    $skip++ if $skip && $line =~ /^\s*%if/;
+
+    if ($skip) {
+      $xspec->[-1] = [ $xspec->[-1], undef ] if $xspec;
+      $ifdeps = 1 if $line =~ /^(BuildRequires|BuildConflicts|\#\!BuildIgnore):\s*(\S.*)$/i;
+      next;
+    }
+
+    if ($line =~ /^\s*%ifarch(.*)$/) {
+      my $arch = $macros{'_target_cpu'} || 'unknown';
+      my @archs = grep {$_ eq $arch} split(/\s+/, $1);
+      $skip = 1 if !@archs;
+      $hasif = 1;
+      next;
+    }
+    if ($line =~ /^\s*%ifnarch(.*)$/) {
+      my $arch = $macros{'_target_cpu'} || 'unknown';
+      my @archs = grep {$_ eq $arch} split(/\s+/, $1);
+      $skip = 1 if @archs;
+      $hasif = 1;
+      next;
+    }
+    if ($line =~ /^\s*%ifos(.*)$/) {
+      my $os = $macros{'_target_os'} || 'unknown';
+      my @oss = grep {$_ eq $os} split(/\s+/, $1);
+      $skip = 1 if !@oss;
+      $hasif = 1;
+      next;
+    }
+    if ($line =~ /^\s*%ifnos(.*)$/) {
+      my $os = $macros{'_target_os'} || 'unknown';
+      my @oss = grep {$_ eq $os} split(/\s+/, $1);
+      $skip = 1 if @oss;
+      $hasif = 1;
+      next;
+    }
+    if ($line =~ /^\s*%if(.*)$/) {
+      my ($v, $r) = expr($1);
+      $v = 0 if $v && $v eq '\"\"';
+      $v =~ s/^0+/0/ if $v;
+      $skip = 1 unless $v;
+      $hasif = 1;
+      next;
+    }
+    if ($main_preamble && ($line =~ /^Name:\s*(\S+)/i)) {
+      $packname = $1;
+      $macros{'name'} = $packname;
+    }
+    if ($main_preamble && ($line =~ /^Version:\s*(\S+)/i)) {
+      $packvers = $1;
+      $macros{'version'} = $packvers;
+    }
+    if ($main_preamble && ($line =~ /^Release:\s*(\S+)/i)) {
+      $packrel = $1;
+      $macros{'release'} = $packrel;
+    }
+    if ($main_preamble && ($line =~ /^ExclusiveArch:\s*(.*)/i)) {
+      $exclarch ||= [];
+      push @$exclarch, split(' ', $1);
+    }
+    if ($main_preamble && ($line =~ /^(BuildRequires|BuildConflicts|\#\!BuildIgnore):\s*(\S.*)$/i)) {
+      my $what = $1;
+      my $deps = $2;
+      $ifdeps = 1 if $hasif;
+      my @deps = $deps =~ /([^\s\[\(,]+)(\s+[<=>]+\s+[^\s\[,]+)?(\s+\[[^\]]+\])?[\s,]*/g;
+      my $replace = 0;
+      my @ndeps = ();
+      while (@deps) {
+       my ($pack, $vers, $qual) = splice(@deps, 0, 3);
+       if (defined($qual)) {
+          $replace = 1;
+          my $arch = $macros{'_target_cpu'} || '';
+          my $proj = $macros{'_target_project'} || '';
+         $qual =~ s/^\s*\[//;
+         $qual =~ s/\]$//;
+         my $isneg = 0;
+         my $bad;
+         for my $q (split('[\s,]', $qual)) {
+           $isneg = 1 if $q =~ s/^\!//;
+           $bad = 1 if !defined($bad) && !$isneg;
+           if ($isneg) {
+             if ($q eq $arch || $q eq $proj) {
+               $bad = 1;
+               last;
+             }
+           } elsif ($q eq $arch || $q eq $proj) {
+             $bad = 0;
+           }
+         }
+         next if $bad;
+       }
+       push @ndeps, $pack;
+      }
+
+      $replace = 1 if grep {/^-/} @ndeps;
+      if ($what ne 'BuildRequires') {
+       push @packdeps, map {"-$_"} @ndeps;
+       next;
+      }
+      if (defined($hasnfb)) {
+        next unless $xspec;
+        if ((grep {$_ eq 'glibc' || $_ eq 'rpm' || $_ eq 'gcc' || $_ eq 'bash'} @ndeps) > 2) {
+          # ignore old generetad BuildRequire lines.
+         $xspec->[-1] = [ $xspec->[-1], undef ];
+       }
+       next;
+      }
+      push @packdeps, @ndeps;
+      next unless $xspec && $inspec;
+      if ($replace) {
+       my @cndeps = grep {!/^-/} @ndeps;
+       if (@cndeps) {
+          $xspec->[-1] = [ $xspec->[-1], "BuildRequires:  ".join(' ', @cndeps) ];
+       } else {
+          $xspec->[-1] = [ $xspec->[-1], ''];
+       }
+      }
+      next;
+    }
+
+    if ($line =~ /^\s*%package\s+(-n\s+)?(\S+)/) {
+      if ($1) {
+       push @subpacks, $2;
+      } else {
+       push @subpacks, "$packname-$2" if defined $packname;
+      }
+    }
+
+    if ($line =~ /^\s*%(package|prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)/) {
+      $main_preamble = 0;
+    }
+  }
+  close SPEC unless ref $specfile;
+  if (defined($hasnfb)) {
+    if (!@packdeps) {
+      @packdeps = split(' ', $hasnfb);
+    }
+  }
+  unshift @subpacks, $packname;
+  $ret->{'name'} = $packname;
+  $ret->{'version'} = $packvers;
+  $ret->{'release'} = $packrel if defined $packrel;
+  $ret->{'subpacks'} = \@subpacks;
+  $ret->{'exclarch'} = $exclarch if defined $exclarch;
+  $ret->{'deps'} = \@packdeps;
+  $ret->{'configdependent'} = 1 if $ifdeps;
+  return $ret;
+}
+
+###########################################################################
+
+my %rpmstag = (
+  "SIGTAG_SIZE"    => 1000,     # /*!< internal Header+Payload size in bytes. */
+  "SIGTAG_MD5"     => 1004,     # /*!< internal MD5 signature. */
+  "NAME"           => 1000,
+  "VERSION"        => 1001,
+  "RELEASE"        => 1002,
+  "EPOCH"          => 1003,
+  "ARCH"           => 1022,
+  "OLDFILENAMES"   => 1027,
+  "SOURCERPM"      => 1044,
+  "PROVIDENAME"    => 1047,
+  "REQUIREFLAGS"   => 1048,
+  "REQUIRENAME"    => 1049,
+  "REQUIREVERSION" => 1050,
+  "NOSOURCE"       => 1051,
+  "NOPATCH"        => 1052,
+  "PROVIDEFLAGS"   => 1112,
+  "PROVIDEVERSION" => 1113,
+  "DIRINDEXES"     => 1116,
+  "BASENAMES"      => 1117,
+  "DIRNAMES"       => 1118,
+);
+
+sub rpmq {
+  my ($rpm, @stags) = @_;
+
+  my @sigtags = grep {/^SIGTAG_/} @stags;
+  @stags = grep {!/^SIGTAG_/} @stags;
+  my $dosigs = @sigtags && !@stags;
+  @stags = @sigtags if $dosigs;
+
+  my $need_filenames = grep { $_ eq 'FILENAMES' } @stags;
+  push @stags, 'BASENAMES', 'DIRNAMES', 'DIRINDEXES', 'OLDFILENAMES' if $need_filenames;
+  @stags = grep { $_ ne 'FILENAMES' } @stags if $need_filenames;
+
+  my %stags = map {0 + ($rpmstag{$_} || $_) => $_} @stags; 
+
+  my ($magic, $sigtype, $headmagic, $cnt, $cntdata, $lead, $head, $index, $data, $tag, $type, $offset, $count);
+
+  local *RPM;
+  if (ref($rpm) eq 'ARRAY') {
+    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $rpm->[0]);
+    if ($headmagic != 0x8eade801) {
+      warn("Bad rpm\n");
+      return ();
+    }
+    if (length($rpm->[0]) < 16 + $cnt * 16 + $cntdata) {
+      warn("Bad rpm\n");
+      return ();
+    }
+    $index = substr($rpm->[0], 16, $cnt * 16);
+    $data = substr($rpm->[0], 16 + $cnt * 16, $cntdata);
+  } else {
+    if (ref($rpm) eq 'GLOB') {
+      *RPM = *$rpm;
+    } elsif (!open(RPM, '<', $rpm)) {
+      warn("$rpm: $!\n");
+      return ();
+    }
+    if (read(RPM, $lead, 96) != 96) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+    ($magic, $sigtype) = unpack('N@78n', $lead);
+    if ($magic != 0xedabeedb || $sigtype != 5) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+    if (read(RPM, $head, 16) != 16) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
+    if ($headmagic != 0x8eade801) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+    if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+    $cntdata = ($cntdata + 7) & ~7;
+    if (read(RPM, $data, $cntdata) != $cntdata) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+  }
+
+  my %res = ();
+  if (@sigtags && !$dosigs) {
+    %res = &rpmq(["$head$index$data"], @sigtags);
+  }
+  if (ref($rpm) eq 'ARRAY' && !$dosigs && @stags && @$rpm > 1) {
+    my %res2 = &rpmq([ $rpm->[1] ], @stags);
+    %res = (%res, %res2);
+    return %res;
+  }
+  if (ref($rpm) ne 'ARRAY' && !$dosigs && @stags) {
+    if (read(RPM, $head, 16) != 16) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
+    if ($headmagic != 0x8eade801) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+    if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+    if (read(RPM, $data, $cntdata) != $cntdata) {
+      warn("Bad rpm $rpm\n");
+      close RPM unless ref($rpm);
+      return ();
+    }
+  }
+  close RPM unless ref($rpm);
+
+  return %res unless @stags;
+
+  while($cnt-- > 0) {
+    ($tag, $type, $offset, $count, $index) = unpack('N4a*', $index);
+    $tag = 0+$tag;
+    if ($stags{$tag}) {
+      eval {
+        my $otag = $stags{$tag};
+        if ($type == 0) {
+          $res{$otag} = [ '' ];
+        } elsif ($type == 1) {
+          $res{$otag} = [ unpack("\@${offset}c$count", $data) ];
+        } elsif ($type == 2) {
+          $res{$otag} = [ unpack("\@${offset}c$count", $data) ];
+        } elsif ($type == 3) {
+          $res{$otag} = [ unpack("\@${offset}n$count", $data) ];
+        } elsif ($type == 4) {
+          $res{$otag} = [ unpack("\@${offset}N$count", $data) ];
+        } elsif ($type == 5) {
+          $res{$otag} = [ undef ];
+        } elsif ($type == 6) {
+          $res{$otag} = [ unpack("\@${offset}Z*", $data) ];
+        } elsif ($type == 7) {
+          $res{$otag} = [ unpack("\@${offset}a$count", $data) ];
+        } elsif ($type == 8 || $type == 9) {
+          my $d = unpack("\@${offset}a*", $data);
+          my @res = split("\0", $d, $count + 1);
+          $res{$otag} = [ splice @res, 0, $count ];
+        } else {
+          $res{$otag} = [ undef ];
+        }
+      };
+      if ($@) {
+        warn("Bad rpm $rpm: $@\n");
+        return ();
+      }
+    }
+  }
+
+  if ($need_filenames) {
+    if ($res{'OLDFILENAMES'}) {
+      $res{'FILENAMES'} = [ @{$res{'OLDFILENAMES'}} ];
+    } else {
+      my $i = 0;
+      $res{'FILENAMES'} = [ map {"$res{'DIRNAMES'}->[$res{'DIRINDEXES'}->[$i++]]$_"} @{$res{'BASENAMES'}} ];
+    }
+  }
+
+  return %res;
+}
+
+sub rpmq_add_flagsvers {
+  my $res = shift;
+  my $name = shift;
+  my $flags = shift;
+  my $vers = shift;
+
+  return unless $res;
+  my @flags = @{$res->{$flags} || []};
+  my @vers = @{$res->{$vers} || []};
+  for (@{$res->{$name}}) {
+    if (@flags && ($flags[0] & 0xe) && @vers) {
+      $_ .= ' ';
+      $_ .= '<' if $flags[0] & 2;
+      $_ .= '>' if $flags[0] & 4;
+      $_ .= '=' if $flags[0] & 8;
+      $_ .= " $vers[0]";
+    }
+    shift @flags;
+    shift @vers;
+  }
+}
+
+sub verscmp_part {
+  my ($s1, $s2) = @_;
+  if (!defined($s1)) {
+    return defined($s2) ? -1 : 0;
+  }
+  return 1 if !defined $s2;
+  return 0 if $s1 eq $s2;
+  while (1) {
+    $s1 =~ s/^[^a-zA-Z0-9]+//;
+    $s2 =~ s/^[^a-zA-Z0-9]+//;
+    my ($x1, $x2, $r);
+    if ($s1 =~ /^([0-9]+)(.*?)$/) {
+      $x1 = $1;
+      $s1 = $2;
+      $s2 =~ /^([0-9]*)(.*?)$/;
+      $x2 = $1;
+      $s2 = $2;
+      return 1 if $x2 eq '';
+      $x1 =~ s/^0+//;
+      $x2 =~ s/^0+//;
+      $r = length($x1) - length($x2) || $x1 cmp $x2;
+    } elsif ($s1 ne '' && $s2 ne '') {
+      $s1 =~ /^([a-zA-Z]*)(.*?)$/;
+      $x1 = $1;
+      $s1 = $2;
+      $s2 =~ /^([a-zA-Z]*)(.*?)$/;
+      $x2 = $1;
+      $s2 = $2;
+      return -1 if $x1 eq '' || $x2 eq '';
+      $r = $x1 cmp $x2;
+    }
+    return $r if $r;
+    if ($s1 eq '') {
+      return $s2 eq '' ? 0 : -1;
+    }
+    return 1 if $s2 eq ''
+  }
+}
+
+sub verscmp {
+  my ($s1, $s2) = @_;
+
+  return 0 if $s1 eq $s2;
+  my ($e1, $v1, $r1) = $s1 =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
+  $e1 = 0 unless defined $e1;
+  $r1 = '' unless defined $r1;
+  my ($e2, $v2, $r2) = $s2 =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
+  $e2 = 0 unless defined $e2;
+  $r2 = '' unless defined $r2;
+  if ($e1 ne $e2) {
+    my $r = verscmp_part($e1, $e2);
+    return $r if $r;
+  }
+  if ($v1 ne $v2) {
+    my $r = verscmp_part($v1, $v2);
+    return $r if $r;
+  }
+  if ($r1 ne $r2) {
+    return verscmp_part($r1, $r2);
+  }
+  return 0;
+}
+
+sub query {
+  my ($handle, $withevra) = @_;
+
+  my %res = rpmq($handle, qw{NAME SOURCERPM NOSOURCE NOPATCH SIGTAG_MD5 PROVIDENAME PROVIDEFLAGS PROVIDEVERSION REQUIRENAME REQUIREFLAGS REQUIREVERSION}, ($withevra ? qw{EPOCH VERSION RELEASE ARCH}: ()));
+  return undef unless %res;
+  my $src = $res{'SOURCERPM'}->[0];
+  $src = '' unless defined $src;
+  $src =~ s/-[^-]*-[^-]*\.[^\.]*\.rpm//;
+  my $data = {
+    name => $res{'NAME'}->[0],
+    hdrmd5 => unpack('H32', $res{'SIGTAG_MD5'}->[0]),
+    provides => [ grep {!/^rpmlib\(/ && !/^\//} @{$res{'PROVIDENAME'} || []} ],
+    requires => [ grep {!/^rpmlib\(/ && !/^\//} @{$res{'REQUIRENAME'} || []} ],
+  };
+  $data->{'source'} = $src if $src ne '';
+  if ($withevra) {
+    my $arch = $res{'ARCH'}->[0];
+    $arch = $res{'NOSOURCE'} || $res{'NOPATCH'} ? 'nosrc' : 'src' unless $src ne '';
+    $data->{'version'} = $res{'VERSION'}->[0];
+    $data->{'release'} = $res{'RELEASE'}->[0];
+    $data->{'arch'} = $arch;
+    $data->{'epoch'} = $res{'EPOCH'}->[0] if exists $res{'EPOCH'};
+  }
+  return $data;
+}
+
+sub queryhdrmd5 {
+  my ($bin) = @_;
+
+  local *F;
+  open(F, '<', $bin) || die("$bin: $!\n");
+  my $buf = '';
+  my $l;  
+  while (length($buf) < 96 + 16) { 
+    $l = sysread(F, $buf, 4096, length($buf));
+    if (!$l) {
+      warn("$bin: read error\n");
+      close(F);
+      return undef;
+    }
+  }
+  my ($magic, $sigtype) = unpack('N@78n', $buf);
+  if ($magic != 0xedabeedb || $sigtype != 5) {
+    warn("$bin: not a rpm (bad magic of header type)\n");
+    close(F);
+    return undef;
+  }
+  my ($headmagic, $cnt, $cntdata) = unpack('@96N@104NN', $buf);
+  if ($headmagic != 0x8eade801) {
+    warn("$bin: not a rpm (bad sig header magic)\n");
+    close(F);
+    return undef;
+  }
+  my $hlen = 96 + 16 + $cnt * 16 + $cntdata;
+  $hlen = ($hlen + 7) & ~7;
+  while (length($buf) < $hlen) {
+    $l = sysread(F, $buf, 4096, length($buf));
+    if (!$l) {
+      warn("$bin: read error\n");
+      close(F);
+      return undef;
+    }
+  }
+  close F;
+  my $idxarea = substr($buf, 96 + 16, $cnt * 16);
+  if ($idxarea !~ /\A(?:.{16})*\000\000\003\354\000\000\000\007(....)\000\000\000\020/s) {
+    warn("$bin: no md5 signature header\n");
+    return undef;
+  }
+  my $md5off = unpack('N', $1);
+  if ($md5off >= $cntdata) {
+    warn("$bin: bad md5 offset\n");
+    return undef;
+  }
+  $md5off += 96 + 16 + $cnt * 16;
+  return unpack("\@${md5off}H32", $buf);
+}
+
+1;
diff --git a/build b/build
index f2ec48d..b80f8ad 100755 (executable)
--- a/build
+++ b/build
@@ -354,8 +354,8 @@ if test -n "$KILL" ; then
     else
        XENID="${XENIMAGE%/root}"
        XENID="${XENID##*/}"
-       if xm list "$XENID" >/dev/null 2>&1 ; then
-           if ! xm destroy "$XENID" ; then
+       if xm list "build:$XENID" >/dev/null 2>&1 ; then
+           if ! xm destroy "build:$XENID" ; then
                echo "could not kill xen build $XENID"
                exit 1
            fi
index 84348d5..81787a4 100755 (executable)
@@ -153,10 +153,10 @@ while ($redo) {
     for my $known (@todo) {
       my $path = $known2path{$known};
       if ($path =~ /\.rpm$/) {
-        my %res = Build::rpmq($path, 1000, 1022, 1047, 1049, 1048, 1050, 1112, 1113);
+        my %res = Build::Rpm::rpmq($path, 1000, 1022, 1047, 1049, 1048, 1050, 1112, 1113);
         next unless %res;
-        Build::rpmq_add_flagsvers(\%res, 1047, 1112, 1113);
-        Build::rpmq_add_flagsvers(\%res, 1049, 1048, 1050);
+        Build::Rpm::rpmq_add_flagsvers(\%res, 1047, 1112, 1113);
+        Build::Rpm::rpmq_add_flagsvers(\%res, 1049, 1048, 1050);
         my $id = $known;
         $id =~ s/.*-//;
         if ($known ne "$res{1000}->[0].$res{1022}->[0]-$id") {
@@ -169,7 +169,7 @@ while ($redo) {
         $newp{$known} = "P:$known: ".join(' ', @{$res{1047} || []});
         $newr{$known} = "R:$known: ".join(' ', @{$res{1049} || []});
       } else {
-        my %res = Build::debq($path);
+        my %res = Build::Deb::debq($path);
         next unless %res;
        my ($dn, $da) = ($res{'PACKAGE'}, $res{'ARCHITECTURE'});
        $da = 'noarch' if $da eq 'all';
diff --git a/debsort b/debsort
index 26cfe33..656681e 100755 (executable)
--- a/debsort
+++ b/debsort
@@ -79,7 +79,7 @@ sub sortpacks {
         unshift @cyc, $v;
         last if $v eq $cycv;
       }
-      unshift @todo, 
+      unshift @todo, $cycv;
       print STDERR "cycle: ".join(' -> ', @cyc)."\n";
       my $breakv;
       if ($buildp) {
@@ -93,8 +93,10 @@ sub sortpacks {
       }
       push @cyc, $cyc[0];
       shift @cyc while $cyc[0] ne $breakv;
-      print STDERR "  breaking with $breakv -> $cyc[1]\n";
-      $deps{$breakv} = [ grep {$_ ne $cyc[1]} @{$deps{$breakv}} ];
+      $v = $cyc[1];
+      print STDERR "  breaking with $breakv -> $v\n";
+      $deps{$breakv} = [ grep {$_ ne $v} @{$deps{$breakv}} ];
+      $rdeps{$v} = [ grep {$_ ne $breakv} @{$rdeps{$v}} ];
       $needed{$breakv}--;
     }
   }
@@ -106,7 +108,7 @@ sub orderdeb {
   my %prov;
   my %req;
   for my $deb (@debs) {
-    my %q = Build::debq("$cachedir/$deb.deb");
+    my %q = Build::Deb::debq("$cachedir/$deb.deb");
     if (!%q) {
       $req{$deb} = [];
       push @{$prov{$deb}}, $deb;
index e7518fe..e082576 100755 (executable)
@@ -153,12 +153,7 @@ my ($packname, $packvers, $subpacks, @packdeps);
 $subpacks = [];
 
 if ($spec) {
-  my $d;
-  if ($spec =~ /\.dsc$/) {
-    $d = Build::read_dsc($cf, $spec);
-  } else {
-    $d = Build::read_spec($cf, $spec);
-  }
+  my $d = Build::parse($cf, $spec);
   $packname = $d->{'name'};
   $packvers = $d->{'version'};
   $subpacks = $d->{'subpacks'};
@@ -195,7 +190,7 @@ for my $pack (keys %packs) {
   $r->{'requires'} = \@re;
   $repo{$pack} = $r;
 }
-Build::readrpmdeps($cf, undef, \%repo);
+Build::readdeps($cf, undef, \%repo);
 
 #######################################################################
 
index 2a19ec7..0585a36 100755 (executable)
@@ -24,7 +24,9 @@ USE_FORCE=false
 
 BUILD_IS_RUNNING=$BUILD_ROOT/not-ready
 TMPFILE=$BUILD_ROOT/tmpfile
-RPMIDFMT="%{NAME}-%{VERSION}-%{RELEASE} %{BUILDHOST}-%{BUILDTIME}\n"
+#buildhost removed so that id can be generated from repo files
+#RPMIDFMT="%{NAME}-%{VERSION}-%{RELEASE} %{BUILDHOST}-%{BUILDTIME}\n"
+RPMIDFMT="%{NAME}-%{VERSION}-%{RELEASE} %{BUILDTIME}\n"
 
 PREPARE_XEN=
 USEUSEDFORBUILD=
@@ -257,6 +259,9 @@ fi
 mkdir -p $BUILD_ROOT
 touch $BUILD_IS_RUNNING
 
+if test -n "$PREPARE_XEN" ; then
+    rm -f $BUILD_ROOT/.build/init_buildsystem.data
+fi
 if test -e $BUILD_ROOT/.build/init_buildsystem.data ; then
     # xen continuation
     . $BUILD_ROOT/.build/init_buildsystem.data
@@ -297,6 +302,7 @@ else
           test "$PKG" = "preinstall:" && continue
           test "$PKG" = "runscripts:" && continue
           test "$PKG" = "dist:" && continue
+          test "$PKG" = "rpmid:" && continue
           echo "${SRC##*/}"
        done < $BUILD_ROOT/.init_b_cache/rpmlist
        rm -rf $BUILD_ROOT/.init_b_cache
@@ -323,6 +329,10 @@ else
            GUESSED_DIST=$SRC
            continue
        fi
+       if test "$PKG" = "rpmid:" ; then
+           echo "${SRC#*:}" > $BUILD_ROOT/.init_b_cache/rpm/${SRC%%:*}.id
+           continue
+       fi
        ln -s "$SRC" "$BUILD_ROOT/.init_b_cache/rpms/$PKG.${SRC##*.}"
        PACKAGES_TO_INSTALL="$PACKAGES_TO_INSTALL $PKG"
     done < $RPMLIST
@@ -486,11 +496,22 @@ for PKG in $PACKAGES_TO_INSTALL_FIRST RUN_LDCONFIG $PACKAGES_TO_INSTALL ; do
 
     test -L $BUILD_ROOT/.init_b_cache/rpms/$PKG.rpm || continue
 
+    if test -f $BUILD_ROOT/.init_b_cache/rpms/$PKG.id -a -f $BUILD_ROOT/.init_b_cache/alreadyinstalled/$PKG ; then
+        read PKGID < $BUILD_ROOT/.init_b_cache/rpms/$PKG.id
+       read OLDPKGID < $BUILD_ROOT/.init_b_cache/alreadyinstalled/$PKG
+       if test "$PKGID" = "$OLDPKGID" ; then
+           echo "keeping ${PKGID%% *}"
+           echo "$PKGID" > $BUILD_ROOT/installed-pkg/$PKG
+           continue
+       fi
+    fi
+
     PKGID=`rpm -qp --qf "$RPMIDFMT" $RPMCHECKOPTS_HOST $BUILD_ROOT/.init_b_cache/rpms/$PKG.rpm`
 
     if test -f $BUILD_ROOT/.init_b_cache/alreadyinstalled/$PKG ; then
-       if test "$PKGID" != "`cat $BUILD_ROOT/.init_b_cache/alreadyinstalled/$PKG`" ; then
-           echo deleting unwanted `sed -e 's/ .*//' < $BUILD_ROOT/.init_b_cache/alreadyinstalled/$PKG`
+       read OLDPKGID < $BUILD_ROOT/.init_b_cache/alreadyinstalled/$PKG
+       if test "$PKGID" != "$OLDPKGID" ; then
+           echo deleting unwanted ${OLDPKGID%% *}
            chroot $BUILD_ROOT rpm --nodeps -e $PKG 2>&1 | \
                grep -v -e "^r.*failed: No such file or directory" -e "^error: failed to stat .*: No such file or directory"
        elif test "$VERIFY_BUILD_SYSTEM" = true ; then
@@ -523,6 +544,7 @@ for PKG in $PACKAGES_TO_INSTALL_FIRST RUN_LDCONFIG $PACKAGES_TO_INSTALL ; do
                $ADDITIONAL_PARAMS .init_b_cache/$PKG.rpm 2>&1 || \
          touch $BUILD_ROOT/exit ) | \
              grep -v "^warning:.*saved as.*rpmorig$"
+    # delete link so package is only installed once
     rm -f $BUILD_ROOT/.init_b_cache/$PKG.rpm
     test -e $BUILD_ROOT/exit && cleanup_and_exit 1
     echo "$PKGID" > $BUILD_ROOT/installed-pkg/$PKG
@@ -651,7 +673,7 @@ fi
 
 HOST=`hostname`
 test -e $BUILD_ROOT/etc/hosts || echo "127.0.0.1 localhost" > $BUILD_ROOT/etc/hosts
-if ! grep -F "127.0.0.1 $HOST" $BUILD_ROOT/etc/hosts ; then
+if ! grep -F "127.0.0.1 $HOST" $BUILD_ROOT/etc/hosts > /dev/null ; then
     # this makes a reverse lookup on 127.0.0.1 return the host name,
     # which is bad, but 127.0.0.2 does not work on all unix systems
     echo "127.0.0.1 $HOST" > $BUILD_ROOT/etc/hosts.new
index 8093d12..02993b8 100755 (executable)
@@ -47,7 +47,7 @@ my $cf = Build::read_config_dist($dist, $archs, $configdir);
 #######################################################################
 
 my $xspec = [];
-my $d = Build::read_spec($cf, $spec, $xspec) || {};
+my $d = Build::parse($cf, $spec, $xspec) || {};
 my @sdeps = @{$d->{'deps'} || []};
 my @neg = map {substr($_, 1)} grep {/^-/} @{$d->{'deps'} || []};
 my %neg = map {$_ => 1} @neg;