mkdrpms

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