mkdrpms

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
   5 }
   6
   7 use Build;
   8 use strict;
   9
  10 my $limit = 80; # throw away deltas bigger than this percentage of the reference
  11 my %oldpkgs;
  12
  13 sub query {
  14     my ($file) = @_;
  15
  16     return undef if $file =~ /\.(?:patch|delta)\.rpm$/; # XXX: rpmtags?
  17     my %res = Build::Rpm::rpmq($file, qw/NAME EPOCH VERSION RELEASE ARCH SOURCERPM NOSOURCE NOPATCH 1124/);
  18     return undef unless %res;
  19     return undef if $res{'1124'}->[0] && $res{'1124'}->[0] eq 'drpm';
  20     my $arch;
  21     if ($res{'SOURCERPM'}->[0]) {
  22         $arch = $res{'ARCH'}->[0];
  23     } else {
  24         # no src rpm deltas for now
  25 #       if ($res{'NOSOURCE'}->[0] || $res{'NOPATCH'}->[0]) {
  26 #           $arch = 'nosrc';
  27 #       } else {
  28 #           $arch = 'src';
  29 #       }
  30         return undef;
  31     }
  32     return { file => $file, name => $res{'NAME'}->[0], epoch => $res{'EPOCH'} ? $res{'EPOCH'}->[0] : '', version => $res{'VERSION'}->[0], release => $res{'RELEASE'}->[0], arch => $arch};
  33 }
  34
  35 sub lsrpms {
  36     local *D;
  37     if (-f "$_[0]") {
  38       return ($_[0]) if $_[0] =~ /\.rpm$/;
  39       return ();
  40     }
  41     opendir(D, $_[0]) || return ();
  42     my @r = grep {$_ ne '.' && $_ ne '..'} readdir(D);
  43     closedir D;
  44     return map {"$_[0]/$_"} grep {/\.rpm$/} sort(@r);
  45 }
  46
  47 while (@ARGV) {
  48     if ($ARGV[0] eq '--limit') {
  49         shift @ARGV;
  50         die("--limit needs an argument\n") unless @ARGV;
  51         $limit = shift @ARGV;
  52         next;
  53     }
  54     last;
  55 }
  56
  57 my $prevbuild = shift @ARGV || die "USAGE: $0 <oldpkgdir> <directories...>";
  58 my @prevbuild = ($prevbuild);
  59 my $i = 1;
  60 while (-d $prevbuild.$i) {
  61     push @prevbuild, $prevbuild.$i;
  62     ++$i;
  63 }
  64 for my $dir (@prevbuild) {
  65     for my $file (lsrpms($dir)) {
  66         my $q = query($file);
  67         next unless $q;
  68         my $n = $q->{'name'}.'.'.$q->{'arch'};
  69         push @{$oldpkgs{$n}}, $q;
  70     }
  71 }
  72
  73 my $sysret = 0;
  74 for my $dir (@ARGV) {
  75     for my $file (lsrpms($dir)) {
  76         my $q = query($file);
  77         next unless $q;
  78         my $n = $q->{'name'}.'.'.$q->{'arch'};
  79         for my $oq (@{$oldpkgs{$n} || []}) {
  80             my $v = $oq->{'version'};
  81             my $r = $oq->{'release'};
  82             if ($v eq $q->{'version'} && $r eq $q->{'release'}) {
  83                 # skip if same version and release
  84                 next;
  85             }
  86             $v .= '_'.$q->{'version'} unless $v eq $q->{'version'};
  87             $r .= '_'.$q->{'release'} unless $r eq $q->{'release'};
  88             my $dn = sprintf("%s-%s-%s.%s.drpm", $q->{'name'}, $v, $r, $q->{'arch'});
  89             my $sn = sprintf("%s-%s-%s.%s.dseq", $q->{'name'}, $v, $r, $q->{'arch'});
  90             print "$dn ... ";
  91             my $dndir = $q->{'file'};
  92             $dndir =~ s/[^\/]+$//s;
  93             $dn = "$dndir$dn";
  94             my $ret = system('makedeltarpm', '-s', $sn, $oq->{'file'}, $q->{'file'}, $dn);
  95             if ($ret || ! -e $dn) {
  96                 unlink($dn);
  97                 unlink($sn);
  98                 print "FAILED\n";
  99                 $sysret = 1;
 100             } else {
 101                 my $ns = (stat($dn))[7] || 1;
 102                 my $os = (stat($q->{'file'}))[7] || 1;
 103                 my $factor = int($ns / $os * 100);
 104                 if ($factor > $limit) {
 105                     print "too big ($factor%), removed\n";
 106                     unlink($dn);
 107                     unlink($sn);
 108                 } else {
 109                     local *F;
 110                     my $seq = '';
 111                     if (!open(F, '<', $sn)) {
 112                         print "missing sequence file, removed\n";
 113                         unlink($dn);
 114                         unlink($sn);
 115                         next;
 116                     }
 117                     1 while sysread(F, $seq, 8192, length($seq));
 118                     close F;
 119                     chomp $seq;
 120                     unlink($sn);
 121                     $seq = "Name: $q->{'name'}\nEpoch: $q->{'epoch'}\nVersion: $q->{'version'}\nRelease: $q->{'release'}\nArch: $q->{'arch'}\nOldName: $oq->{'name'}\nOldEpoch: $oq->{'epoch'}\nOldVersion: $oq->{'version'}\nOldRelease: $oq->{'release'}\nOldArch: $oq->{'arch'}\nSeq: $seq\n";
 122                     if (!open(F, '>', $sn) || syswrite(F, $seq) != length($seq) || !close(F)) {
 123                         print "sequence file write error, removed\n";
 124                         unlink($dn);
 125                         unlink($sn);
 126                         next;
 127                     }
 128                     print "ok ($factor%)\n";
 129                 }
 130             }
 131         }
 132     }
 133 }
 134
 135 exit $sysret;