pax_global_header00006660000000000000000000000064122074235350014515gustar00rootroot0000000000000052 comment=512eb9427a85efe991eb2ab8b7307dfeaf7b544d qa-rpmelfsym-0.12/000075500000000000000000000000001220742353500140525ustar00rootroot00000000000000qa-rpmelfsym-0.12/.gear/000075500000000000000000000000001220742353500150465ustar00rootroot00000000000000qa-rpmelfsym-0.12/.gear/rules000064400000000000000000000000431220742353500161200ustar00rootroot00000000000000tar: . name=qa-rpmelfsym-@version@ qa-rpmelfsym-0.12/Makefile.PL000064400000000000000000000004231220742353500160230ustar00rootroot00000000000000use ExtUtils::MakeMaker; WriteMakefile NAME => 'qa::rpmelfsym', VERSION_FROM => 'lib/qa/rpmelfsym.pm', AUTHOR => 'Alexey Tourbin ', EXE_FILES => [qw(rpmelfsym.pl bad_elf_symbols.pl bad_elf_symbols_dircmp.pl)], dist => { COMPRESS => 'gzip -9nf' }, ; qa-rpmelfsym-0.12/bad_elf_symbols.pl000075500000000000000000000016341220742353500175420ustar00rootroot00000000000000#!/usr/bin/perl use strict; use Getopt::Long 2.24 qw(GetOptions :config gnu_getopt); GetOptions "include=s" => \(my $include = "*.rpm") and @ARGV or die "Usage: $0 [--include=GLOB] [RPM...] [RPMDIR...]\n"; my @rpms; for (@ARGV) { if (-d) { use File::Glob 'bsd_glob'; my @gl = bsd_glob("$_/$include", 0) or die "$_: no rpms"; push @rpms, @gl; } else { push @rpms, $_; } } use File::Temp 'tempdir'; use sigtrap qw(die normal-signals); my $TMPDIR = $ENV{TMPDIR} = tempdir(CLEANUP => 1); use qa::rpmelfsym 'collect_bad_elfsym'; collect_bad_elfsym $TMPDIR, "", \@rpms; exit 0 unless -s "$TMPDIR/seq"; $ENV{tab} = "\t"; 0 == system <<'EOF' or die "/bin/sh failed"; set -efu cd "$TMPDIR" sort -u -o def def sort -t"$tab" -k2,2 -o ref ref join -t"$tab" -v1 -12 -21 -o '1.1 1.2' ref def >tmp mv -f tmp ref rm -f def sort -t"$tab" -k1,1 -o ref ref join -t"$tab" -o '1.2 1.3 1.4 2.2' seq ref >tmp sort -u tmp EOF qa-rpmelfsym-0.12/bad_elf_symbols_dircmp.pl000075500000000000000000000044371220742353500211040ustar00rootroot00000000000000#!/usr/bin/perl use strict; use Getopt::Long 2.24 qw(GetOptions :config gnu_getopt); GetOptions "include=s" => \(my $include = "*.rpm") and @ARGV == 2 and do { open my $fh, ">&3" } or die "Usage: $0 [--include=GLOB] RPMDIR1 RPMDIR2 >plus 3>minus\n"; my ($dir1, $dir2) = @ARGV; my @rpms0; my @rpms1; my @rpms2; { use File::Glob 'bsd_glob'; @rpms1 = bsd_glob("$dir1/$include", 0) or die "$dir1: no rpms"; @rpms2 = bsd_glob("$dir2/$include", 0) or die "$dir2: no rpms"; use qa::memoize 0.02 'basename'; my %rpms1 = map { basename($_) => [ $_, -s $_, -M _ ] } @rpms1; my %rpms2 = map { basename($_) => [ $_, -s $_, -M _ ] } @rpms2; while (my ($basename, $path_size_mtime1) = each %rpms1) { my $path_size_mtime2 = $rpms2{$basename}; next unless $path_size_mtime2; next unless "@$path_size_mtime1[1,2]" eq "@$path_size_mtime2[1,2]"; push @rpms0, $$path_size_mtime1[0]; delete $rpms1{$basename}; delete $rpms2{$basename}; } @rpms0 = sort @rpms0; @rpms1 = sort map { $$_[0] } values %rpms1; @rpms2 = sort map { $$_[0] } values %rpms2; } use File::Temp 'tempdir'; use sigtrap qw(die normal-signals); my $TMPDIR = $ENV{TMPDIR} = tempdir(CLEANUP => 1); use qa::rpmelfsym 'collect_bad_elfsym'; collect_bad_elfsym $TMPDIR, "1", \@rpms1; collect_bad_elfsym $TMPDIR, "2", \@rpms2; exit 0 unless -s "$TMPDIR/seq"; collect_bad_elfsym $TMPDIR, "0", \@rpms0; $ENV{tab} = "\t"; 0 == system <<'EOF' or die "/bin/sh failed"; set -efu cd "$TMPDIR" sort -u -o def1 def1 sort -t"$tab" -k2,2 -o ref1 ref1 join -t"$tab" -v1 -12 -21 -o '1.1 1.2' ref1 def1 >tmp mv -f tmp ref1 sort -u -o def2 def2 sort -t"$tab" -k2,2 -o ref2 ref2 join -t"$tab" -v1 -12 -21 -o '1.1 1.2' ref2 def2 >tmp mv -f tmp ref2 sort -u -o def0 def0 sort -t"$tab" -k2,2 -o ref0 ref0 join -t"$tab" -v1 -12 -21 -o '1.1 1.2' ref0 def0 >tmp & join -t"$tab" -v1 -12 -21 -o '1.1 1.2' ref1 def0 >ref1a join -t"$tab" -v1 -12 -21 -o '1.1 1.2' ref2 def0 >ref2a wait $! mv -f tmp ref0 rm -f def0 join -t"$tab" -v1 -12 -21 -o '1.1 1.2' ref0 def1 >ref1b join -t"$tab" -v1 -12 -21 -o '1.1 1.2' ref0 def2 >ref2b sort -u -o ref1 ref1a ref1b sort -u -o ref2 ref2a ref2b join -t"$tab" -o '1.2 1.3 1.4 2.2' seq ref1 >tmp sort -u -o xref1 tmp join -t"$tab" -o '1.2 1.3 1.4 2.2' seq ref2 >tmp sort -u -o xref2 tmp comm -13 xref1 xref2 comm -23 xref1 xref2 >&3 EOF qa-rpmelfsym-0.12/lib/000075500000000000000000000000001220742353500146205ustar00rootroot00000000000000qa-rpmelfsym-0.12/lib/qa/000075500000000000000000000000001220742353500152215ustar00rootroot00000000000000qa-rpmelfsym-0.12/lib/qa/rpmelfsym.pm000064400000000000000000000071401220742353500175770ustar00rootroot00000000000000package qa::rpmelfsym; use strict; our $VERSION = '0.11'; require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); { my $magic; use File::LibMagic 0.90 qw(magic_open magic_load magic_buffer magic_file); sub file ($) { unless ($magic) { $magic = magic_open(0) or die "magic_open failed"; magic_load($magic, undef); } my $f = shift; magic_file($magic, $f); } } sub rpmelfsym ($) { my $rpm = shift; require RPM::Payload; my $cpio = RPM::Payload->new($rpm); my $out = ""; while (my $ent = $cpio->next) { use Fcntl 'S_ISREG'; next unless S_ISREG($ent->mode); next unless $ent->size > 4; my $filename = $ent->filename; $filename =~ s#^\./|^/|^#/#; next if $filename =~ m#^/usr/lib/debug/.+\.debug\z#; $ent->read(my $magic, 4) == 4 or die "$rpm: $filename: cpio read failed"; next unless $magic eq "\177ELF"; require File::Temp; my $tmp = File::Temp->new; local ($\, $,); print $tmp $magic or die "$rpm: $filename: tmp write failed: $!"; while ($ent->read(my $buf, 8192) > 0) { print $tmp $buf or die "$rpm: $filename: tmp write failed: $!"; } $tmp->flush or die "$rpm: $filename: tmp write failed: $!"; my $type = file("$tmp"); next unless $type =~ /\bELF .+ dynamically linked/; my @file2syms = $filename; open my $fh, "-|", qw(nm -D -P), "$tmp" or die "$rpm: $filename: nm failed"; local $_; while (<$fh>) { my @sym = split; @sym >= 2 and 1 == length $sym[1] or die "$rpm: $filename: invalid nm output: @sym"; push @file2syms, $sym[1] . $sym[0]; } close $fh or die "$rpm: $filename: nm failed"; $out .= join "\0", @file2syms, "" if @file2syms > 1; } chop $out; return $out; } use qa::memoize 0.02 qw(memoize_bsm); memoize_bsm("rpmelfsym"); require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(rpmelfsym collect_bad_elfsym print_elfsym); # We use seqno as a join key for (rpm-basename,elf-filename) tuples, which # we store separately. Four-letter numbers impose 456K limit on ELF files # from within rpm packages which can be processed simultaneously. However, # our typical repo is 10K packages and 30K ELF files total (per arch). sub last_seqno ($) { my $fname = shift; open my $fh, "<", $fname or return "AAAA"; stat $fh and my $size = -s _ or return "AAAA"; use constant PIPE_BUF => 4096; seek $fh, - PIPE_BUF, 2 if $size > PIPE_BUF; read $fh, my $buf, PIPE_BUF; my @lines = split /\n/, $buf; my $line = $lines[-1]; $line =~ /^([A-Z]{4})\t/ or die "$fname: invalid last line: $line"; return $1; } sub collect_bad_elfsym2 ($$$$$) { my ($ref, $def, $seq, $seqno, $rpms) = @_; my $cnt = 0; for my $rpm (@$rpms) { next unless $cnt++ % 2 == 0; my $argz = rpmelfsym $rpm; next if $argz eq ""; use qa::memoize 0.02 'basename'; $rpm = basename $rpm; collect_bad_elfsym1($rpm, $argz, $ref, $def, $seq, $seqno); } } sub collect_bad_elfsym ($$$) { my ($dir, $suffix, $rpms) = @_; my $seqno = last_seqno "$dir/seq"; open my $ref, ">>", "$dir/ref$suffix" or die "ref: $!"; open my $def, ">>", "$dir/def$suffix" or die "def: $!"; open my $seq, ">>", "$dir/seq" or die "seq: $!"; use 5.010; my $pid1 = fork // die "fork: $!"; if ($pid1 == 0) { collect_bad_elfsym2($ref, $def, $seq, $seqno, $rpms); exit 0; } my $pid2 = fork // die "fork: $!"; if ($pid2 == 0) { # process "odd" rpms shift @$rpms; # use alternate seqno $seqno++; collect_bad_elfsym2($ref, $def, $seq, $seqno, $rpms); exit 0; } $pid1 == waitpid $pid1, 0 and $? == 0 or die "pid1 failed"; $pid2 == waitpid $pid2, 0 and $? == 0 or die "pid2 failed"; 0 == system "sort", "-o", "$dir/seq", "$dir/seq" or die "sort seq failed"; } 1; qa-rpmelfsym-0.12/perl-qa-rpmelfsym.spec000064400000000000000000000056001220742353500203040ustar00rootroot00000000000000%define dist qa-rpmelfsym Name: perl-%dist Version: 0.12 Release: alt3 Summary: Faster rpmelfsym(1) and bad_elf_symbols implementation License: GPLv2+ Group: Development/Perl URL: %CPAN %dist Source: %dist-%version.tar # rpmelfsym.pm uses nm(1) Requires: binutils # Automatically added by buildreq on Mon Oct 10 2011 (-bi) BuildRequires: perl-File-LibMagic perl-devel perl-qa-cache %description no description %prep %setup -q -n %dist-%version %build %perl_vendor_build %install %perl_vendor_install # MakeMaker sucks (and I don't know how to tweak it) rm %buildroot%perl_vendor_archlib/qa/*.pl %files %_bindir/*.pl %perl_vendor_archlib/qa* %perl_vendor_autolib/qa* %changelog * Wed Aug 28 2013 Vladimir Lettiev 0.12-alt3 - built for perl 5.18 * Wed Nov 21 2012 Dmitry V. Levin 0.12-alt2 - Added binutils to package requirements. * Tue Oct 02 2012 Alexey Tourbin 0.12-alt1 - rpmelfsym.pl: reimplemented print_elfysm() routine in XS - rpmelfsym.xs: further optimized PerlIO_write() calls - scripts: added --include=GLOB option * Sat Sep 01 2012 Vladimir Lettiev 0.11-alt3 - rebuilt for perl-5.16 * Mon Oct 10 2011 Alexey Tourbin 0.11-alt2 - rebuilt for perl-5.14 * Sun Sep 11 2011 Alexey Tourbin 0.11-alt1 - qa/rpmelfsym.pm: implemented parallel collect_bad_elfsym routine - bad_elf_symbols_dircmp.pl: optimized def0 usage for parallel join * Thu Sep 08 2011 Alexey Tourbin 0.10-alt1 - changed internal data format to argz blob - rewritten bad_elf_symbols inner loop in XS * Sun Feb 06 2011 Alexey Tourbin 0.09-alt1 - qa/rpmelfsym.pm: ignore *.debug files under /usr/lib/debug - bad_elf_symbols*.pl: added support for "i" indirect functions * Tue Aug 10 2010 Alexey Tourbin 0.08-alt1 - bad_elf_symbols*.pl: handle unique global symbols (Dmitry V. Levin) * Tue Apr 07 2009 Alexey Tourbin 0.07-alt1 - switched to (rpm-basename,size,mtime) caching mode - flattened down internal data structure, for efficiency - reverted piping to sort(1) and other optimizations proved inefficient - optimized by saving (rpm-basename,filename) in a separate file - optimized by eliminating huge 'sort -m' merges * Fri Apr 03 2009 Alexey Tourbin 0.06-alt1 - optimized inner loop writes for speed * Wed Apr 01 2009 Alexey Tourbin 0.05-alt1 - bad_elf_symbols*.pl: optimize by running sort(1) in background * Sun Feb 22 2009 Alexey Tourbin 0.04-alt1 - rpmelfsym.pm: fixed ELF magic check for nm(1) * Fri Feb 20 2009 Alexey Tourbin 0.03-alt1 - implemented bad_elf_symbols_dircmp.pl, for use in girar-builder * Thu Feb 19 2009 Alexey Tourbin 0.02-alt1 - rpmelfsym.pm: better handling of tmp write errors * Wed Feb 18 2009 Alexey Tourbin 0.01-alt1 - initial revision qa-rpmelfsym-0.12/rpmelfsym.pl000075500000000000000000000012571220742353500164350ustar00rootroot00000000000000#!/usr/bin/perl use strict; use Getopt::Long 2.24 qw(GetOptions :config gnu_getopt); GetOptions "include=s" => \(my $include = "*.rpm") and @ARGV or die "Usage: $0 [--include=GLOB] [RPM...] [RPMDIR...]\n"; my @rpms; for (@ARGV) { if (-d) { use File::Glob 'bsd_glob'; my @gl = bsd_glob("$_/$include", 0) or die "$_: no rpms"; push @rpms, @gl; } else { push @rpms, $_; } } sub print_rpmelfsym ($) { my $rpm = shift; use qa::rpmelfsym 'rpmelfsym'; my $argz = rpmelfsym $rpm; return if $argz eq ""; use qa::memoize 0.02 'basename'; my $rpm_bn = basename $rpm; use qa::rpmelfsym 'print_elfsym'; print_elfsym $rpm_bn, $argz, *STDOUT; } print_rpmelfsym($_) for @rpms; qa-rpmelfsym-0.12/rpmelfsym.xs000064400000000000000000000101031220742353500164370ustar00rootroot00000000000000#include #include #include #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifndef PIPE_BUF #define PUPE_BUF 4096 #endif MODULE = qa::rpmelfsym PACKAGE = qa::rpmelfsym void print_elfsym(rpm, argz, fh) SV * rpm SV * argz PerlIO * fh CODE: STRLEN argz_len = 0; char *argz_pv = SvPVbyte(argz, argz_len); char *argz_end = argz_pv + argz_len + 1; STRLEN rpm_len = 0; char *rpm_pv = SvPVbyte(rpm, rpm_len); if (*argz_pv != '/') croak("%s: argz: invalid data", rpm_pv); SV *bufsv = sv_mortalcopy(rpm); char *buf = SvGROW(bufsv, rpm_len + 256); buf[rpm_len] = '\t'; STRLEN prefix_len = 0; while (argz_pv < argz_end) { argz_len = strlen(argz_pv); if (isALPHA(*argz_pv)) { int n1 = prefix_len + 3 + argz_len; buf = SvGROW(bufsv, n1); buf[prefix_len + 1] = *argz_pv; memcpy(buf + prefix_len + 3, argz_pv + 1, argz_len - 1); buf[n1 - 1] = '\n'; int n2 = PerlIO_write(fh, buf, n1); if (n1 != n2) croak("fh: write error: %s", strerror(errno)); } else if (*argz_pv == '/') { prefix_len = rpm_len + 1 + argz_len; buf = SvGROW(bufsv, prefix_len + 3); memcpy(buf + rpm_len + 1, argz_pv, argz_len); buf[prefix_len + 0] = '\t'; buf[prefix_len + 2] = '\t'; } argz_pv += argz_len + 1; } if (PerlIO_flush(fh) != 0) croak("fh: flush error: %s", strerror(errno)); void collect_bad_elfsym1(rpm, argz, ref, def, seq, seqno) SV * rpm SV * argz PerlIO * ref PerlIO * def PerlIO * seq SV * seqno CODE: int ref_fill = 0; int def_fill = 0; int seq_fill = 0; STRLEN argz_len = 0; char *argz_pv = SvPVbyte(argz, argz_len); char *argz_end = argz_pv + argz_len + 1; STRLEN rpm_len = 0; char *rpm_pv = SvPVbyte(rpm, rpm_len); if (*argz_pv != '/') croak("%s: argz: invalid data", rpm_pv); STRLEN seqno_len = 0; char *seqno_pv = NULL; SvGROW(seqno, 256); while (argz_pv < argz_end) { int n1 = 0; int n2 = 0; argz_len = strlen(argz_pv); switch (*argz_pv) { case 'U': n1 = seqno_len + argz_len + 1; assert(n1 < PIPE_BUF); if (ref_fill + n1 <= PIPE_BUF) ref_fill += n1; else { if (PerlIO_flush(ref) != 0) croak("ref: flush error: %s", strerror(errno)); ref_fill = n1; } seqno_pv = SvGROW(seqno, n1); memcpy(seqno_pv + seqno_len + 1, argz_pv + 1, argz_len - 1); seqno_pv[seqno_len] = '\t'; seqno_pv[n1 - 1] = '\n'; n2 = PerlIO_write(ref, seqno_pv, n1); seqno_pv[seqno_len] = '\0'; if (n1 != n2) croak("ref: write error: %s", strerror(errno)); break; case 'T': case 'W': case 'V': case 'D': case 'B': case 'A': case 'R': case 'u': case 'i': n1 = argz_len; assert(n1 < PIPE_BUF); if (def_fill + n1 <= PIPE_BUF) def_fill += n1; else { if (PerlIO_flush(def) != 0) croak("def: flush error: %s", strerror(errno)); def_fill = n1; } argz_pv[argz_len] = '\n'; n2 = PerlIO_write(def, argz_pv + 1, argz_len); argz_pv[argz_len] = '\0'; if (n1 != n2) croak("def: write error: %s", strerror(errno)); break; case '/': sv_inc(seqno); sv_inc(seqno); seqno_pv = SvPVbyte(seqno, seqno_len); n1 = seqno_len + rpm_len + argz_len + 5; assert(n1 < PIPE_BUF); if (seq_fill + n1 <= PIPE_BUF) seq_fill += n1; else { if (PerlIO_flush(seq) != 0) croak("seq: flush error: %s", strerror(errno)); seq_fill = n1; } seqno_pv[seqno_len] = '\t'; rpm_pv[rpm_len] = '\t'; argz_pv[argz_len] = '\t'; n2 += PerlIO_write(seq, seqno_pv, seqno_len + 1); n2 += PerlIO_write(seq, rpm_pv, rpm_len + 1); n2 += PerlIO_write(seq, argz_pv, argz_len + 1); n2 += PerlIO_write(seq, "U\n", 2); seqno_pv[seqno_len] = '\0'; rpm_pv[rpm_len] = '\0'; argz_pv[argz_len] = '\0'; if (n1 != n2) croak("seq: write error: %s", strerror(errno)); break; } argz_pv += argz_len + 1; } if (PerlIO_flush(ref) != 0) croak("ref: flush error: %s", strerror(errno)); if (PerlIO_flush(def) != 0) croak("def: flush error: %s", strerror(errno)); if (PerlIO_flush(seq) != 0) croak("seq: flush error: %s", strerror(errno));