mkdrpms

   1 #!/usr/bin/perl -w
   2
   3 ################################################################
   4 #
   5 # Copyright (c) 1995-2014 SUSE Linux Products GmbH
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License version 2 or 3 as
   9 # published by the Free Software Foundation.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program (see the file COPYING); if not, write to the
  18 # Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
  20 #
  21 ################################################################
  22
  23 BEGIN {
  24   unshift @INC, '/usr/lib/build';
  25   unshift @INC, $::ENV{'BUILD_DIR'} if $::ENV{'BUILD_DIR'};
  26 }
  27
  28 use Build;
  29 use strict;
  30
  31 my $limit = 80; # throw away deltas bigger than this percentage of the reference
  32 my %oldpkgs;
  33
  34 sub query {
  35     my ($file) = @_;
  36
  37     return undef if $file =~ /\.(?:patch|delta)\.rpm$/; # XXX: rpmtags?
  38     my %res = Build::Rpm::rpmq($file, qw/NAME EPOCH VERSION RELEASE ARCH SOURCERPM NOSOURCE NOPATCH 1124/);
  39     return undef unless %res;
  40     return undef if $res{'1124'}->[0] && $res{'1124'}->[0] eq 'drpm';
  41     my $arch;
  42     if ($res{'SOURCERPM'}->[0]) {
  43         $arch = $res{'ARCH'}->[0];
  44     } else {
  45         # no src rpm deltas for now
  46 #       if ($res{'NOSOURCE'}->[0] || $res{'NOPATCH'}->[0]) {
  47 #           $arch = 'nosrc';
  48 #       } else {
  49 #           $arch = 'src';
  50 #       }
  51         return undef;
  52     }
  53     return { file => $file, name => $res{'NAME'}->[0], epoch => $res{'EPOCH'} ? $res{'EPOCH'}->[0] : '', version => $res{'VERSION'}->[0], release => $res{'RELEASE'}->[0], arch => $arch};
  54 }
  55
  56 sub lsrpms {
  57     local *D;
  58     if (-f "$_[0]") {
  59       return ($_[0]) if $_[0] =~ /\.rpm$/;
  60       return ();
  61     }
  62     opendir(D, $_[0]) || return ();
  63     my @r = grep {$_ ne '.' && $_ ne '..'} readdir(D);
  64     closedir D;
  65     return map {"$_[0]/$_"} grep {/\.rpm$/} sort(@r);
  66 }
  67
  68 while (@ARGV) {
  69     if ($ARGV[0] eq '--limit') {
  70         shift @ARGV;
  71         die("--limit needs an argument\n") unless @ARGV;
  72         $limit = shift @ARGV;
  73         next;
  74     }
  75     last;
  76 }
  77
  78 my $prevbuild = shift @ARGV || die "USAGE: $0 <oldpkgdir> <directories...>";
  79 my @prevbuild = ($prevbuild);
  80 my $i = 1;
  81 while (-d $prevbuild.$i) {
  82     push @prevbuild, $prevbuild.$i;
  83     ++$i;
  84 }
  85 for my $dir (@prevbuild) {
  86     for my $file (lsrpms($dir)) {
  87         my $q = query($file);
  88         next unless $q;
  89         my $n = $q->{'name'}.'.'.$q->{'arch'};
  90         push @{$oldpkgs{$n}}, $q;
  91     }
  92 }
  93
  94 my $sysret = 0;
  95 for my $dir (@ARGV) {
  96     for my $file (lsrpms($dir)) {
  97         my $q = query($file);
  98         next unless $q;
  99         my $n = $q->{'name'}.'.'.$q->{'arch'};
 100         for my $oq (@{$oldpkgs{$n} || []}) {
 101             my $v = $oq->{'version'};
 102             my $r = $oq->{'release'};
 103             if ($v eq $q->{'version'} && $r eq $q->{'release'}) {
 104                 # skip if same version and release
 105                 next;
 106             }
 107             $v .= '_'.$q->{'version'} unless $v eq $q->{'version'};
 108             $r .= '_'.$q->{'release'} unless $r eq $q->{'release'};
 109             my $dn = sprintf("%s-%s-%s.%s.drpm", $q->{'name'}, $v, $r, $q->{'arch'});
 110             my $sn = sprintf("%s-%s-%s.%s.dseq", $q->{'name'}, $v, $r, $q->{'arch'});
 111             print "$dn ... ";
 112             my $dndir = $q->{'file'};
 113             $dndir =~ s/[^\/]+$//s;
 114             $dn = "$dndir$dn";
 115             my $ret = system('makedeltarpm', '-s', $sn, $oq->{'file'}, $q->{'file'}, $dn);
 116             if ($ret || ! -e $dn) {
 117                 unlink($dn);
 118                 unlink($sn);
 119                 print "FAILED\n";
 120                 $sysret = 1;
 121             } else {
 122                 my $ns = (stat($dn))[7] || 1;
 123                 my $os = (stat($q->{'file'}))[7] || 1;
 124                 my $factor = int($ns / $os * 100);
 125                 if ($factor > $limit) {
 126                     print "too big ($factor%), removed\n";
 127                     unlink($dn);
 128                     unlink($sn);
 129                 } else {
 130                     local *F;
 131                     my $seq = '';
 132                     if (!open(F, '<', $sn)) {
 133                         print "missing sequence file, removed\n";
 134                         unlink($dn);
 135                         unlink($sn);
 136                         next;
 137                     }
 138                     1 while sysread(F, $seq, 8192, length($seq));
 139                     close F;
 140                     chomp $seq;
 141                     unlink($sn);
 142                     $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";
 143                     if (!open(F, '>', $sn) || syswrite(F, $seq) != length($seq) || !close(F)) {
 144                         print "sequence file write error, removed\n";
 145                         unlink($dn);
 146                         unlink($sn);
 147                         next;
 148                     }
 149                     print "ok ($factor%)\n";
 150                 }
 151             }
 152         }
 153     }
 154 }
 155
 156 exit $sysret;