Vincent Danen <[EMAIL PROTECTED]> writes:
> Something like StackGuard+FormatGuard (from Immunix although I think
> they're quite out-dated) would be good (cover buffer overflows and
> format string vulns all at the same time).
the later should be covered if one check compiler output with modern
gcc.
i once again promote pixel "install deps, build it, check it and offer
to upload it" script that filter output and only output stderr thus
highlighting gcc warnings:
#!/usr/bin/perl
use MDK::Common;
use POSIX;
my $rpm = "rpm --nosignature";
my $rpmdir = chomp_(`rpm --eval '%_topdir'`);
my $tmppath = chomp_(`rpm --eval '%_tmppath'`);
s|/$|| foreach $rpmdir, $tmppath;
if ($0 =~ /isrpms/i) {
@ARGV == 1 or die "isrpms <package name>\n";
my $srpm = previous_pkg('SRPMS', $ARGV[0]);
print "installing $srpm\n";
system("rpm -i $srpm");
my $name = pkg_info($srpm)->{name};
chdir "$rpmdir/SPECS";
-e "$name.spec" or die "bad spec file name, missing $name.spec\n";
system("emacsclient --no-wait $name.spec 2>/dev/null");
} elsif ($0 =~ /compare/i) {
@ARGV or die "Compare_package_files <rpm file>\n";
foreach (@ARGV) {
my $info = pkg_info($_);
my $previous = previous_pkg('RPMS', $info->{name});
compare_package_files($info, $previous);
}
} else {
goto upload;
}
exit 0;
upload:
my $short_circuit = $ARGV[0] eq '--short-circuit' && shift(@ARGV);
my ($q_spec) = @ARGV;
if ($q_spec =~ /\.src\.rpm$/) {
system("rpm", "-i", $q_spec) == 0 or die "bad srpm $q_spec\n";
($q_spec) = `$rpm -qpl $q_spec` =~ /(.*)\.spec$/m or internal_error("missing
spec");
}
-e $q_spec or $q_spec = "$rpmdir/SPECS/$q_spec.spec";
-e $q_spec && @ARGV == 1 or die "Upload <spec file>\n";
my $spec = basename($q_spec);
my $buildlog = "$tmppath/.upload-$spec";
$| = 1;
system("chmod", "644", $q_spec, grep { -f $_ } glob_("$rpmdir/SOURCES/*"));
if (system("rpmbuild -bs $q_spec > $buildlog") != 0) {
system("rpmbuild -bs $q_spec > /dev/null 2> $buildlog");
if (my @deps_needed = cat_($buildlog) =~ /^\s+(\S+)\s+.*is needed by/gm) {
foreach (@deps_needed) {
system("sudo ue -u $_");
system("sudo ue -c $_");
}
warn "Waiting for @deps_needed to be installed\n";
sleep 120;
}
if (my @deps_conflict = cat_($buildlog) =~ /^\s+(\S+)\s+.*conflicts with/gm) {
@deps_conflict = map { chomp_(`rpm -q --whatprovides --qf '%{name}\n' $_`) }
@deps_conflict;
print STDERR "There are conflicting packages.\nRemove packages @deps_conflict
(Y/n) ?";
<STDIN> !~ /n/i or exit 0;
system("sudo ue -e $_") foreach @deps_conflict;
warn "Waiting for @deps_conflict to be removed\n";
sleep 120;
}
system("rpmbuild -bs $q_spec > $buildlog") == 0 or die "rpmbuild -bs $spec
failed\n";
}
my ($srpm) = map { if_(/^Wrote: (.*)/, $1) } cat_($buildlog);
my $info = pkg_info($srpm);
my $previous_srpm = eval { previous_pkg('SRPMS', $info->{name},
"$info->{name}-$info->{version}") };
my $previous = $previous_srpm && pkg_info($previous_srpm);
my $cooker_or_contrib;
if ($previous_srpm) {
$info->{version} eq $previous->{version} && $info->{release} eq
$previous->{release}
and die "ERROR: package $info->{name} already exists in cooker
($previous_srpm)\ndid you increase the release number?\n";
if ($previous_srpm =~ m|mandrake/uploads|) {
print "package $info->{name} is already in the upload queue
($previous_srpm)\n";
print "continue anyway (y/N)? ";
<STDIN> =~ /^y/i or exit 1;
}
$cooker_or_contrib = $previous_srpm =~ m|contrib/| ? 'contrib' : 'cooker';
}
while (!$cooker_or_contrib) {
print($previous_srpm ? "Weird, $info->{name} is both in contrib and main" :
"$info->{name} is neither in contrib nor main");
print ", what do you choose (contrib/cooker)? ";
my $r = <STDIN>;
$cooker_or_contrib = 'contrib' if $r =~ /con/i;
$cooker_or_contrib = 'cooker' if $r =~ /coo/i;
$cooker_or_contrib or print qq(Bad answer, please type "cooker" or "contrib"\n");
};
if ($short_circuit) {
print "installing...\n";
system("rpmbuild -bi --short-circuit $q_spec > $buildlog") == 0 or die "rpmbuild
-bi --short-circuit $spec failed\n";
system("rpmbuild -bb --short-circuit $q_spec >> $buildlog") == 0 or die "rpmbuild
-bb --short-circuit $spec failed\n";
} else {
print "building...\n";
system("rpmbuild -bb $q_spec > $buildlog") == 0 or die "rpmbuild -bb $spec
failed\n";
}
my @rpms = map { pkg_info($_) } map { if_(/^Wrote: (.*)/, $1) } cat_($buildlog);
if ($previous_srpm) {
@rpms = compare_package_files($previous, @rpms);
compare_package_requires($previous, @rpms);
compare_package_provides($previous, @rpms);
} else {
if (any { $_->{name} =~ /-debug$/ } @rpms) {
print "Do you want to upload $info->{name}-debug (the debug version) (y/N)? ";
if (<STDIN> !~ /^y/i) {
@rpms = grep { $_->{name} !~ /-debug$/ } @rpms;
}
}
}
{
my $rpms = join(" ", map { $_->{file} } @rpms);
if (my $s = `rpmlint $srpm $rpms`) {
print "rpmlint
***********************************************************************\n";
print $s;
}
}
print
"*******************************************************************************\n";
print "test package" . (@rpms > 1 ? 's' : '') . ' ' . join(', ', map {
"$_->{name}-$_->{release}" } @rpms) . "\n";
print "then press <enter> to upload to $cooker_or_contrib (or <ctrl-C> to abort)\n";
<STDIN>;
print "ftp$cooker_or_contrib...\n";
system("sudo", "ftp$cooker_or_contrib", $srpm, map { $_->{file} } @rpms) == 0 or die
"$cooker_or_contrib failed\n";
system("rpmbuild --clean --rmsource --nodeps $q_spec");
system("rm -f $q_spec $q_spec.old $buildlog");
sub pkg_info {
my ($srpm) = @_;
my ($name, $version, $release) = split ' ', `$rpm -qp --qf '%{name} %{version}
%{release}' $srpm`;
(my $rpmdir = dirname($srpm)) =~ s/SRPMS/RPMS/;
{ name => $name, version => $version, release => $release, rpmdir => $rpmdir, file
=> $srpm };
}
sub previous_pkg {
my ($rpm_or_srpm, $name, $o_q_name) = @_;
my @dirs = map { "$_$rpm_or_srpm" } qw(/home/mandrake/uploads/cooker/
/home/mandrake/uploads/contrib/ / /contrib/);
foreach (if_($o_q_name, @dirs)) {
my @l = glob("$_/$o_q_name-*.rpm") or next;
return keep_the_one($name, @l);
}
if (my @l = (map { glob("$_/$name-*.rpm") } @dirs)) {
return keep_the_one($name, @l);
}
die "no existing package named $name\n";
}
sub keep_the_one {
my ($name, @l) = @_;
@l = grep { `$rpm -qp --queryformat "%{name}" $_` eq $name } @l if @l > 1;
if (@l == 1) {
return $l[0];
} elsif (@l) {
die "more than one package is named $name: " . join(" ", @l) . "\n";
} else {
die "no existing package named $name\n";
}
}
my $package_files_banner_displayed;
sub compare_one_package_files {
my ($rpm_info, $previous_rpm) = @_;
my @new = `$rpm -qpl $rpm_info->{file}`;
my @old = `$rpm -qpl $previous_rpm`;
@old = map { moved_files($_) } @old;
@old || $rpm_info->{name} !~ /-debug$/ or return;
compare_lists('files', $rpm_info, [EMAIL PROTECTED], [EMAIL PROTECTED]);
check_bad_files($_) foreach @new;
1;
}
sub compare_package_files {
my ($previous, @rpms) = @_;
grep {
my $previous_rpm =
"$previous->{rpmdir}/$_->{name}-$previous->{version}-$previous->{release}*.rpm";
if (compare_one_package_files($_, $previous_rpm)) {
1;
} else {
unlink $_->{file};
0;
}
} @rpms;
}
sub compare_package_requires {
my ($previous, @rpms) = @_;
foreach my $rpm_info (@rpms) {
my $previous_rpm =
"$previous->{rpmdir}/$rpm_info->{name}-$previous->{version}-$previous->{release}*.rpm";
my $non_interesting_requires = sub {
/^\Qld-linux.so.2/;
};
my @new = grep { !$non_interesting_requires->() } `$rpm -qp --requires
$rpm_info->{file}`;
my @old = grep { !$non_interesting_requires->() } `$rpm -qp --requires
$previous_rpm`;
compare_lists('requires', $rpm_info, [EMAIL PROTECTED], [EMAIL PROTECTED]);
}
}
sub compare_package_provides {
my ($previous, @rpms) = @_;
foreach my $rpm_info (@rpms) {
my $previous_rpm =
"$previous->{rpmdir}/$rpm_info->{name}-$previous->{version}-$previous->{release}*.rpm";
my $non_interesting_provides = sub {
/\Q$rpm_info->{name} = /;
};
my @new = grep { !$non_interesting_provides->() } `$rpm -qp --provides
$rpm_info->{file}`;
my @old = grep { !$non_interesting_provides->() } `$rpm -qp --provides
$previous_rpm`;
compare_lists('provides', $rpm_info, [EMAIL PROTECTED], [EMAIL PROTECTED]);
}
}
my %banner_displayed;
sub compare_lists {
my ($name, $rpm_info, $new, $old) = @_;
$new = join('', sort @$new);
$old = join('', sort @$old);
$new ne $old or return 1;
my $olddir = POSIX::getcwd();
chdir $rpmdir;
output("$rpm_info->{name}--$name.new", $new);
output("$rpm_info->{name}--$name.old", $old);
print "compare package $name
*********************************************************\n" if
!$banner_displayed{$name}++;
system("diff -u $rpm_info->{name}--$name.old $rpm_info->{name}--$name.new");
unlink "$rpm_info->{name}--$name.old", "$rpm_info->{name}--$name.new";
chdir $olddir;
0;
}
sub moved_files {
local ($_) = @_;
s|site_perl|vendor_perl|;
s|5.6.1|5.8.1|;
s|5.8.0|5.8.1|;
s|python2.2|python2.3|;
s|/man3pm/|/man3/|;
s|/i386-linux/|/i386-linux-thread-multi/|;
$_;
}
sub check_bad_files {
local ($_) = @_;
my $ok = 1;
chomp;
m|/site_perl/| and warn("ERROR: bad file $_\n"), $ok = 0;
$ok;
}
