[build] copy qemus from server not for local build
[opensuse:build.git] / 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;