Main   Changelog   Spec   Patches   Sources   Download   Gear   Bugs e FR  Repocop 

pax_global_header00006660000000000000000000000064120340307140014504gustar00rootroot0000000000000052 comment=1af54bc0b22fa1cb76fd8b2d79c8ef71d461556c
RPM-Payload-0.11/000075500000000000000000000000001203403071400134505ustar00rootroot00000000000000RPM-Payload-0.11/.gear/000075500000000000000000000000001203403071400144445ustar00rootroot00000000000000RPM-Payload-0.11/.gear/rules000064400000000000000000000000421203403071400155150ustar00rootroot00000000000000tar: . name=RPM-Payload-@version@
RPM-Payload-0.11/MANIFEST000064400000000000000000000000761203403071400146040ustar00rootroot00000000000000Makefile.PL
MANIFEST
lib/RPM/Payload.pm
perl-RPM-Payload.spec
RPM-Payload-0.11/Makefile.PL000064400000000000000000000003531203403071400154230ustar00rootroot00000000000000use ExtUtils::MakeMaker;
WriteMakefile 
	NAME		=> 'RPM::Payload',
	VERSION_FROM	=> 'lib/RPM/Payload.pm',
	ABSTRACT_FROM	=> 'lib/RPM/Payload.pm',
	AUTHOR		=> 'Alexey Tourbin <at@altlinux.org>',
	dist		=> { COMPRESS => 'gzip -9nf' },
	;
RPM-Payload-0.11/lib/000075500000000000000000000000001203403071400142165ustar00rootroot00000000000000RPM-Payload-0.11/lib/RPM/000075500000000000000000000000001203403071400146545ustar00rootroot00000000000000RPM-Payload-0.11/lib/RPM/Payload.pm000064400000000000000000000126441203403071400166120ustar00rootroot00000000000000package RPM::Payload;

use 5.008;
use strict;

our $VERSION = '0.11';

sub new {
	my ($class, $f) = @_;
	open my $fh, "-|", "rpm2cpio", $f
		or die "$f: rpm2cpio failed";
	# n1: current data pos
	# n2: end data pos
	# n3: next entry pos
	bless [ $f, $fh, 0, 0, 0 ] => $class;
}

sub _skip ($$$) {
	my ($f, $fh, $n) = @_;
	while ($n > 0) {
		my $m = ($n > 8192) ? 8192 : $n;
		$m == read $fh, my $buf, $m
			or die "$f: cannot skip cpio bytes";
		$n -= $m;
	}
}

sub next {
	my $self = shift;
	my ($f, $fh, $n1, $n2, $n3) = @$self;
	if ($n3 > $n1) {
		_skip($f, $fh, $n3 - $n1);
		$n1 = $n3;
	}
	110 == read $fh, my $cpio_header, 110
		or die "$f: cannot read cpio header";
	$n1 += 110;

	my ($magic, $ino, $mode, $uid, $gid, $nlink, $mtime, $size,
	$dev_major, $dev_minor, $rdev_major, $rdev_minor, $namelen, $checksum) =
		map hex, unpack "a6(a8)13", $cpio_header;
	$magic == 0x070701 or die "$f: bad cpio header magic";

	my $namesize = (($namelen + 1) & ~3) + 2;
	$namesize == read $fh, my $filename, $namesize
		or die "$f: cannot read cpio filename";
	$n1 += $namesize;
	substr $filename, $namelen, $namesize, "";
	chop($filename) eq "\0"
		or die "$f: bad cpio filename";

	$n2 = $n1 + $size;
	$n3 = ($n2 + 3) & ~3;
	#warn "filename=$filename\tdatapos=$n1 end=$n2 next=$n3\n";
	@$self[2,3,4] = ($n1, $n2, $n3);

	return if $filename eq "TRAILER!!!";

	my $entry = {
		filename => $filename,
		ino	=> $ino,
		mode	=> $mode,
		uid	=> $uid,
		gid	=> $gid,
		nlink	=> $nlink,
		mtime	=> $mtime,
		size	=> $size,
		dev_major => $dev_major, dev_minor => $dev_minor,
		rdev_major => $rdev_major, rdev_minor => $rdev_minor,
		dev	=> ($dev_major << 8) | $dev_minor,
		rdev	=> ($rdev_major << 8) | $rdev_minor,
		_cpio	=> $self,
	};
	bless $entry, "RPM::Payload::entry";
}

package RPM::Payload::entry;
use Fcntl qw(S_ISREG S_ISLNK);

sub read : method {
	die "Usage: ENTRY->read(SCALAR,LENGTH)"
		unless @_ == 3;
	my $self = shift;
	my $n = pop;
	my $cpio = $$self{_cpio};
	my ($f, $fh, $n1, $n2, $n3) = @$cpio;
	die "$f: $$self{filename}: not regular file"
		unless S_ISREG($$self{mode});

	my $left = $n2 - $n1;
	$n = $left if $n > $left;
	return 0 if $n < 1;

	$n == read $fh, $_[0], $n
		or die "$f: $$self{filename}: cannot read cpio data";
	$$cpio[2] += $n;
	return $n;
}

