Code:
#!/usr/bin/perl -w
########################################################################
=head1 NAME
deb_digger.pl
=head1 SYNOPSIS
B<deb_digger.pl> <wanted package> [base dir]
Where <wanted package> is the package to extract and [base dir] is
the (optional) directory to save the extracted deb file to.
=head1 DESCRIPTION
Attempts to extract and rebuild a usable Debian package using nothing
more than the files/metadata for an installed Debian package.
The motivation for this has to do with wanting to create a custom
Knoppix-from-scratch live CD without having to either pare down an
existing knoppix CD or build up a minimalist derivative such as DSL.
Ideally, I'd like to extract the Knoppix specific packages from a live Knoppix
session ala:
for i in `dpkg-query -W --showformat='${Package}\n' | grep -i knoppix` ;
do
echo "### $i #######################################"
perl deb_digger.pl $i
echo ""
done
and apply the resulting deb files to a vanilla Debian install.
=head1 LIMITATIONS
This will neither slice, dice or make Julianne fries. But wait, if you
act now you won't get a bonus set of ginzu steak knifes or a pocket
fisherman either.
=head1 AUTHOR
gsiems
=head1 HISTORY
2006.02.07 Created.
=cut
########################################################################
use strict;
my $wanted_package = $ARGV[0] || die "Usage: $0 <wanted package> [base dir]\n";
my $base_dir = $ARGV[1] || './dug_up_debs';
my %deb = get_deb_data($wanted_package);
# control file
$deb{control} = get_control_file($wanted_package);
die "No control file found for $wanted_package.\n" unless ($deb{control});
# file list
my @file_list = get_file_list($wanted_package);
die "No list file found for $wanted_package.\n" unless (@file_list);
push @{$deb{list}}, @file_list;
# MD5's
my @md5sums = get_md5sums($wanted_package);
die "No MD5's for $wanted_package.\n" unless (@md5sums);
push @{$deb{md5sums}}, @md5sums;
# What shall we name the deb?
my $deb_dir = "$base_dir/${wanted_package}";
for (qw(version architecture)) {
$deb_dir .= '-' . $deb{$_} if ($deb{$_});
}
`rm -rf ${deb_dir}` if (-d ${deb_dir});
#######################################
# Write/copy/create the control.tar.gz pieces
`mkdir -p ${deb_dir}/DEBIAN`;
# write the control, list, and md5sums files
write_file("${deb_dir}/DEBIAN/control", '644', $deb{control});
write_file("${deb_dir}/DEBIAN/list", '644', @{$deb{list}});
write_file("${deb_dir}/DEBIAN/md5sums", '644', @{$deb{md5sums}});
# copy any other files found in /var/lib/dpkg/info/
foreach (`ls /var/lib/dpkg/info/${wanted_package}.*`) {
chomp;
my $file_name = filename($_);
my $target = "${deb_dir}/DEBIAN/" . (split /\./, $file_name)[-1];
`cp -p ${_} ${target}` unless (-e $target);
}
#######################################
# Write/copy/create the data.tar.gz pieces
foreach my $source (@{$deb{list}}) {
chomp $source;
my (undef, undef, $mode, undef, $uid, $gid) = stat $source;
my $target = "${deb_dir}/${source}";
if (-d $source) {
`mkdir -p $target`;
chmod $mode, $target;
`chown $uid.$gid $target`;
} elsif (-f $source) {
`cp -p $source $target`;
}
}
#######################################
`dpkg-deb --build ${deb_dir}`;
#######################################################################
sub filename {
my $filename = (split /\//, $_[0])[-1];
return $filename;
}
sub read_file {
my ($source) = @_;
open(IN, '<', $source) || die "Could not open $source for input. $!\n";
my @ary = (<IN>);
close IN;
return wantarray() ? @ary : (join '', @ary);
}
sub write_file {
my $target = shift;
my $mode = shift;
open(OUT, '>', $target) or die "Could not open $target for output. $!\n";
print OUT @_;
close OUT;
chmod $mode, $target;
}
sub get_control_file {
my ($wanted_package, $status_file) = @_;
$status_file ||= '/var/lib/dpkg/status';
my $control;
my $raw_data = read_file($status_file);
# ASSERTION: it appears theat the first attribute in the status file
# for any given package is the package name.
foreach my $pkg_control (split /Package:\s+/, $raw_data) {
my ($package) = split /\n/, $pkg_control, 2;
next unless ($package && $package eq $wanted_package);
$control = 'Package: ';
foreach (split /\n/, $pkg_control) {
next if (/^Status:/);
$control .= $_ . "\n";
}
last;
}
return $control;
}
sub get_deb_data {
my ($wanted_package) = @_;
my %deb_data;
my $cmd = q(dpkg-query -W --showformat='${Version}\t${Architecture}');
my $result = (`$cmd ${wanted_package}`)[0];
unless ($result =~ /No packages found/) {
my ($version, $architecture) = split /\t/, $result;
$deb_data{version} = $version || '0.0.0';
$deb_data{architecture} = $architecture || '';
}
return %deb_data;
}
sub get_file_list {
my ($wanted_package, $list_file) = @_;
$list_file ||= "/var/lib/dpkg/info/${wanted_package}.list";
my @list;
if (-f $list_file) {
my @listed = read_file($list_file);
chomp @listed;
foreach (@listed) {
if (-d $_ || -f $_) {
push @list, "$_\n";
} else {
warn "File or directory is missing: $_.\n";
}
}
}
return @list;
}
sub get_md5sums {
my ($wanted_package, $md5_file) = @_;
$md5_file ||= "/var/lib/dpkg/info/${wanted_package}.md5sums";
my @md5sums;
if (-f $md5_file) {
my @md5s = read_file($md5_file);
chomp @md5s;
foreach (@md5s) {
my ($md5, $file) = split /\s+/, $_, 2;
$file = '/' . $file;
if (-f $file) {
my $check = (`md5sum $file`)[0];
my ($md5_check) = split /\s+/, $check;
($md5_check eq $md5) || warn "MD5 for $file does not match.\n";
push @md5sums, $check;
} else {
warn "File $file not found.\n";
}
}
} else {
warn "No MD5 file found for $wanted_package.\n";
}
return @md5sums;
}
__END__
Reply With Quote
