mirror of
https://github.com/Project-OSS-Revival/alien.git
synced 2026-04-24 14:00:17 +00:00
* Added -v to enable verbose mode, which lists each shell command
as it is run. Also added --veryverbose for verbose with command
output too.
* Use -V for version. (-v used to be documented, but never worked)
This commit is contained in:
154
Alien/Package.pm
154
Alien/Package.pm
@@ -9,6 +9,7 @@ Alien::Package - an object that represents a package
|
||||
package Alien::Package;
|
||||
use strict;
|
||||
use vars qw($AUTOLOAD);
|
||||
our $verbose=0;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
@@ -143,22 +144,6 @@ yet. It will be set at unpack time.
|
||||
|
||||
=over 4
|
||||
|
||||
=item new
|
||||
|
||||
Returns a new object of this class. Optionally, you can pass in named
|
||||
parameters that specify the values of any fields in the class.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my $this=bless ({}, $class);
|
||||
$this->init;
|
||||
$this->$_(shift) while $_=shift; # run named parameters as methods
|
||||
return $this;
|
||||
}
|
||||
|
||||
=item init
|
||||
|
||||
This is called by new(). It's a handy place to set fields, etc, without
|
||||
@@ -168,20 +153,6 @@ having to write your own new() method.
|
||||
|
||||
sub init {}
|
||||
|
||||
=item checkfile
|
||||
|
||||
This is a class method. Pass it a filename, and it will return true if it
|
||||
looks like the file is a package of the type handled by the class.
|
||||
|
||||
=cut
|
||||
|
||||
sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
|
||||
return ''; # children override this.
|
||||
}
|
||||
|
||||
=item install
|
||||
|
||||
Simply installs a package file. The filename is passed.
|
||||
@@ -241,7 +212,7 @@ sub scan {
|
||||
my $file=$this->filename;
|
||||
|
||||
if (! -e $file) {
|
||||
die "`$file' does not exist; cannot read.";
|
||||
die "$file does not exist; cannot read.";
|
||||
}
|
||||
}
|
||||
|
||||
@@ -260,12 +231,12 @@ sub unpack {
|
||||
my $this=shift;
|
||||
|
||||
my $workdir = $this->name."-".$this->version;
|
||||
mkdir($workdir, 0755) ||
|
||||
$this->do("mkdir $workdir") or
|
||||
die "unable to mkdir $workdir: $!";
|
||||
# If the parent directory is suid/sgid, mkdir will make the root
|
||||
# directory of the package inherit those bits. That is a bad thing,
|
||||
# so explicitly force perms to 755.
|
||||
chmod 0755, $workdir;
|
||||
$this->do("chmod 755 $workdir");
|
||||
$this->unpacked_tree($workdir);
|
||||
}
|
||||
|
||||
@@ -325,10 +296,10 @@ sub DESTROY {
|
||||
return if (! defined $this->unpacked_tree || $this->unpacked_tree eq '');
|
||||
# This should never happen, but it pays to check.
|
||||
if ($this->unpacked_tree eq '/') {
|
||||
die "alien internal error: unpacked_tree is set to `/'. Please file a bug report!";
|
||||
die "alien internal error: unpacked_tree is set to '/'. Please file a bug report!";
|
||||
}
|
||||
(system('rm', '-rf', $this->unpacked_tree) == 0)
|
||||
or die "unable to delete temporary directory `".$this->unpacked_tree."`: $!";
|
||||
$this->do('rm', '-rf', $this->unpacked_tree)
|
||||
or die "unable to delete temporary directory '".$this->unpacked_tree."': $!";
|
||||
$this->unpacked_tree('');
|
||||
}
|
||||
|
||||
@@ -355,6 +326,117 @@ sub AUTOLOAD {
|
||||
|
||||
=back
|
||||
|
||||
=head1 CLASS DATA
|
||||
|
||||
=over 4
|
||||
|
||||
=item $Alien::Package::verbose
|
||||
|
||||
If set to a nonzero value, the shell commands that are run should be output.
|
||||
If set to a value greater than 1, any output of the commands should also be
|
||||
output.
|
||||
|
||||
=back
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
These methods can be called on either an object or on the class itself.
|
||||
|
||||
=cut
|
||||
|
||||
=over 4
|
||||
|
||||
=item new
|
||||
|
||||
Returns a new object of this class. Optionally, you can pass in named
|
||||
parameters that specify the values of any fields in the class.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my $this=bless ({}, $class);
|
||||
$this->init;
|
||||
$this->$_(shift) while $_=shift; # run named parameters as methods
|
||||
return $this;
|
||||
}
|
||||
|
||||
=item checkfile
|
||||
|
||||
Pass it a filename, and it will return true if it looks like the file is
|
||||
a package of the type handled by the class.
|
||||
|
||||
=cut
|
||||
|
||||
sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
|
||||
return ''; # children override this.
|
||||
}
|
||||
|
||||
=item do
|
||||
|
||||
Runs a shell command. Is verbose or not depending on the value of
|
||||
$Alien::Package::verbose. Returns true if the command succeeds,
|
||||
false on failure.
|
||||
|
||||
=cut
|
||||
|
||||
sub do {
|
||||
my $whatever=shift;
|
||||
my @command=@_;
|
||||
if ($Alien::Package::verbose) {
|
||||
print "\t@command\n";
|
||||
}
|
||||
my $pid=fork;
|
||||
if (!$pid) {
|
||||
# child
|
||||
if ($Alien::Package::verbose < 2) {
|
||||
# just closing it won't do
|
||||
open(STDOUT, ">/dev/null");
|
||||
}
|
||||
exec(@command);
|
||||
exit 1;
|
||||
}
|
||||
else {
|
||||
# parent
|
||||
return (waitpid($pid, 0) > 0);
|
||||
}
|
||||
}
|
||||
|
||||
=item runpipe
|
||||
|
||||
This is similar to backticks, but honors $Alien::Package::verbose, logging
|
||||
the command run if asked to. The output of the command returned.
|
||||
|
||||
=cut
|
||||
|
||||
sub runpipe {
|
||||
my $whatever=shift;
|
||||
my @command=@_;
|
||||
if ($Alien::Package::verbose) {
|
||||
print "\t@command\n";
|
||||
}
|
||||
if (wantarray) {
|
||||
my @ret=`@command`;
|
||||
if ($Alien::Package::verbose >= 2) {
|
||||
print @ret;
|
||||
}
|
||||
return @ret;
|
||||
}
|
||||
else {
|
||||
my $ret=`@command`;
|
||||
if ($Alien::Package::verbose >= 2) {
|
||||
print $ret."\n";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Joey Hess <joey@kitenet.net>
|
||||
|
||||
@@ -87,7 +87,7 @@ sub install {
|
||||
my $this=shift;
|
||||
my $deb=shift;
|
||||
|
||||
(system("dpkg", "--no-force-overwrite", "-i", $deb) == 0)
|
||||
$this->do("dpkg", "--no-force-overwrite", "-i", $deb)
|
||||
or die "Unable to install";
|
||||
}
|
||||
|
||||
@@ -107,7 +107,7 @@ sub test {
|
||||
return map { s/\n//; $_ }
|
||||
grep {
|
||||
! /unknown-section alien/
|
||||
} `lintian $deb`;
|
||||
} $this->runpipe("lintian $deb");
|
||||
}
|
||||
else {
|
||||
return "lintian not available, so not testing";
|
||||
@@ -127,7 +127,7 @@ sub getcontrolfile {
|
||||
my $file=$this->filename;
|
||||
|
||||
if ($this->have_dpkg_deb) {
|
||||
return `dpkg-deb --info $file $controlfile 2>/dev/null`;
|
||||
return $this->runpipe("dpkg-deb --info $file $controlfile 2>/dev/null");
|
||||
}
|
||||
else {
|
||||
# Solaris tar doesn't support O
|
||||
@@ -140,7 +140,7 @@ sub getcontrolfile {
|
||||
" cat $file; cd /; rm -rf /tmp/tar_out.$$)";
|
||||
}
|
||||
my $getcontrol = "ar -p $file control.tar.gz | gzip -dc | ".tar_out($controlfile)." 2>/dev/null";
|
||||
return `$getcontrol`
|
||||
return $this->runpipe($getcontrol);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -205,15 +205,15 @@ sub scan {
|
||||
$this->conffiles(\@conffiles);
|
||||
|
||||
# Read in the list of all files.
|
||||
# Note that tar doesn't supply a leading `/', so we have to add that.
|
||||
# Note that tar doesn't supply a leading '/', so we have to add that.
|
||||
my @filelist;
|
||||
if ($this->have_dpkg_deb) {
|
||||
@filelist=map { chomp; s:\./::; "/$_" }
|
||||
`dpkg-deb --fsys-tarfile $file | tar tf -`;
|
||||
$this->runpipe("dpkg-deb --fsys-tarfile $file | tar tf -");
|
||||
}
|
||||
else {
|
||||
@filelist=map { chomp; s:\./::; "/$_" }
|
||||
`ar -p $file data.tar.gz | gzip -dc | tar tf -`;
|
||||
$this->runpipe("ar -p $file data.tar.gz | gzip -dc | tar tf -");
|
||||
}
|
||||
$this->filelist(\@filelist);
|
||||
|
||||
@@ -237,12 +237,12 @@ sub unpack {
|
||||
my $file=$this->filename;
|
||||
|
||||
if ($this->have_dpkg_deb) {
|
||||
(system("dpkg-deb", "-x", $file, $this->unpacked_tree) == 0)
|
||||
or die "Unpacking of `$file' failed: $!";
|
||||
$this->do("dpkg-deb", "-x", $file, $this->unpacked_tree)
|
||||
or die "Unpacking of '$file' failed: $!";
|
||||
}
|
||||
else {
|
||||
(system("ar -p $file data.tar.gz | gzip -dc | (cd ".$this->unpacked_tree."; tar xpf -)") == 0)
|
||||
or die "Unpacking of `$file' failed: $!";
|
||||
$this->do("ar -p $file data.tar.gz | gzip -dc | (cd ".$this->unpacked_tree."; tar xpf -)")
|
||||
or die "Unpacking of '$file' failed: $!";
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -293,20 +293,20 @@ sub prep {
|
||||
my $this=shift;
|
||||
my $dir=$this->unpacked_tree || die "The package must be unpacked first!";
|
||||
|
||||
mkdir("$dir/debian", 0755) ||
|
||||
$this->do("mkdir $dir/debian") ||
|
||||
die "mkdir $dir/debian failed: $!";
|
||||
|
||||
# Use a patch file to debianize?
|
||||
if (defined $this->patchfile) {
|
||||
# The -f passed to zcat makes it pass uncompressed files
|
||||
# through without error.
|
||||
(system("zcat -f ".$this->patchfile." | (cd $dir; patch -p1)") == 0)
|
||||
$this->do("zcat -f ".$this->patchfile." | (cd $dir; patch -p1)")
|
||||
or die "patch error: $!";
|
||||
# Look for .rej files.
|
||||
die "patch failed with .rej files; giving up"
|
||||
if `find $dir -name "*.rej"`;
|
||||
system('find', '.', '-name', '*.orig', '-exec', 'rm', '{}', ';');
|
||||
chmod 0755, "$dir/debian/rules";
|
||||
if $this->runpipe("find $dir -name \"*.rej\"");
|
||||
$this->do('find', '.', '-name', '*.orig', '-exec', 'rm', '{}', ';');
|
||||
$this->do("chmod", 755, "$dir/debian/rules");
|
||||
|
||||
# It's possible that the patch file changes the debian
|
||||
# release or version. Parse changelog to detect that.
|
||||
@@ -406,6 +406,9 @@ binary-arch: build
|
||||
dh_clean -k
|
||||
dh_installdirs
|
||||
|
||||
dh_installdocs
|
||||
dh_installchangelogs
|
||||
|
||||
# Copy the packages's files.
|
||||
find . -maxdepth 1 -mindepth 1 -not -name debian -print0 | \\
|
||||
xargs -0 -r -i cp -a {} debian/\$(PACKAGE)
|
||||
@@ -414,8 +417,8 @@ binary-arch: build
|
||||
# If you need to move files around in debian/\$(PACKAGE) or do some
|
||||
# binary patching, do it here
|
||||
#
|
||||
dh_installdocs
|
||||
dh_installchangelogs
|
||||
|
||||
|
||||
# This has been known to break on some wacky binaries.
|
||||
# dh_strip
|
||||
dh_compress
|
||||
@@ -431,7 +434,7 @@ binary: binary-indep binary-arch
|
||||
.PHONY: build clean binary-indep binary-arch binary
|
||||
EOF
|
||||
close OUT;
|
||||
chmod 0755,"$dir/debian/rules";
|
||||
$this->do("chmod", 755, "$dir/debian/rules");
|
||||
|
||||
# Save any scripts.
|
||||
if ($this->usescripts) {
|
||||
@@ -456,10 +459,10 @@ EOF
|
||||
if (-d "$dir/$olddir" && ! -e "$dir/$dirtrans{$olddir}") {
|
||||
# Ignore failure..
|
||||
my ($dirbase)=$dirtrans{$olddir}=~/(.*)\//;
|
||||
system("install", "-d", "$dir/$dirbase");
|
||||
system("mv", "$dir/$olddir", "$dir/$dirtrans{$olddir}");
|
||||
$this->do("install", "-d", "$dir/$dirbase");
|
||||
$this->do("mv", "$dir/$olddir", "$dir/$dirtrans{$olddir}");
|
||||
if (-d "$dir/$olddir") {
|
||||
system("rmdir", "-p", "$dir/$olddir");
|
||||
$this->do("rmdir", "-p", "$dir/$olddir");
|
||||
}
|
||||
}
|
||||
else {
|
||||
@@ -479,7 +482,7 @@ sub build {
|
||||
my $this=shift;
|
||||
|
||||
chdir $this->unpacked_tree;
|
||||
my $log=`debian/rules binary 2>&1`;
|
||||
my $log=$this->runpipe("debian/rules binary 2>&1");
|
||||
if ($?) {
|
||||
die "Package build failed. Here's the log:\n", $log;
|
||||
}
|
||||
@@ -503,15 +506,15 @@ sub cleantree {
|
||||
if (! -e "$dir/$olddir" && -d "$dir/$dirtrans{$olddir}") {
|
||||
# Ignore failure.. (should I?)
|
||||
my ($dirbase)=$dir=~/(.*)\//;
|
||||
system("install", "-d", "$dir/$dirbase");
|
||||
system("mv", "$dir/$dirtrans{$olddir}", "$dir/$olddir");
|
||||
$this->do("install", "-d", "$dir/$dirbase");
|
||||
$this->do("mv", "$dir/$dirtrans{$olddir}", "$dir/$olddir");
|
||||
if (-d "$dir/$dirtrans{$olddir}") {
|
||||
system("rmdir", "-p", "$dir/$dirtrans{$olddir}");
|
||||
$this->do("rmdir", "-p", "$dir/$dirtrans{$olddir}");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
system("rm", "-rf", "$dir/debian");
|
||||
$this->do("rm", "-rf", "$dir/debian");
|
||||
}
|
||||
|
||||
=item package
|
||||
@@ -643,7 +646,7 @@ Returns the date, in rfc822 format.
|
||||
sub date {
|
||||
my $this=shift;
|
||||
|
||||
my $date=`822-date`;
|
||||
my $date=$this->runpipe("822-date");
|
||||
chomp $date;
|
||||
if (!$date) {
|
||||
die "822-date did not return a valid result. You probably need to install the dpkg-dev debian package";
|
||||
@@ -673,7 +676,7 @@ sub email {
|
||||
close MAILNAME;
|
||||
}
|
||||
if (!$mailname) {
|
||||
$mailname=`hostname -f`;
|
||||
$mailname=$this->runpipe("hostname -f");
|
||||
chomp $mailname;
|
||||
}
|
||||
return "$login\@$mailname";
|
||||
|
||||
@@ -15,10 +15,6 @@ use base qw(Alien::Package::Rpm);
|
||||
This is an object class that represents a lsb package. It is derived from
|
||||
Alien::Package::Rpm.
|
||||
|
||||
=head1 FIELDS
|
||||
|
||||
=over 4
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
@@ -34,7 +30,7 @@ sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
return unless $file =~ m/^lsb-.*\.rpm$/;
|
||||
my @deps=`LANG=C rpm -qp -R $file`;
|
||||
my @deps=$this->runpipe("LANG=C rpm -qp -R $file");
|
||||
return 1 if grep { s/\s+//g; $_ eq 'lsb' } @deps;
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -104,7 +104,7 @@ sub install {
|
||||
my $pkg=shift;
|
||||
|
||||
if (-x "/usr/sbin/pkgadd") {
|
||||
(system("/usr/sbin/pkgadd", "-d .", "$pkg") == 0)
|
||||
$this->do("/usr/sbin/pkgadd", "-d .", "$pkg")
|
||||
or die "Unable to install";
|
||||
}
|
||||
else {
|
||||
@@ -124,7 +124,7 @@ sub scan {
|
||||
my $file=$this->filename;
|
||||
my $tdir="pkg-scan-tmp.$$";
|
||||
|
||||
mkdir($tdir, 0755) || die "Error making $tdir: $!\n";
|
||||
$this->do("mkdir", $tdir) || die "Error making $tdir: $!\n";
|
||||
|
||||
my $pkgname;
|
||||
if (-x "/usr/bin/pkginfo" && -x "/usr/bin/pkgtrans") {
|
||||
@@ -137,7 +137,7 @@ sub scan {
|
||||
close INFO;
|
||||
|
||||
# Extract the files
|
||||
(system("/usr/bin/pkgtrans -i $file $tdir $pkgname") == 0)
|
||||
$this->do("/usr/bin/pkgtrans -i $file $tdir $pkgname")
|
||||
|| die "Error running pkgtrans: $!\n";
|
||||
|
||||
open(INFO, "$tdir/$pkgname/pkginfo")
|
||||
@@ -205,7 +205,7 @@ sub scan {
|
||||
if -e "$file/".scripttrans()->{$script};
|
||||
}
|
||||
|
||||
system ("rm -rf $tdir");
|
||||
$this->do("rm -rf $tdir");
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -230,8 +230,8 @@ sub unpack {
|
||||
|
||||
if (-x "/usr/bin/pkgtrans") {
|
||||
my $workdir = $this->name."-".$this->version;;
|
||||
mkdir($workdir, 0755) || die "unable to mkdir $workdir: $!\n";
|
||||
(system("/usr/bin/pkgtrans $file $workdir $pkgname") == 0)
|
||||
$this->do("mkdir", $workdir) || die "unable to mkdir $workdir: $!\n";
|
||||
$this->do("/usr/bin/pkgtrans $file $workdir $pkgname")
|
||||
|| die "unable to extract $file: $!\n";
|
||||
rename("$workdir/$pkgname", "$ {workdir}_1")
|
||||
|| die "unable rename $workdir/$pkgname: $!\n";
|
||||
@@ -257,7 +257,7 @@ sub prep {
|
||||
# grep {/^\./} readdir DIR;
|
||||
# closedir DIR;
|
||||
|
||||
(system("cd $dir; find . -print | pkgproto > ./prototype") == 0)
|
||||
$this->do("cd $dir; find . -print | pkgproto > ./prototype")
|
||||
|| die "error during pkgproto: $!\n";
|
||||
|
||||
open(PKGPROTO, ">>$dir/prototype")
|
||||
@@ -280,7 +280,7 @@ sub prep {
|
||||
close PKGINFO;
|
||||
print PKGPROTO "i pkginfo=./pkginfo\n";
|
||||
|
||||
mkdir("$dir/install", 0755) || die "unable to mkdir $dir/install: $!";
|
||||
$this->do("mkdir", "$dir/install") || die "unable to mkdir $dir/install: $!";
|
||||
open(COPYRIGHT, ">$dir/install/copyright")
|
||||
|| die "error creating copyright: $!\n";
|
||||
print COPYRIGHT $this->copyright;
|
||||
@@ -295,7 +295,7 @@ sub prep {
|
||||
open (OUT, ">$out") || die "$out: $!";
|
||||
print OUT $data;
|
||||
close OUT;
|
||||
chmod 0755, $out;
|
||||
$this->do("chmod", 755, $out);
|
||||
print PKGPROTO "i $script=$out\n";
|
||||
}
|
||||
close PKGPROTO;
|
||||
@@ -311,14 +311,14 @@ sub build {
|
||||
my $this = shift;
|
||||
my $dir = $this->unpacked_tree;
|
||||
|
||||
(system("cd $dir; pkgmk -r / -d .") == 0)
|
||||
$this->do("cd $dir; pkgmk -r / -d .")
|
||||
|| die "Error during pkgmk: $!\n";
|
||||
|
||||
my $pkgname = $this->converted_name;
|
||||
my $name = $this->name."-".$this->version.".pkg";
|
||||
(system("pkgtrans $dir $name $pkgname") == 0)
|
||||
$this->do("pkgtrans $dir $name $pkgname")
|
||||
|| die "Error during pkgtrans: $!\n";
|
||||
rename "$dir/$name", $name;
|
||||
$this->do("mv", "$dir/$name", $name);
|
||||
return $name;
|
||||
}
|
||||
|
||||
|
||||
@@ -23,6 +23,8 @@ Alien::Package.
|
||||
|
||||
Relocatable rpm packages have a prefixes field.
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
@@ -51,7 +53,7 @@ sub install {
|
||||
my $this=shift;
|
||||
my $rpm=shift;
|
||||
|
||||
(system("rpm -ivh ".(exists $ENV{RPMINSTALLOPT} ? $ENV{RPMINSTALLOPT} : '').$rpm) == 0)
|
||||
$this->do("rpm -ivh ".(exists $ENV{RPMINSTALLOPT} ? $ENV{RPMINSTALLOPT} : '').$rpm)
|
||||
or die "Unable to install";
|
||||
}
|
||||
|
||||
@@ -81,23 +83,23 @@ sub scan {
|
||||
|
||||
# Use --queryformat to pull out all the fields we need.
|
||||
foreach my $field (keys(%fieldtrans)) {
|
||||
$_=`LANG=C rpm -qp --queryformat \%{$field} $file`;
|
||||
$_=$this->runpipe("LANG=C rpm -qp --queryformat \%{$field} $file");
|
||||
$field=$fieldtrans{$field};
|
||||
$_='' if $_ eq '(none)';
|
||||
$this->$field($_);
|
||||
}
|
||||
|
||||
# Get the conffiles list.
|
||||
$this->conffiles([map { chomp; $_ } `LANG=C rpm -qcp $file`]);
|
||||
$this->conffiles([map { chomp; $_ } $this->runpipe("LANG=C rpm -qcp $file")]);
|
||||
if (defined $this->conffiles->[0] &&
|
||||
$this->conffiles->[0] eq '(contains no files)') {
|
||||
$this->conffiles([]);
|
||||
}
|
||||
|
||||
$this->binary_info(scalar `rpm -qpi $file`);
|
||||
$this->binary_info(scalar $this->runpipe("rpm -qpi $file"));
|
||||
|
||||
# Get the filelist.
|
||||
$this->filelist([map { chomp; $_ } `LANG=C rpm -qpl $file`]);
|
||||
$this->filelist([map { chomp; $_ } $this->runpipe("LANG=C rpm -qpl $file")]);
|
||||
if (defined $this->filelist->[0] &&
|
||||
$this->filelist->[0] eq '(contains no files)') {
|
||||
$this->filelist([]);
|
||||
@@ -145,8 +147,8 @@ sub unpack {
|
||||
$this->SUPER::unpack(@_);
|
||||
my $workdir=$this->unpacked_tree;
|
||||
|
||||
(system("rpm2cpio ".$this->filename." | (cd $workdir; cpio --extract --make-directories --no-absolute-filenames --preserve-modification-time) 2>/dev/null") == 0)
|
||||
or die "Unpacking of `".$this->filename."' failed";
|
||||
$this->do("rpm2cpio ".$this->filename." | (cd $workdir; cpio --extract --make-directories --no-absolute-filenames --preserve-modification-time) 2>&1")
|
||||
or die "Unpacking of '".$this->filename."' failed";
|
||||
|
||||
# If the package is relocatable. We'd like to move it to be under
|
||||
# the $this->prefixes directory. However, it's possible that that
|
||||
@@ -168,12 +170,12 @@ sub unpack {
|
||||
foreach (split m:/:, $this->prefixes) {
|
||||
if ($_ ne '') { # this keeps us from using anything but relative paths.
|
||||
$collect.="/$_";
|
||||
mkdir($collect,0755) || die "unable to mkdir $collect: $!";
|
||||
$this->do("mkdir", $collect) || die "unable to mkdir $collect: $!";
|
||||
}
|
||||
}
|
||||
# Now move all files in the package to the directory we made.
|
||||
if (@filelist) {
|
||||
(system("mv", @filelist, "$workdir/".$this->prefixes) == 0)
|
||||
$this->do("mv", @filelist, "$workdir/".$this->prefixes)
|
||||
or die "error moving unpacked files into the default prefix directory: $!";
|
||||
}
|
||||
}
|
||||
@@ -185,7 +187,7 @@ sub unpack {
|
||||
# Note that the next section overrides these default permissions,
|
||||
# if override data exists in the rpm permissions info. And such
|
||||
# data should always exist, so this is probably a no-op.
|
||||
system("find $workdir -type d -perm 700 -print0 | xargs --no-run-if-empty -0 chmod 700");
|
||||
$this->do("find $workdir -type d -perm 700 -print0 | xargs --no-run-if-empty -0 chmod 700");
|
||||
|
||||
# rpm files have two sets of permissions; the set in the cpio
|
||||
# archive, and the set in the control data; which override them.
|
||||
@@ -215,9 +217,11 @@ sub unpack {
|
||||
}
|
||||
next unless -e "$workdir/$file"; # skip broken links
|
||||
if ($> == 0) {
|
||||
chown($uid, $gid, "$workdir/$file") || die "failed chowning $file to $uid\:$gid\: $!";
|
||||
$this->do("chown", "$uid:$gid", "$workdir/$file")
|
||||
|| die "failed chowning $file to $uid\:$gid\: $!";
|
||||
}
|
||||
chmod($mode, "$workdir/$file") || die "failed changing mode of $file to $mode\: $!";
|
||||
$this->do("chmod", sprintf("%lo", $mode), "$workdir/$file")
|
||||
|| die "failed changing mode of $file to $mode\: $!";
|
||||
}
|
||||
$this->owninfo(\%owninfo);
|
||||
|
||||
@@ -339,7 +343,7 @@ sub build {
|
||||
# Ask rpm how it's set up. We want to know what architecture it
|
||||
# will output, and where it will place rpms.
|
||||
my ($rpmarch, $rpmdir);
|
||||
foreach (`rpm --showrc`) {
|
||||
foreach ($this->runpipe("rpm --showrc")) {
|
||||
chomp;
|
||||
if (/^build arch\s+:\s(.*)$/) {
|
||||
$rpmarch=$1;
|
||||
@@ -381,7 +385,7 @@ sub build {
|
||||
|
||||
$opts.=" $ENV{RPMBUILDOPTS}" if exists $ENV{RPMBUILDOPTS};
|
||||
my $command="cd $dir; $buildcmd -bb $opts ".$this->name."-".$this->version."-".$this->release.".spec";
|
||||
my $log=`$command 2>&1`;
|
||||
my $log=$this->runpipe("$command 2>&1");
|
||||
if ($?) {
|
||||
die "Package build failed. Here's the log of the command ($command):\n", $log;
|
||||
}
|
||||
|
||||
@@ -85,7 +85,7 @@ Holds the compression type used in the slp file.
|
||||
|
||||
Holds the slp package format version of the slp file.
|
||||
|
||||
=item
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
@@ -114,7 +114,7 @@ sub install {
|
||||
my $this=shift;
|
||||
my $slp=shift;
|
||||
|
||||
(system("slpi", $slp) == 0)
|
||||
$this->do("slpi", $slp)
|
||||
or die "Unable to install";
|
||||
}
|
||||
|
||||
@@ -163,7 +163,7 @@ sub scan {
|
||||
# Read in the file list.
|
||||
my @filelist;
|
||||
# FIXME: support gzip files too!
|
||||
foreach (`bzip2 -d < $file | tar -tf -`) {
|
||||
foreach ($this->runpipe("bzip2 -d < $file | tar -tf -")) {
|
||||
chomp;
|
||||
s:^\./:/:;
|
||||
$_="/$_" unless m:^/:;
|
||||
@@ -176,7 +176,7 @@ sub scan {
|
||||
$this->distribution('Stampede');
|
||||
$this->origformat('slp');
|
||||
$this->changelogtext('');
|
||||
$this->binary_info(`ls -l $file`);
|
||||
$this->binary_info($this->runpipe("ls -l $file"));
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -195,10 +195,10 @@ sub unpack {
|
||||
my $compresstype=$this->compresstype;
|
||||
|
||||
if ($compresstype == 0) {
|
||||
system("bzip2 -d < $file | (cd ".$this->unpacked_tree."; tar xpf -)")
|
||||
$this->do("bzip2 -d < $file | (cd ".$this->unpacked_tree."; tar xpf -)")
|
||||
}
|
||||
elsif ($compresstype == 1) {
|
||||
system("gzip -dc $file | (cd ".$this->unpacked_tree."; tar xpf -)")
|
||||
$this->do("gzip -dc $file | (cd ".$this->unpacked_tree."; tar xpf -)")
|
||||
}
|
||||
else {
|
||||
die "package uses an unknown compression type, $compresstype (please file a bug report)";
|
||||
@@ -250,7 +250,7 @@ sub build {
|
||||
# something like that, becuase it results in a tar file where all
|
||||
# the files in it start with "./", which is consitent with how
|
||||
# normal stampede files look.
|
||||
(system("(cd ".$this->unpacked_tree."; tar cf - ./*) | bzip2 - > $slp") == 0)
|
||||
$this->do("(cd ".$this->unpacked_tree."; tar cf - ./*) | bzip2 - > $slp")
|
||||
or die "package build failed: $!";
|
||||
|
||||
# Now append the footer.
|
||||
|
||||
@@ -66,7 +66,7 @@ sub install {
|
||||
my $tgz=shift;
|
||||
|
||||
if (-x "/sbin/installpkg") {
|
||||
(system("/sbin/installpkg", "$tgz") == 0)
|
||||
$this->do("/sbin/installpkg", "$tgz")
|
||||
or die "Unable to install";
|
||||
}
|
||||
else {
|
||||
@@ -111,7 +111,7 @@ sub scan {
|
||||
$this->group("unknown");
|
||||
$this->origformat('tgz');
|
||||
$this->changelogtext('');
|
||||
$this->binary_info(`ls -l $file`);
|
||||
$this->binary_info($this->runpipe("ls -l $file"));
|
||||
|
||||
# Now figure out the conffiles. Assume anything in etc/ is a
|
||||
# conffile.
|
||||
@@ -145,7 +145,7 @@ sub scan {
|
||||
|
||||
# Now get the scripts.
|
||||
foreach my $script (keys %{scripttrans()}) {
|
||||
$this->$script(`tar Oxzf $file install/${scripttrans()}{$script} 2>/dev/null`);
|
||||
$this->$script($this->runpipe("tar Oxzf $file install/${scripttrans()}{$script} 2>/dev/null"));
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -162,10 +162,10 @@ sub unpack {
|
||||
$this->SUPER::unpack(@_);
|
||||
my $file=$this->filename;
|
||||
|
||||
(system("cat $file | (cd ".$this->unpacked_tree."; tar zxpf -)") == 0)
|
||||
or die "Unpacking of `$file' failed: $!";
|
||||
$this->do("cat $file | (cd ".$this->unpacked_tree."; tar zxpf -)")
|
||||
or die "Unpacking of '$file' failed: $!";
|
||||
# Delete the install directory that has slackware info in it.
|
||||
system("cd ".$this->unpacked_tree."; rm -rf ./install");
|
||||
$this->do("cd ".$this->unpacked_tree."; rm -rf ./install");
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -194,7 +194,7 @@ sub prep {
|
||||
open (OUT, ">$out") || die "$out: $!";
|
||||
print OUT $data;
|
||||
close OUT;
|
||||
chmod 0755, $out;
|
||||
$this->do("chmod", 755, $out);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -209,7 +209,7 @@ sub build {
|
||||
my $this=shift;
|
||||
my $tgz=$this->name."-".$this->version.".tgz";
|
||||
|
||||
(system("cd ".$this->unpacked_tree."; tar czf ../$tgz .") == 0)
|
||||
$this->do("cd ".$this->unpacked_tree."; tar czf ../$tgz .")
|
||||
or die "Package build failed";
|
||||
|
||||
return $tgz;
|
||||
|
||||
3
README
3
README
@@ -72,3 +72,6 @@ Programs that use alien:
|
||||
Please report any bugs in alien to the author:
|
||||
|
||||
Joey Hess <joeyh@debian.org>
|
||||
|
||||
It is helpful to provide a log of alien --veryverbose reproducing the
|
||||
bug. I may also ask for the package that exposes the problem you saw.
|
||||
|
||||
@@ -9,6 +9,6 @@ Description: Alien converts Slackware .tgz packages, Red Hat .rpm packages,
|
||||
Keywords: debian dpkg deb red hat redhat rpm slackware tgz stampede slp convert package LSB
|
||||
Author: joey@kitenet.net
|
||||
Primary-site: sunsite.unc.edu /pub/Linux/utils/package
|
||||
32 alien-@version@.tar.gz
|
||||
80 alien-@version@.tar.gz
|
||||
Copying-policy: GPL
|
||||
End
|
||||
|
||||
104
alien.pl
104
alien.pl
@@ -10,19 +10,19 @@ alien - Convert or install an alien binary package
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<alien> is a program that converts between Redhat rpm, Debian deb,
|
||||
B<alien> is a program that converts between Red Hat rpm, Debian deb,
|
||||
Stampede slp, Slackware tgz, and Solaris pkg file formats. If you want to
|
||||
use a package from another linux distribution than the one you have
|
||||
installed on your system, you can use alien to convert it to your preferred
|
||||
installed on your system, you can use B<alien> to convert it to your preferred
|
||||
package format and install it. It also supports LSB packages.
|
||||
|
||||
=head1 WARNING
|
||||
|
||||
Despite the high version number, alien is still (and will probably always
|
||||
Despite the high version number, B<alien> is still (and will probably always
|
||||
be) rather experimental software. It's been under development for many
|
||||
years now, but there are still many bugs and limitations.
|
||||
|
||||
Alien should not be used to replace important system packages, like
|
||||
B<alien> should not be used to replace important system packages, like
|
||||
init, libc, or other things that are essential for the functioning of
|
||||
your system. Many of these packages are set up differently by the
|
||||
different distributions, and packages from the different distributions
|
||||
@@ -41,8 +41,7 @@ installed.
|
||||
|
||||
=item lsb
|
||||
|
||||
To convert from lsb packages, the Red Hat Package Manager must be installed.
|
||||
Unlike the other package formats, alien can handle the depenendencies of
|
||||
Unlike the other package formats, B<alien> can handle the depenendencies of
|
||||
lsb packages if the destination package format supports dependencies. Note
|
||||
that this means that the package generated from a lsb package will depend on
|
||||
a package named "lsb" -- your distribution should provide a package by that
|
||||
@@ -50,7 +49,7 @@ name, if it is lsb compliant. The scripts in the lsb package will be converted
|
||||
by default as well.
|
||||
|
||||
To generate lsb packages, the Red Hat Package Manager must be installed,
|
||||
and alien will use by preference a program named lsb-rpm, if it exists.
|
||||
and B<alien> will use by preference a program named lsb-rpm, if it exists.
|
||||
No guarantees are made that the generated lsb packages will be fully LSB
|
||||
compliant, and it's rather unlikely they will unless you build them in the
|
||||
lsbdev environment.
|
||||
@@ -65,7 +64,7 @@ dpkg-dev, and dpkg packages must be installed.
|
||||
Note that when converting from the tgz format, B<alien> will simply generate an
|
||||
output package that has the same files in it as are in the tgz file. This
|
||||
only works well if the tgz file has precompiled binaries in it in a
|
||||
standard linux directory tree. Do NOT run alien on tar files with source
|
||||
standard linux directory tree. Do NOT run B<alien> on tar files with source
|
||||
code in them, unless you want this source code to be installed in your root
|
||||
directory when you install the package!
|
||||
|
||||
@@ -79,7 +78,7 @@ tools.
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
Alien will convert all the files you pass into it into all the output types
|
||||
B<alien> will convert all the files you pass into it into all the output types
|
||||
you specify. If no output type is specified, it defaults to converting to
|
||||
deb format.
|
||||
|
||||
@@ -156,7 +155,7 @@ Specifiy a version for the package. This only has an effect when
|
||||
converting from the tgz package format, which may lack version
|
||||
information.
|
||||
|
||||
Note that without an argument, this displays the version of alien instead.
|
||||
Note that without an argument, this displays the version of B<alien> instead.
|
||||
|
||||
=item B<-c>, B<--scripts>
|
||||
|
||||
@@ -176,8 +175,8 @@ lintian's output displayed.
|
||||
|
||||
=item B<-k>, B<--keep-version>
|
||||
|
||||
By default, alien adds one to the minor version number of each package it
|
||||
converts. If this option is given, alien will not do this.
|
||||
By default, B<alien> adds one to the minor version number of each package it
|
||||
converts. If this option is given, B<alien> will not do this.
|
||||
|
||||
=item B<--fixperms>
|
||||
|
||||
@@ -187,15 +186,29 @@ some things to mess with their permissions and owners to the degree this does,
|
||||
so it defaults to off. This can only be used when converting to debian
|
||||
packages.
|
||||
|
||||
=item B<-v>, B<--verbose>
|
||||
|
||||
Be verbose: Display each command B<alien> runs in the process of converting a
|
||||
package.
|
||||
|
||||
=item B<--veryverbose>
|
||||
|
||||
Be verbose as with --verbose, but also display the output of each command
|
||||
run. Some commands may generate a lot of output.
|
||||
|
||||
=item B<-h>, B<--help>
|
||||
|
||||
Display a short usage summary.
|
||||
|
||||
=item B<-V>, B<--version>
|
||||
|
||||
Display the version of B<alien>.
|
||||
|
||||
=back
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
Here are some examples of the use of alien:
|
||||
Here are some examples of the use of B<alien>:
|
||||
|
||||
=over 4
|
||||
|
||||
@@ -222,7 +235,7 @@ all 4 package formats.
|
||||
|
||||
=head1 ENVIRONMENT
|
||||
|
||||
Alien recognizes the following environemnt variables:
|
||||
B<alien> recognizes the following environemnt variables:
|
||||
|
||||
=over 4
|
||||
|
||||
@@ -236,24 +249,24 @@ Options to pass to rpm when it is installing a package.
|
||||
|
||||
=item EMAIL
|
||||
|
||||
If set, alien assumes this is your email address. Email addresses are included
|
||||
in generated debian packages.
|
||||
If set, B<alien> assumes this is your email address. Email addresses are
|
||||
included in generated debian packages.
|
||||
|
||||
=back
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
When using alien to convert a tgz package, all files in /etc in are assumed
|
||||
When using B<alien> to convert a tgz package, all files in /etc in are assumed
|
||||
to be configuration files.
|
||||
|
||||
If alien is not run as root, the files in the generated package will have
|
||||
If B<alien> is not run as root, the files in the generated package will have
|
||||
incorrect owners and permissions.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Alien was written by Christoph Lameter, B<<clameter@debian.org>>.
|
||||
B<alien> was written by Christoph Lameter, B<<clameter@debian.org>>.
|
||||
|
||||
deb to rpm conversion code was taken from the Martian program by
|
||||
deb to rpm conversion code was taken from the martian program by
|
||||
Randolph Chung, B<<tausq@debian.org>>.
|
||||
|
||||
The Solaris pkg code was written by Mark A. Hershberger B<<mah@everybody.org>>.
|
||||
@@ -296,7 +309,7 @@ sub usage {
|
||||
Usage: alien [options] file [...]
|
||||
file [...] Package file or files to convert.
|
||||
-d, --to-deb Generate a Debian deb package (default).
|
||||
Enables the following options:
|
||||
Enables these options:
|
||||
--patch=<patch> Specify patch file to use instead of automatically
|
||||
looking for patch in /var/lib/alien.
|
||||
--nopatch Do not use patches.
|
||||
@@ -309,16 +322,18 @@ Usage: alien [options] file [...]
|
||||
--to-slp Generate a Stampede slp package.
|
||||
-l, --to-lsb Generate a LSB package.
|
||||
-t, --to-tgz Generate a Slackware tgz package.
|
||||
Enables the following option:
|
||||
Enables these options:
|
||||
--description=<desc> Specify package description.
|
||||
--version=<version> Specify package version.
|
||||
-p, --to-pkg Generate a Solaris pkg package.
|
||||
-i, --install Install generated package.
|
||||
-g, --generate Unpack, but do not generate a new package.
|
||||
-c, --scripts Include scripts in package.
|
||||
-v, --verbose Display each command alien runs.
|
||||
--veryverbose Be verbose, and also display output of run commands.
|
||||
-k, --keep-version Do not change version of generated package.
|
||||
-h, --help Display this help message.
|
||||
-v, --version Display alien's version number.
|
||||
-V, --version Display alien's version number.
|
||||
|
||||
EOF
|
||||
exit 1;
|
||||
@@ -334,25 +349,28 @@ my (%destformats, $generate, $install, $single, $scripts, $patchfile,
|
||||
Getopt::Long::Configure("bundling");
|
||||
|
||||
GetOptions(
|
||||
"to-deb|d", sub { $destformats{deb}=1 },
|
||||
"to-rpm|r", sub { $destformats{rpm}=1 },
|
||||
"to-lsb|l", sub { $destformats{lsb}=1 },
|
||||
"to-tgz|t", sub { $destformats{tgz}=1 },
|
||||
"to-slp", sub { $destformats{slp}=1 },
|
||||
"to-pkg|p", sub { $destformats{pkg}=1 },
|
||||
"test|T", \$test,
|
||||
"generate|g", \$generate,
|
||||
"install|i", \$install,
|
||||
"single|s", sub { $single=1; $generate=1 },
|
||||
"scripts|c", \$scripts,
|
||||
"patch=s", \$patchfile,
|
||||
"nopatch", \$nopatch,
|
||||
"anypatch", \$anypatch,
|
||||
"description=s", \$tgzdescription,
|
||||
"version:s", sub { length $_[1] ? $tgzversion=$_[1] : version() },
|
||||
"keep-version|k", \$keepversion,
|
||||
"fixperms", \$fixperms,
|
||||
"help|h", \&usage,
|
||||
"to-deb|d" => sub { $destformats{deb}=1 },
|
||||
"to-rpm|r" => sub { $destformats{rpm}=1 },
|
||||
"to-lsb|l" => sub { $destformats{lsb}=1 },
|
||||
"to-tgz|t" => sub { $destformats{tgz}=1 },
|
||||
"to-slp" => sub { $destformats{slp}=1 },
|
||||
"to-pkg|p" => sub { $destformats{pkg}=1 },
|
||||
"test|T" => \$test,
|
||||
"generate|g" => \$generate,
|
||||
"install|i" => \$install,
|
||||
"single|s" => sub { $single=1; $generate=1 },
|
||||
"scripts|c" => \$scripts,
|
||||
"patch=s" => \$patchfile,
|
||||
"nopatch" => \$nopatch,
|
||||
"anypatch" => \$anypatch,
|
||||
"description=s" => \$tgzdescription,
|
||||
"V" => \&version,
|
||||
"version:s" => sub { length $_[1] ? $tgzversion=$_[1] : version() },
|
||||
"verbose|v" => \$Alien::Package::verbose,
|
||||
"veryverbose" => sub { $Alien::Package::verbose=2 },
|
||||
"keep-version|k" => \$keepversion,
|
||||
"fixperms" => \$fixperms,
|
||||
"help|h" => \&usage,
|
||||
) || usage();
|
||||
|
||||
# Default to deb conversion.
|
||||
@@ -450,7 +468,7 @@ foreach my $file (@ARGV) {
|
||||
# Make .orig.tar.gz directory?
|
||||
if ($format eq 'deb' && ! $single && $generate) {
|
||||
# Make .orig.tar.gz directory.
|
||||
(system("cp", "-fa", "--", $package->unpacked_tree, $package->unpacked_tree.".orig") == 0)
|
||||
Alien::Package->do("cp", "-fa", "--", $package->unpacked_tree, $package->unpacked_tree.".orig")
|
||||
or die "cp -fa failed";
|
||||
}
|
||||
|
||||
|
||||
@@ -14,7 +14,7 @@ BuildArchitectures: noarch
|
||||
Alien allows you to convert Debian, Slackware, and Stampede Packages into Red
|
||||
Hat packages, which can be installed with rpm.
|
||||
|
||||
It can also convert into Slackware, Debian and Stampede packages.
|
||||
It can also generate Slackware, Debian and Stampede packages.
|
||||
|
||||
This is a tool only suitable for binary packages.
|
||||
|
||||
|
||||
9
debian/changelog
vendored
9
debian/changelog
vendored
@@ -1,3 +1,12 @@
|
||||
alien (8.30) unstable; urgency=low
|
||||
|
||||
* Added -v to enable verbose mode, which lists each shell command
|
||||
as it is run. Also added --veryverbose for verbose with command
|
||||
output too.
|
||||
* Use -V for version. (-v used to be documented, but never worked)
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Wed, 14 May 2003 00:12:00 -0400
|
||||
|
||||
alien (8.26) unstable; urgency=low
|
||||
|
||||
* alien.spec: pass PREFIX to Makefile.PL so it works on systems
|
||||
|
||||
2
debian/rules
vendored
2
debian/rules
vendored
@@ -5,6 +5,8 @@ build-stamp:
|
||||
dh_testdir
|
||||
perl Makefile.PL
|
||||
$(MAKE)
|
||||
# simple smoke test
|
||||
./alien.pl -V
|
||||
touch build-stamp
|
||||
|
||||
clean:
|
||||
|
||||
Reference in New Issue
Block a user