source: soft/build_system/build_system/upload/robot/trunk/bm-check-submit @ 1

Last change on this file since 1 was 1, checked in by fasma, 13 years ago

Initial Import from Mandriva's soft revision 224062 and package revision 45733

File size: 9.0 KB
RevLine 
[1]1#!/usr/bin/perl
2
3use MDK::Common;
4use POSIX;
5
6$ENV{LC_ALL} = "C";
7
8my $rpm = "rpm --nosignature";
9my $rpmdir  = chomp_(`rpm --eval '%_topdir'`);
10my $tmppath = chomp_(`rpm --eval '%_tmppath'`);
11
12s|/$|| foreach $rpmdir, $tmppath;
13
14
15if ($0 =~ /isrpms/i) {
16    @ARGV == 1 or die "isrpms <package name>\n";
17    my $srpm = previous_pkg('SRPMS', $ARGV[0]);
18    print "installing $srpm\n";
19    system("rpm -i $srpm");
20    my $name = pkg_info($srpm)->{name};
21    chdir "$rpmdir/SPECS";
22    -e "$name.spec" or die "bad spec file name, missing $name.spec\n";
23    system("emacsclient --no-wait $name.spec 2>/dev/null");
24    exit 0;
25} elsif ($0 =~ /compare/i) {
26    @ARGV or die "Compare_package_files <rpm file>\n";
27    foreach (@ARGV) {
28        my $info = pkg_info($_);
29        my $previous = pkg_info(previous_pkg('RPMS', $info->{name}));
30        compare_package_files($previous, $info);
31        compare_package_requires($previous, $info);
32        compare_package_provides($previous, $info);
33    }
34    exit 0;
35}
36
37-d 'SPECS' or die 'no directory "SPECS"';
38-d '.svn' or die 'no directory ".svn"';
39
40my $short_circuit = $ARGV[0] eq '--short-circuit' && shift(@ARGV);
41my $no_submit = $ARGV[0] eq '--no-submit' && shift(@ARGV);
42
43my $name = basename(chomp_(`pwd`));
44my ($q_spec) = glob_("SPECS/$name*.spec") or die "can't find spec file\n";
45
46!$short_circuit and cleanup();
47
48my $buildlog = "$tmppath/.upload-$name";
49
50$| = 1;
51system("chmod", "644", $q_spec, grep { -f $_ } glob_("SOURCES/*"));
52
53if (system("bm -ls --build-log=$buildlog") != 0) {
54    if (my @deps_needed = cat_($buildlog) =~ /^\s+(\S+)\s+.*is needed by/gm) {
55        system('sudo', 'rurpmi', @deps_needed);
56    }
57    if (my @deps_conflict = cat_($buildlog) =~ /^\s+(\S+)\s+.*conflicts with/gm) {
58        @deps_conflict = map { chomp_(`rpm -q --whatprovides --qf '%{name}\n' $_`) } @deps_conflict;
59        print STDERR "There are conflicting packages.\nRemove packages @deps_conflict (Y/n) ?";
60        <STDIN> !~ /n/i or exit 0;
61
62        system('sudo', 'rurpme', @deps_conflict);
63    }
64    system("bm -ls --build-log=$buildlog") == 0 or die "bm -ls failed\n";
65}
66my $srpm = cat_($buildlog) =~ /^Wrote: (.*)/ && $1;
67
68my $info = pkg_info($srpm);
69my $previous_srpm = eval { previous_pkg('SRPMS', $info->{name}, "$info->{name}-$info->{version}") };
70my $previous = $previous_srpm && pkg_info($previous_srpm);
71
72if ($previous_srpm) {
73    if ($info->{version} eq $previous->{version} && $info->{release} eq $previous->{release}) {
74        my $msg = "package $info->{name} already exists in cooker ($previous_srpm)\n";
75        my $differ = compare_spec_files($previous_srpm, $q_spec);
76        print "*******************************************************************************\n";
77        if ($differ) {
78            die $msg . "spec file has been modified, did you increase the release number?\n";
79        } else {
80            print $msg . "spec file hasn't been modified, no submit will be done\n";
81            print "continue anyway (y/N)? ";
82            <STDIN> =~ /^y/i or exit 1;
83            $no_submit = 1;
84        }
85    } elsif ($previous_srpm =~ m|mandrake/uploads|) {
86        print "package $info->{name} is already in the upload queue ($previous_srpm)\n";
87        print "continue anyway (y/N)? ";
88        <STDIN> =~ /^y/i or exit 1;
89    }
90}
91
92if ($short_circuit) {
93    print "installing...\n";
94    sys("bm -i --short-circuit --build-log=$buildlog");
95    sys("bm -lb --short-circuit >> $buildlog");
96} else {
97    print "building...\n";
98    sys("bm -b $q_spec --build-log=$buildlog");
99}
100my @rpms = map { pkg_info($_) } map { if_(/^Wrote: (.*)/, $1) } cat_($buildlog);
101
102if ($previous_srpm) {
103    compare_package_files($previous, @rpms);
104    compare_package_requires($previous, @rpms);
105    compare_package_provides($previous, @rpms);
106    compare_spec_files($previous_srpm, $q_spec);
107}
108
109{
110    my $rpms = join(" ", map { $_->{file} } @rpms);
111    if (my $s = `rpmlint $srpm $rpms`) {
112        print "rpmlint ***********************************************************************\n";
113        print $s;
114    }
115}
116
117if (!$no_submit) {
118    print "*******************************************************************************\n";
119    print "test package" . (@rpms > 1 ? 's' : '') . ' ' . join(', ', map { "$_->{name}-$_->{version}-$_->{release}" } @rpms) . "\n";
120    print "then press <enter> to commit & submit (or <ctrl-C> to abort)\n";
121    <STDIN>;
122
123    sys('mdvsys sync');
124    sys('svn commit');
125    sys("mdvsys", "submit", $name);
126
127    cleanup();
128}
129
130sub cleanup() {
131    rm_rf($_) foreach grep { -d $_ } 'BUILD', 'BUILDROOT', 'SRPMS', 'RPMS';
132}
133
134sub pkg_info {
135    my ($srpm) = @_;
136    my ($name, $version, $release) = split ' ', `$rpm -qp --qf '%{name} %{version} %{release}' $srpm`;
137    (my $rpmdir = dirname($srpm)) =~ s/SRPMS/media/;
138    { name => $name, version => $version, release => $release, rpmdir => $rpmdir, file => $srpm };
139}
140
141sub previous_pkg {
142    my ($rpm_or_srpm, $name, $o_q_name) = @_;
143    my @dirs = (
144                (map { "$_$rpm_or_srpm" } qw(/home/mandrake/uploads/cooker/ /home/mandrake/uploads/contrib/)),
145                $rpm_or_srpm eq 'SRPMS' ? qw(/SRPMS/main/release /SRPMS/contrib/release) : qw(/media/main/release /media/contrib/release /media/debug_main /media/debug_contrib)
146               );
147    foreach (if_($o_q_name, @dirs)) {
148        my @l = glob("$_/$o_q_name-*.rpm") or next;
149        return keep_the_one($name, @l);
150    }
151    if (my @l = (map { glob("$_/$name-*.rpm") } @dirs)) {
152        return keep_the_one($name, @l);
153    }
154    die "no existing package named $name\n";
155}
156
157sub keep_the_one {
158    my ($name, @l) = @_;
159
160    @l = grep { `$rpm -qp --queryformat "%{name}" $_` eq $name } @l if @l > 1;
161
162    if (@l == 1) {
163        return $l[0];
164    } elsif (@l) {
165        die "more than one package is named $name: " . join(" ", @l) . "\n";
166    } else {
167        die "no existing package named $name\n";
168    }
169}
170
171sub rpmdir_maybe_debug {
172    my ($rpm_info, $previous) = @_;
173    my $dir = $previous->{rpmdir};
174    $rpm_info->{name} =~ /-debug/ and $dir =~ s!/((?:main|contrib)(?:/|$))!/debug_$1!;
175    $dir;
176}
177
178sub compare_one_package_files {
179    my ($rpm_info, $previous_rpm) = @_;
180
181    my @new = `$rpm -qpl $rpm_info->{file}`;
182    my @old = map { moved_files($_) } `$rpm -qpl $previous_rpm`;
183
184    compare_lists('files', $rpm_info, \@new, \@old);
185
186    check_bad_files($_) foreach @new;
187}
188
189sub compare_package_files {
190    my ($previous, @rpms) = @_;
191
192    foreach my $rpm_info (@rpms) {
193        my $previous_rpm = rpmdir_maybe_debug($rpm_info, $previous) . "/$rpm_info->{name}-$previous->{version}-$previous->{release}*.rpm";
194        compare_one_package_files($rpm_info, $previous_rpm);
195    }
196}
197
198sub compare_package_requires {
199    my ($previous, @rpms) = @_;
200
201    foreach my $rpm_info (@rpms) {
202        my $previous_rpm = rpmdir_maybe_debug($rpm_info, $previous) . "/$rpm_info->{name}-$previous->{version}-$previous->{release}*.rpm";
203
204        my $non_interesting_requires = sub {
205            /^\Qld-linux.so.2/;
206        };
207        my @new = grep { !$non_interesting_requires->() } `$rpm -qp --requires $rpm_info->{file}`;
208        my @old = grep { !$non_interesting_requires->() } `$rpm -qp --requires $previous_rpm`;
209        compare_lists('requires', $rpm_info, \@new, \@old);
210    }
211}
212
213sub compare_package_provides {
214    my ($previous, @rpms) = @_;
215
216    foreach my $rpm_info (@rpms) {
217        my $previous_rpm = rpmdir_maybe_debug($rpm_info, $previous) . "/$rpm_info->{name}-$previous->{version}-$previous->{release}*.rpm";
218
219        my $non_interesting_provides = sub {
220            /\Q$rpm_info->{name} = /;
221        };
222        my @new = grep { !$non_interesting_provides->() } `$rpm -qp --provides $rpm_info->{file}`;
223        my @old = grep { !$non_interesting_provides->() } `$rpm -qp --provides $previous_rpm`;
224        compare_lists('provides', $rpm_info, \@new, \@old);
225    }
226}
227
228sub compare_spec_files {
229    my ($previous, $q_spec) = @_;
230    my $spec = basename($q_spec);
231    system("rpm2cpio $previous | (cd $tmppath ; cpio --quiet -i $spec)");
232    system(q(perl -p0i -e 's/\n+%changelog\s*\n.*/\n/s') . " $tmppath/$spec");
233    print "compare spec files ************************************************************\n";
234    system("diff -u $tmppath/$spec $q_spec");
235    my $ret = $?;
236    unlink "$tmppath/$spec";
237    $ret; #- 0 if identical
238}
239
240my %banner_displayed;
241sub compare_lists {
242    my ($name, $rpm_info, $new, $old) = @_;
243
244    $new = join('', sort @$new);
245    $old = join('', sort @$old);
246
247    $new ne $old or return 1;
248
249    my $olddir = POSIX::getcwd();
250    chdir $rpmdir;
251    output("$rpm_info->{name}--$name.new", $new);
252    output("$rpm_info->{name}--$name.old", $old);
253    print "compare package $name *********************************************************\n" if !$banner_displayed{$name}++;
254    system("diff -u $rpm_info->{name}--$name.old $rpm_info->{name}--$name.new");
255    unlink "$rpm_info->{name}--$name.old", "$rpm_info->{name}--$name.new";
256    chdir $olddir;
257    0;
258}
259
260sub moved_files {
261    local ($_) = @_;
262    s|site_perl|vendor_perl|;
263    s|\Q5.6.1|5.8.2|;
264    s|\Q5.8.0|5.8.2|;
265    s|\Q5.8.1|5.8.2|;
266    s|\Q5.8.2|5.8.3|;
267    s|python2.2|python2.3|;
268    s|/man3pm/|/man3/|;
269    s|/i386-linux-thread-multi/|/i386-linux/|;
270    s!/22.0.50/!/22.0.90/!;
271    $_;
272}
273
274sub check_bad_files {
275    local ($_) = @_;
276    my $ok = 1;
277    chomp;
278    m|/site_perl/| and warn("ERROR: bad file $_\n"), $ok = 0;
279    $ok;
280}
281
282sub system_verbose { print join(' ', @_), "\n"; system(@_) }
283sub sys { &system_verbose; $? and die }
Note: See TracBrowser for help on using the repository browser.