sub readlink {
	my $self = shift;
	return $$self{_readlink} if exists $$self{_readlink};
	my $cpio = $$self{_cpio};
	my ($f, $fh, $n1, $n2, $n3) = @$cpio;
	die "$f: $$self{filename}: not symbolic link"
		unless S_ISLNK($$self{mode});

	my $n = $n2 - $n1;
	die "$f: $$self{filename}: bad cpio symlink"
		if $n < 1;

	$n == read $fh, my $linkto, $n
		or die "$f: $$self{filename}: cannot read cpio symlink";
	$$cpio[2] += $n;
	$$self{_readlink} = $linkto;
	return $linkto;
}

for my $method (qw(
	filename ino mode uid gid nlink mtime size dev rdev
	dev_major dev_minor rdev_major rdev_minor))
{
	no strict 'refs';
	*$method = sub { $_[0]->{$method} };
}

1;

__END__

=head1	NAME

RPM::Payload - simple in-memory access to RPM cpio archive

=head1	SYNOPSIS

    use RPM::Payload;
    my $cpio = RPM::Payload->new("rpm-3.0.4-0.48.i386.rpm");
    while (my $entry = $cpio->next) {
	print $entry->filename, "\n";
    }

=head1	DESCRIPTION

C<RPM::Payload> provides in-memory access to RPM cpio archive.
Cpio headers and file data can be read in a simple loop.
C<RPM::Payload> uses C<rpm2cpio> program which comes with RPM.

=head1	EXAMPLE

Piece of Bourne shell code:

    rpmfile()
    {
	tmpdir=`mktemp -dt rpmfile.XXXXXXXX`
	rpm2cpio "$1" |(cd "$tmpdir"
	    cpio -idmu --quiet --no-absolute-filenames
	    chmod -Rf u+rwX .
	    find -type f -print0 |xargs -r0 file)
	rm -rf "$tmpdir"
    }

Sample output:

    $ rpmfile rss2mail2-2.25-alt1.noarch.rpm 
    ./usr/share/man/man1/rss2mail2.1.gz: gzip compressed data, from Unix, max compression
    ./usr/bin/rss2mail2:                 perl script text executable
    ./etc/rss2mail2rc:                   ASCII text
    $

Perl implementation:

    use RPM::Payload;
    use Fcntl qw(S_ISREG);
    use File::LibMagic qw(MagicBuffer);
    sub rpmfile {
	my $f = shift;
	my $cpio = RPM::Payload->new($f);
	while (my $entry = $cpio->next) {
	    next unless S_ISREG($entry->mode);
	    next unless $entry->size > 0;
	    $entry->read(my $buf, 8192) > 0 or die "read error";
	    print $entry->filename, "\t", MagicBuffer($buf), "\n";
	}
    }

=head1	CAVEATS

C<rpm2cpio> program (which comes with RPM) must be installed.

It will die on error, so you may need an enclosing eval block.  However,
they say "when you must fail, fail noisily and as soon as possible".

Entries obtained with C<< $cpio->next >> are coupled with current position
in C<$cpio> stream.  Thus, C<< $entry->read >> and C<< $entry->readlink >>
methods may only be invoked before the next C<< $cpio->next >> call.

Hradlinks must be handled manually.  Alternatively, you may want to skip
entries with C<< $entry->size == 0 >> altogether.

=head1	AUTHOR

Written by Alexey Tourbin <at@altlinux.org>.

=head1	COPYING

Copyright (c) 2006, 2009  Alexey Tourbin, ALT Linux Team.

This is free software; you can redistribute it and/or modify it under the terms
of the GNU General Public License as published by the Free Software Foundation;
either version 2 of the License, or (at your option) any later version.

=head1	SEE ALSO

rpm2cpio(8).

Edward C. Bailey.  Maximum RPM.
L<http://www.rpm.org/max-rpm/index.html> (RPM File Format).

Eric S. Raymond.  The Art of Unix Programming.
L<http://www.faqs.org/docs/artu/index.html> (Rule of Repair).

=cut
RPM-Payload-0.11/perl-RPM-Payload.spec000064400000000000000000000020631203403071400173120ustar00rootroot00000000000000%define dist RPM-Payload
Name: perl-%dist
Version: 0.11
Release: alt1

Summary: Simple in-memory access to RPM cpio archive
License: GPLv2+
Group: Development/Perl

URL: %CPAN %dist
Source: %dist-%version.tar

Requires: /usr/bin/rpm2cpio

BuildArch: noarch

# Automatically added by buildreq on Sat Oct 06 2012
BuildRequires: perl-devel

%description
RPM::Payload provides in-memory access to RPM cpio archive.
Cpio headers and file data can be read in a simple loop.
RPM::Payload uses rpm2cpio program which comes with RPM.

%prep
%setup -q -n %dist-%version

%build
%perl_vendor_build

%install
%perl_vendor_install

%files
%perl_vendor_privlib/RPM

%changelog
* Sat Oct 06 2012 Alexey Tourbin <at@altlinux.ru> 0.11-alt1
- marked read() as method, to suppress warnings

* Fri Apr 03 2009 Alexey Tourbin <at@altlinux.ru> 0.10-alt1
- implemented $entry->readlink method
- released under GPLv2+

* Mon Feb 16 2009 Alexey Tourbin <at@altlinux.ru> 0.02-alt1
- use rpm2cpio, to handle LZMA payloads

* Sat Mar 18 2006 Alexey Tourbin <at@altlinux.ru> 0.01-alt1
- initial revision