1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
|
#!/usr/bin/perl
#
# Package for converting from a .rpm file.
package From::rpm;
use strict;
# Query a rpm file for fields, and return a hash of the fields found.
# Pass the filename of the rpm file to query.
sub GetFields { my ($self,$file)=@_;
my %fields;
# This maps rpm fields (the keys) to the name we want
# for each field (the values).
my %fieldtrans;
# Get the scripts fields too?
if ($main::scripts) {
%fieldtrans=(
'PREIN' => 'PREINST',
'POSTIN' => 'POSTINST',
'PREUN' => 'PRERM',
'POSTUN' => 'POSTRM',
);
}
# These fields need no translation.
my $field;
foreach $field ('NAME','VERSION','RELEASE','ARCH','CHANGELOGTEXT','SUMMARY',
'DESCRIPTION', 'COPYRIGHT') {
$fieldtrans{$field}=$field;
}
# Use --queryformat to pull out all the fields we need.
foreach $field (keys(%fieldtrans)) {
$_=`rpm -qp $file --queryformat \%{$field}`;
$fields{$fieldtrans{$field}}=$_ if $_ ne '(none)';
}
# DEFAULTPREFIX is special because it only exists in old versions of rpm.
$_=`rpm -qp $file --queryformat \%{DEFAULTPREFIX} 2>/dev/null`;
$fields{DEFAULTPREFIX}=$_ if $_ ne '(none)';
if ($main::scripts) {
# Fix up the scripts - they are always shell scripts, so make them so.
foreach $field ('PREINST','POSTINST','PRERM','POSTRM') {
$fields{$field}="#!/bin/sh\n$fields{$field}" if $fields{$field};
}
}
# Get the conffiles list.
# TOCHECK: if this is a relocatable package and DEFAULTPREFIX is set,
# do we need to prepend DEFAULTPREFIX to each of these filenames?
$fields{CONFFILES}=`rpm -qcp $file`;
# Include the output of rpm -qi in the copyright file.
$fields{COPYRIGHT_EXTRA}=`rpm -qpi $file`;
# Get the filelist, it's used in the parent directory check in Unpack().
$fields{FILELIST}=`rpm -qpl $file`;
# Sanity check fields.
if (!$fields{SUMMARY}) {
# Older rpms will have no summary, but will have a
# description. We'll take the 1st line out of the
# description, and use it for the summary.
($fields{SUMMARY})=($fields{DESCRIPTION}."\n")=~m/(.*?)\n/m;
# Fallback.
if (!$fields{SUMMARY}) {
$fields{SUMMARY}="Converted RPM package";
}
}
if (!$fields{COPYRIGHT}) {
$fields{COPYRIGHT}="unknown";
}
if (!$fields{DESCRIPTION}) {
$fields{DESCRIPTION}=$fields{SUMMARY};
}
# Convert ARCH into string, if it isn't already a string.
if ($fields{ARCH} eq 1) {
$fields{ARCH}='i386';
}
elsif ($fields{ARCH} eq 2) {
$fields{ARCH}='alpha';
}
elsif ($fields{ARCH} eq 3) {
$fields{ARCH}='sparc';
}
elsif ($fields{ARCH} eq 6) {
$fields{ARCH}='m68k';
}
elsif ($fields{ARCH} eq "noarch") { # noarch = all
$fields{ARCH}='all';
}
if ($fields{RELEASE} eq undef || $fields{VERSION} eq undef|| !$fields{NAME}) {
Alien::Error("Error querying rpm file.");
}
$fields{RELEASE}++ unless $main::keep_version;
$fields{DISTRIBUTION}="Red Hat";
return %fields;
}
# Unpack a rpm file.
sub Unpack { my ($self,$file,%fields)=@_;
Alien::SafeSystem("(cd ..;rpm2cpio $file) | cpio --extract --make-directories --no-absolute-filenames --preserve-modification-time",
"Error unpacking $file\n");
# This whole block is just in for backwards compatability with old versions
# of rpm.
if ($fields{DEFAULTPREFIX} ne undef) {
print "Moving unpacked files into $fields{DEFAULTPREFIX}\n";
# We have extracted the package, but it's in the wrong place. Move it
# to be under the DEFAULTPREFIX directory.
# First, get a list of files to move.
my $filelist=join ' ',glob('*');
# Now, make the destination directory.
my $collect=undef;
foreach (split(m:/:,$fields{DEFAULTPREFIX})) {
if ($_ ne undef) { # this keeps us from using anything but relative paths.
$collect.="$_/";
mkdir $collect,0755 || Alien::Error("Unable to make directory: $collect: $!");
}
}
# Now move all files in the package to the directory we made.
Alien::SafeSystem("mv $filelist ./$fields{DEFAULTPREFIX}",
"Error moving unpacked files into the default prefix directory\n");
}
# When cpio extracts the file, any child directories that are present, but
# whose parent directories are not, end up mode 700. This next block corrects
# that to 755, which is more reasonable.
#
# Of course, this whole thing assumes we get the filelist in sorted order.
my $lastdir=undef;
foreach $file (split(/\n/,$fields{FILELIST})) {
$file=~s/^\///;
if (($lastdir && $file=~m:^\Q$lastdir\E/[^/]*$: eq undef) || !$lastdir) {
# We've found one of the nasty directories. Fix it up.
#
# Note that I strip the trailing filename off $file here, for two
# reasons. First, it makes the loop easier, we don't need to fix the
# perms on the last file, after all! Second, it makes the -d test below
# fire, which saves us from trying to fix a parent directory twice.
($file)=$file=~m:(.*)/.*?:;
my $dircollect=undef;
my $dir;
foreach $dir (split(/\//,$file)) {
$dircollect.="$dir/";
chmod 0755,$dircollect; # TADA!
}
}
if (-d "./$file") {
$lastdir=$file;
}
}
}
1
|