Archive-Cpio-0.10/0000755000175000017500000000000012615431032013620 5ustar prigauxprigauxArchive-Cpio-0.10/META.yml0000644000175000017500000000104512615431032015071 0ustar prigauxprigaux--- abstract: 'module for manipulations of cpio archives' author: - 'Pixel ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.150005' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Archive-Cpio no_index: directory: - t - inc requires: {} version: '0.10' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Archive-Cpio-0.10/MANIFEST0000644000175000017500000000067612615431032014762 0ustar prigauxprigauxbin/cpio-filter Changes lib/Archive/Cpio.pm lib/Archive/Cpio/Common.pm lib/Archive/Cpio/File.pm lib/Archive/Cpio/FileHandle_with_pushback.pm lib/Archive/Cpio/NewAscii.pm lib/Archive/Cpio/ODC.pm lib/Archive/Cpio/OldBinary.pm Makefile.PL MANIFEST This list of files t/00basic.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Archive-Cpio-0.10/Changes0000644000175000017500000000225112615430650015120 0ustar prigauxprigaux0.10 Sun Nov 1 16:36:59 CET 2015 - new feature: create an archive from scratch (Adrien Mahieux) 0.09 Mon May 30 14:05:02 CEST 2011 - fix cpio-filter --in-place --exclude (thanks to blino) (regression introduced in 2007) 0.08 Thu Jan 27 09:50:42 CET 2011 - fix ->remove on Archive::Cpio (rt.cpan.org #64852) (thanks to Frits/vwf and Corion) 0.07 Wed Dec 19 11:45:45 CET 2007 - allow ->read($filehandle) and ->write($filehandle) (rt.cpan.org #31686) - fix ->size on Archive::Cpio::File (rt.cpan.org #31684) (thanks to teek) 0.06 Tue Apr 25 00:00:00 CET 2007 - handle ODC (octal) format (Mike Sliczniak) 0.05 Thu Mar 15 18:34:12 CET 2007 - add ->add_data, ->get_file - rename ->list into ->get_files 0.04 Thu Mar 15 16:27:12 CET 2007 - bug fix release - fix using STDIN which can't seek back 0.03 Thu Mar 15 11:51:16 CET 2007 - switch to an OO API to handle different archive formats - handle old binary format (only little-endian for now) - add option --in-place to cpio-filter 0.02 Wed Feb 28 17:10:49 CET 2007 - fix padding at end of generated cpio 0.01 Wed Feb 28 17:10:49 CET 2007 - initial release Archive-Cpio-0.10/t/0000755000175000017500000000000012615431032014063 5ustar prigauxprigauxArchive-Cpio-0.10/t/00basic.t0000644000175000017500000000013011754141654015476 0ustar prigauxprigauxuse Test; BEGIN { plan tests => 1 } END { ok($loaded) } use Archive::Cpio; $loaded++; Archive-Cpio-0.10/lib/0000755000175000017500000000000012615431032014366 5ustar prigauxprigauxArchive-Cpio-0.10/lib/Archive/0000755000175000017500000000000012615431032015747 5ustar prigauxprigauxArchive-Cpio-0.10/lib/Archive/Cpio/0000755000175000017500000000000012615431032016641 5ustar prigauxprigauxArchive-Cpio-0.10/lib/Archive/Cpio/File.pm0000644000175000017500000000034511754141654020073 0ustar prigauxprigauxpackage Archive::Cpio::File; sub new { my ($class, $val) = @_; bless $val, $class; } sub name { my ($o) = @_; $o->{name} } sub size { my ($o) = @_; length($o->{data}) } sub get_content { my ($o) = @_; $o->{data} } 1; Archive-Cpio-0.10/lib/Archive/Cpio/Common.pm0000644000175000017500000000130212615427131020430 0ustar prigauxprigauxpackage Archive::Cpio::Common; use Archive::Cpio::FileHandle_with_pushback; use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(padding write_or_die max begins_with); sub magics() { { "070707" => 'ODC', "070701" => 'NewAscii', "\xC7\x71" => 'OldBinary', # swabbed 070707 "\x71\xC7" => 'OldBinary', # 070707 }; } sub padding { my ($nb, $offset) = @_; my $align = $offset % $nb; $align ? $nb - $align : 0; } sub write_or_die { my ($F, $val) = @_; print $F $val or die "writing failed: $!\n"; } sub max { my $n = shift; $_ > $n and $n = $_ foreach @_; $n } sub begins_with { my ($s, $prefix) = @_; index($s, $prefix) == 0; } 1; Archive-Cpio-0.10/lib/Archive/Cpio/OldBinary.pm0000644000175000017500000000431312615427131021070 0ustar prigauxprigauxpackage Archive::Cpio::OldBinary; use Archive::Cpio::Common; my $TRAILER = 'TRAILER!!!'; my $BLOCK_SIZE = 512; my @HEADER = qw( magic dev ino mode uid gid nlink rdev mtime_high mtime_low namesize datasize_high datasize_low ); sub new { my ($class, $magic) = @_; bless { magic => unpack('v', $magic) }, $class; } sub read_one { my ($o, $FHwp) = @_; my $entry = read_one_header($o, $FHwp); $entry->{name} = $FHwp->read($entry->{namesize}); $entry->{name} =~ s/\0$//; $entry->{name} ne $TRAILER or return; $FHwp->read(padding(2, $entry->{namesize})); $entry->{data} = $FHwp->read($entry->{datasize}); $FHwp->read(padding(2, $entry->{datasize})); cleanup_entry($entry); $entry; } sub read_one_header { my ($o, $FHwp) = @_; my %h; my @vals = unpack('v*', $FHwp->read(2 * @HEADER)); foreach my $field (@HEADER) { $h{$field} = shift @vals; } foreach ('mtime', 'datasize') { $h{$_} = $h{$_ . '_high'} * 0x10000 + $h{$_ . '_low'}; } $h{magic} == $o->{magic} or die "bad magic ($h{magic} vs $o->{MAGIC})\n"; \%h; } sub write_one { my ($o, $F, $entry) = @_; $entry->{magic} = $o->{magic}; $entry->{namesize} = length($entry->{name}) + 1; $entry->{datasize} = length($entry->{data}); foreach ('mtime', 'datasize') { $entry->{$_ . '_high'} = int($entry->{$_} / 0x10000); $entry->{$_ . '_low'} = $entry->{$_} % 0x10000; } write_or_die($F, pack_header($entry) . $entry->{name} . "\0" . "\0" x padding(2, $entry->{namesize})); write_or_die($F, $entry->{data}); write_or_die($F, "\0" x padding(2, $entry->{datasize})); cleanup_entry($entry); } sub write_trailer { my ($o, $F) = @_; write_one($o, $F, { name => $TRAILER, data => '', nlink => 1 }); write_or_die($F, "\0" x padding($BLOCK_SIZE, tell($F))); } sub cleanup_entry { my ($entry) = @_; foreach ('datasize', 'namesize', 'magic') { delete $entry->{$_}; } foreach (keys %$entry) { /_low$|_high$/ and delete $entry->{$_}; } } sub pack_header { my ($h) = @_; pack('v*', map { $h->{$_} || 0 } @HEADER); } 1; Archive-Cpio-0.10/lib/Archive/Cpio/NewAscii.pm0000644000175000017500000000445012615427131020711 0ustar prigauxprigauxpackage Archive::Cpio::NewAscii; use Archive::Cpio::Common; my $TRAILER = 'TRAILER!!!'; my $BLOCK_SIZE = 512; my @HEADER = ( magic => 6, inode => 8, mode => 8, uid => 8, gid => 8, nlink => 8, mtime => 8, datasize => 8, devMajor => 8, devMinor => 8, rdevMajor => 8, rdevMinor => 8, namesize => 8, checksum => 8, ); sub new { my ($class, $magic) = @_; bless { magic => hex($magic) }, $class; } sub read_one { my ($o, $FHwp) = @_; my $entry = read_one_header($o, $FHwp); $entry->{name} = $FHwp->read($entry->{namesize}); $entry->{name} =~ s/\0$//; $entry->{name} ne $TRAILER or return; $FHwp->read(padding(4, $entry->{namesize} + 2)); $entry->{data} = $FHwp->read($entry->{datasize}); $FHwp->read(padding(4, $entry->{datasize})); cleanup_entry($entry); $entry; } sub read_one_header { my ($o, $FHwp) = @_; my %h; my @header = @HEADER; while (@header) { my $field = shift @header; my $size = shift @header; $h{$field} = $FHwp->read($size); $h{$field} =~ /^[0-9A-F]*$/si or die "bad header value $h{$field}\n"; $h{$field} = hex $h{$field}; } $h{magic} == $o->{magic} or die "bad magic ($h{magic} vs $o->{MAGIC})\n"; \%h; } sub write_one { my ($o, $F, $entry) = @_; $entry->{magic} = $o->{magic}; $entry->{namesize} = length($entry->{name}) + 1; $entry->{datasize} = length($entry->{data}); write_or_die($F, pack_header($entry) . $entry->{name} . "\0" . "\0" x padding(4, $entry->{namesize} + 2)); write_or_die($F, $entry->{data}); write_or_die($F, "\0" x padding(4, $entry->{datasize})); cleanup_entry($entry); } sub write_trailer { my ($o, $F) = @_; write_one($o, $F, { name => $TRAILER, data => '', nlink => 1 }); write_or_die($F, "\0" x padding($BLOCK_SIZE, tell($F))); } sub cleanup_entry { my ($entry) = @_; foreach ('datasize', 'namesize', 'magic') { delete $entry->{$_}; } } sub pack_header { my ($h) = @_; my $packed = ''; my @header = @HEADER; while (@header) { my $field = shift @header; my $size = shift @header; $packed .= sprintf("%0${size}X", $h->{$field} || 0); } $packed; } 1; Archive-Cpio-0.10/lib/Archive/Cpio/FileHandle_with_pushback.pm0000644000175000017500000000140612615427131024113 0ustar prigauxprigauxpackage Archive::Cpio::FileHandle_with_pushback; sub new { my ($class, $F) = @_; bless { F => $F, already_read => '' }, $class; } sub pushback { my ($FHwp, $s) = @_; $FHwp->{already_read} .= $s; } sub read { my ($FHwp, $size) = @_; $size or return; $size =~ /^\d+$/ or die "bad size $size\n"; my $tmp = ''; if ($FHwp->{already_read}) { $tmp = substr($FHwp->{already_read}, 0, $size); substr($FHwp->{already_read}, 0, $size) = ''; $size -= length($tmp); } read($FHwp->{F}, $tmp, $size, length($tmp)) == $size or die "unexpected end of file while reading (got $tmp)\n"; $tmp; } sub read_ahead { my ($FHwp, $size) = @_; my $s = $FHwp->read($size); $FHwp->pushback($s); $s; } 1; Archive-Cpio-0.10/lib/Archive/Cpio/ODC.pm0000644000175000017500000000365112615427131017616 0ustar prigauxprigauxpackage Archive::Cpio::ODC; use Archive::Cpio::Common; my $TRAILER = 'TRAILER!!!'; my $BLOCK_SIZE = 512; my @HEADER = ( magic => 6, dev => 6, inode => 6, mode => 6, uid => 6, gid => 6, nlink => 6, rdev => 6, mtime => 11, namesize => 6, datasize => 11, ); sub new { my ($class, $magic) = @_; bless { magic => oct($magic) }, $class; } sub read_one { my ($o, $FHwp) = @_; my $entry = read_one_header($o, $FHwp); $entry->{name} = $FHwp->read($entry->{namesize}); $entry->{name} =~ s/\0$//; $entry->{name} ne $TRAILER or return; $entry->{data} = $FHwp->read($entry->{datasize}); cleanup_entry($entry); $entry; } sub read_one_header { my ($o, $FHwp) = @_; my %h; my @header = @HEADER; while (@header) { my $field = shift @header; my $size = shift @header; $h{$field} = $FHwp->read($size); $h{$field} =~ /^[0-9]*$/si or die "bad header value $h{$field}\n"; $h{$field} = oct $h{$field}; } $h{magic} == $o->{magic} or die "bad magic ($h{magic} vs $o->{MAGIC})\n"; \%h; } sub write_one { my ($o, $F, $entry) = @_; $entry->{magic} = $o->{magic}; $entry->{namesize} = length($entry->{name}) + 1; $entry->{datasize} = length($entry->{data}); write_or_die($F, pack_header($entry) . $entry->{name} . "\0" . $entry->{data}); cleanup_entry($entry); } sub write_trailer { my ($o, $F) = @_; write_one($o, $F, { name => $TRAILER, data => '', nlink => 1 }); } sub cleanup_entry { my ($entry) = @_; foreach ('datasize', 'namesize', 'magic') { delete $entry->{$_}; } } sub pack_header { my ($h) = @_; my $packed = ''; my @header = @HEADER; while (@header) { my $field = shift @header; my $size = shift @header; $packed .= sprintf("%0${size}lo", $h->{$field} || 0); } $packed; } 1; Archive-Cpio-0.10/lib/Archive/Cpio.pm0000644000175000017500000001272412615431026017210 0ustar prigauxprigauxpackage Archive::Cpio; use strict; use warnings; our $VERSION = '0.10'; use Archive::Cpio::Common; use Archive::Cpio::File; use Archive::Cpio::OldBinary; =head1 NAME Archive::Cpio - module for manipulations of cpio archives =head1 SYNOPSIS use Archive::Cpio; # simple example removing entry "foo" my $cpio = Archive::Cpio->new; $cpio->read($file); $cpio->remove('foo'); $cio->write($file); # more complex example, filtering on the fly my $cpio = Archive::Cpio->new; $cpio->read_with_handler(\*STDIN, sub { my ($e) = @_; if ($e->name ne 'foo') { $cpio->write_one(\*STDOUT, $e); } }); $cpio->write_trailer(\*STDOUT); =head1 DESCRIPTION Archive::Cpio provides a few functions to read and write cpio files. =cut =head2 Archive::Cpio->new() Create an object =cut sub new { my ($class, %options) = @_; bless \%options, $class; } =head2 $cpio->read($filename) =head2 $cpio->read($filehandle) Reads the cpio file =cut sub read { my ($cpio, $file) = @_; my $IN; if (ref $file) { $IN = $file; } else { open($IN, '<', $file) or die "can't open $file: $!\n"; } read_with_handler($cpio, $IN, sub { my ($e) = @_; push @{$cpio->{list}}, $e; }); } =head2 $cpio->write($filename) =head2 $cpio->write($filehandle) Writes the entries and the trailer =cut sub write { my ($cpio, $file, $fmt) = @_; my $OUT; if (ref $file) { $OUT = $file; } else { open($OUT, '>', $file) or die "can't open $file: $!\n"; } # Set the format if not done or if specified if (!$cpio->{archive_format} || $fmt) { $cpio->{archive_format} = _create_archive_format($fmt || 'ODC'); } $cpio->write_one($OUT, $_) foreach @{$cpio->{list}}; $cpio->write_trailer($OUT); } =head2 $cpio->remove(@filenames) Removes any entries with names matching any of the given filenames from the in-memory archive =cut sub remove { my ($cpio, @filenames) = @_; $cpio->{list} or die "can't remove from nothing\n"; my %filenames = map { $_ => 1 } @filenames; @{$cpio->{list}} = grep { !$filenames{$_->name} } @{$cpio->{list}}; } =head2 $cpio->get_files([ @filenames ]) Returns a list of C (after a C<$cpio->read>) =cut sub get_files { my ($cpio, @list) = @_; if (@list) { map { get_file($cpio, $_) } @list; } else { @{$cpio->{list}}; } } =head2 $cpio->get_file($filename) Returns the C matching C<$filename< (after a C<$cpio->read>) =cut sub get_file { my ($cpio, $file) = @_; foreach (@{$cpio->{list}}) { $_->name eq $file and return $_; } undef; } =head2 $cpio->add_data($filename, $data, $opthashref) Takes a filename, a scalar full of data and optionally a reference to a hash with specific options. Will add a file to the in-memory archive, with name C<$filename> and content C<$data>. Specific properties can be set using C<$opthashref>. =cut sub add_data { my ($cpio, $filename, $data, $opthashref) = @_; my $entry = $opthashref || {}; $entry->{name} = $filename; $entry->{data} = $data; $entry->{nlink} ||= 1; $entry->{mode} ||= 0100644; push @{$cpio->{list}}, Archive::Cpio::File->new($entry); } =head2 $cpio->read_with_handler($filehandle, $coderef) Calls the handler function on each header. An C is passed as a parameter =cut sub read_with_handler { my ($cpio, $F, $handler) = @_; my $FHwp = Archive::Cpio::FileHandle_with_pushback->new($F); $cpio->{archive_format} = detect_archive_format($FHwp); while (my $entry = $cpio->{archive_format}->read_one($FHwp)) { $entry = Archive::Cpio::File->new($entry); $handler->($entry); } } =head2 $cpio->write_one($filehandle, $entry) Writes a C (beware, a valid cpio needs a trailer using C) =cut sub write_one { my ($cpio, $F, $entry) = @_; $cpio->{archive_format}->write_one($F, $entry); } =head2 $cpio->write_trailer($filehandle) Writes the trailer to finish the cpio file =cut sub write_trailer { my ($cpio, $F) = @_; $cpio->{archive_format}->write_trailer($F); } sub _default_magic { my ($archive_format) = @_; my $magics = Archive::Cpio::Common::magics(); my %format2magic = reverse %$magics; $format2magic{$archive_format} or die "unknown archive_format $archive_format\n"; } sub _create_archive_format { my ($archive_format, $magic) = @_; $magic ||= _default_magic($archive_format); # perl_checker: require Archive::Cpio::NewAscii # perl_checker: require Archive::Cpio::OldBinary my $class = "Archive::Cpio::$archive_format"; eval "require $class"; return $class->new($magic); } sub detect_archive_format { my ($FHwp) = @_; my $magics = Archive::Cpio::Common::magics(); my $max_length = max(map { length $_ } values %$magics); my $s = $FHwp->read_ahead($max_length); foreach my $magic (keys %$magics) { my $archive_format = $magics->{$magic}; begins_with($s, $magic) or next; #warn "found magic for $archive_format\n"; # perl_checker: require Archive::Cpio::NewAscii # perl_checker: require Archive::Cpio::OldBinary return _create_archive_format($archive_format, $magic); } die "invalid archive\n"; } =head1 AUTHOR Pascal Rigaux =cut Archive-Cpio-0.10/Makefile.PL0000644000175000017500000000037511754141654015612 0ustar prigauxprigauxuse ExtUtils::MakeMaker; WriteMakefile( NAME => 'Archive::Cpio', VERSION_FROM => 'lib/Archive/Cpio.pm', ABSTRACT_FROM => 'lib/Archive/Cpio.pm', EXE_FILES => ['bin/cpio-filter'], AUTHOR => 'Pixel ', ); Archive-Cpio-0.10/bin/0000755000175000017500000000000012615431032014370 5ustar prigauxprigauxArchive-Cpio-0.10/bin/cpio-filter0000644000175000017500000000234211754141654016544 0ustar prigauxprigaux#!/usr/bin/perl use Archive::Cpio; use Getopt::Long; =head1 NAME cpio-filter - transform a cpio archive =head1 SYNOPSIS cpio-filter [--exclude ] [--in-place] [] =head1 DESCRIPTION Transform a cpio archive on the fly. Reads on stdin and output on stderr =head1 AUTHOR Pascal Rigaux =cut my %options = ( 'exclude=s' => \ (my $exclude), 'in-place|i' => \ (my $in_place), ); sub usage { die "usage: cpio-filter [--exclude ] [--in-place] []\n"; } GetOptions(%options) or usage(); @ARGV <= 1 or usage(); if ($in_place) { @ARGV or die "you can't use --in-place without giving a cpio file\n"; } my ($file) = @ARGV; sub exclude { my ($e) = @_; $exclude && $e->name =~ m!(^|/)${exclude}($|/)!; } my $cpio = Archive::Cpio->new; if ($in_place) { $cpio->read($file); $cpio->remove(map { exclude($_) ? $_->name : () } $cpio->get_files); $cpio->write($file); } else { my $IN; if ($file) { open($IN, '<', $file) or die "can't open $file: $!\n"; } else { $IN = \*STDIN; } $cpio->read_with_handler($IN, sub { my ($e) = @_; $cpio->write_one(\*STDOUT, $e) if !exclude($e); }); $cpio->write_trailer(\*STDOUT); } Archive-Cpio-0.10/META.json0000644000175000017500000000160412615431032015242 0ustar prigauxprigaux{ "abstract" : "module for manipulations of cpio archives", "author" : [ "Pixel " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.150005", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Archive-Cpio", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "version" : "0.10", "x_serialization_backend" : "JSON::PP version 2.27203" }