mlot/alien
1
0
Fork 0
mirror of https://github.com/Project-OSS-Revival/alien.git synced 2026-04-24 14:00:17 +00:00
Code Issues Packages Projects Releases Wiki Activity

* Added -v to enable verbose mode, which lists each shell command

Browse Source 
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:
joey
2003-05-14 22:14:29 +00:00
parent cbe19ea395
commit 7e6421c8e4
13 changed files with 274 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files

154
Alien/Package.pm
View File

@@ -9,6 +9,7 @@ Alien::Package - an object that represents a package
package Alien::Package; package Alien::Package;
use strict; use strict;
use vars qw($AUTOLOAD); use vars qw($AUTOLOAD);
our $verbose=0;
=head1 DESCRIPTION =head1 DESCRIPTION
@@ -143,22 +144,6 @@ yet. It will be set at unpack time.
=over 4 =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 =item init
This is called by new(). It's a handy place to set fields, etc, without 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 {} 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 =item install
Simply installs a package file. The filename is passed. Simply installs a package file. The filename is passed.
@@ -241,7 +212,7 @@ sub scan {
my $file=$this->filename; my $file=$this->filename;
if (! -e $file) { 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 $this=shift;
my $workdir = $this->name."-".$this->version; my $workdir = $this->name."-".$this->version;
mkdir($workdir, 0755) || $this->do("mkdir $workdir") or
die "unable to mkdir $workdir: $!"; die "unable to mkdir $workdir: $!";
# If the parent directory is suid/sgid, mkdir will make the root # If the parent directory is suid/sgid, mkdir will make the root
# directory of the package inherit those bits. That is a bad thing, # directory of the package inherit those bits. That is a bad thing,
# so explicitly force perms to 755. # so explicitly force perms to 755.
chmod 0755, $workdir; $this->do("chmod 755 $workdir");
$this->unpacked_tree($workdir); $this->unpacked_tree($workdir);
} }
@@ -325,10 +296,10 @@ sub DESTROY {
return if (! defined $this->unpacked_tree || $this->unpacked_tree eq ''); return if (! defined $this->unpacked_tree || $this->unpacked_tree eq '');
# This should never happen, but it pays to check. # This should never happen, but it pays to check.
if ($this->unpacked_tree eq '/') { 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) $this->do('rm', '-rf', $this->unpacked_tree)
or die "unable to delete temporary directory `".$this->unpacked_tree."`: $!"; or die "unable to delete temporary directory '".$this->unpacked_tree."': $!";
$this->unpacked_tree(''); $this->unpacked_tree('');
} }
@@ -355,6 +326,117 @@ sub AUTOLOAD {
=back =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 =head1 AUTHOR
Joey Hess <joey@kitenet.net> Joey Hess <joey@kitenet.net>

61
Alien/Package/Deb.pm
View File

@@ -87,7 +87,7 @@ sub install {
my $this=shift; my $this=shift;
my $deb=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"; or die "Unable to install";
} }
@@ -107,7 +107,7 @@ sub test {
return map { s/\n//; $_ } return map { s/\n//; $_ }
grep { grep {
! /unknown-section alien/ ! /unknown-section alien/
} `lintian $deb`; } $this->runpipe("lintian $deb");
} }
else { else {
return "lintian not available, so not testing"; return "lintian not available, so not testing";
@@ -127,7 +127,7 @@ sub getcontrolfile {
my $file=$this->filename; my $file=$this->filename;
if ($this->have_dpkg_deb) { 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 { else {
# Solaris tar doesn't support O # Solaris tar doesn't support O
@@ -140,7 +140,7 @@ sub getcontrolfile {
" cat $file; cd /; rm -rf /tmp/tar_out.$$)"; " cat $file; cd /; rm -rf /tmp/tar_out.$$)";
} }
my $getcontrol = "ar -p $file control.tar.gz | gzip -dc | ".tar_out($controlfile)." 2>/dev/null"; 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); $this->conffiles(\@conffiles);
# Read in the list of all files. # 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; my @filelist;
if ($this->have_dpkg_deb) { if ($this->have_dpkg_deb) {
@filelist=map { chomp; s:\./::; "/$_" } @filelist=map { chomp; s:\./::; "/$_" }
`dpkg-deb --fsys-tarfile $file | tar tf -`; $this->runpipe("dpkg-deb --fsys-tarfile $file | tar tf -");
} }
else { else {
@filelist=map { chomp; s:\./::; "/$_" } @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); $this->filelist(\@filelist);
@@ -237,12 +237,12 @@ sub unpack {
my $file=$this->filename; my $file=$this->filename;
if ($this->have_dpkg_deb) { if ($this->have_dpkg_deb) {
(system("dpkg-deb", "-x", $file, $this->unpacked_tree) == 0) $this->do("dpkg-deb", "-x", $file, $this->unpacked_tree)
or die "Unpacking of `$file' failed: $!"; or die "Unpacking of '$file' failed: $!";
} }
else { else {
(system("ar -p $file data.tar.gz | gzip -dc | (cd ".$this->unpacked_tree."; tar xpf -)") == 0) $this->do("ar -p $file data.tar.gz | gzip -dc | (cd ".$this->unpacked_tree."; tar xpf -)")
or die "Unpacking of `$file' failed: $!"; or die "Unpacking of '$file' failed: $!";
} }
return 1; return 1;
@@ -293,20 +293,20 @@ sub prep {
my $this=shift; my $this=shift;
my $dir=$this->unpacked_tree || die "The package must be unpacked first!"; 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: $!"; die "mkdir $dir/debian failed: $!";
# Use a patch file to debianize? # Use a patch file to debianize?
if (defined $this->patchfile) { if (defined $this->patchfile) {
# The -f passed to zcat makes it pass uncompressed files # The -f passed to zcat makes it pass uncompressed files
# through without error. # 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: $!"; or die "patch error: $!";
# Look for .rej files. # Look for .rej files.
die "patch failed with .rej files; giving up" die "patch failed with .rej files; giving up"
if `find $dir -name "*.rej"`; if $this->runpipe("find $dir -name \"*.rej\"");
system('find', '.', '-name', '*.orig', '-exec', 'rm', '{}', ';'); $this->do('find', '.', '-name', '*.orig', '-exec', 'rm', '{}', ';');
chmod 0755, "$dir/debian/rules"; $this->do("chmod", 755, "$dir/debian/rules");
# It's possible that the patch file changes the debian # It's possible that the patch file changes the debian
# release or version. Parse changelog to detect that. # release or version. Parse changelog to detect that.
@@ -406,6 +406,9 @@ binary-arch: build
dh_clean -k dh_clean -k
dh_installdirs dh_installdirs
dh_installdocs
dh_installchangelogs
# Copy the packages's files. # Copy the packages's files.
find . -maxdepth 1 -mindepth 1 -not -name debian -print0 | \\ find . -maxdepth 1 -mindepth 1 -not -name debian -print0 | \\
xargs -0 -r -i cp -a {} debian/\$(PACKAGE) 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 # If you need to move files around in debian/\$(PACKAGE) or do some
# binary patching, do it here # binary patching, do it here
# #
dh_installdocs
dh_installchangelogs
# This has been known to break on some wacky binaries. # This has been known to break on some wacky binaries.
# dh_strip # dh_strip
dh_compress dh_compress
@@ -431,7 +434,7 @@ binary: binary-indep binary-arch
.PHONY: build clean binary-indep binary-arch binary .PHONY: build clean binary-indep binary-arch binary
EOF EOF
close OUT; close OUT;
chmod 0755,"$dir/debian/rules"; $this->do("chmod", 755, "$dir/debian/rules");
# Save any scripts. # Save any scripts.
if ($this->usescripts) { if ($this->usescripts) {
@@ -456,10 +459,10 @@ EOF
if (-d "$dir/$olddir" && ! -e "$dir/$dirtrans{$olddir}") { if (-d "$dir/$olddir" && ! -e "$dir/$dirtrans{$olddir}") {
# Ignore failure.. # Ignore failure..
my ($dirbase)=$dirtrans{$olddir}=~/(.*)\//; my ($dirbase)=$dirtrans{$olddir}=~/(.*)\//;
system("install", "-d", "$dir/$dirbase"); $this->do("install", "-d", "$dir/$dirbase");
system("mv", "$dir/$olddir", "$dir/$dirtrans{$olddir}"); $this->do("mv", "$dir/$olddir", "$dir/$dirtrans{$olddir}");
if (-d "$dir/$olddir") { if (-d "$dir/$olddir") {
system("rmdir", "-p", "$dir/$olddir"); $this->do("rmdir", "-p", "$dir/$olddir");
} }
} }
else { else {
@@ -479,7 +482,7 @@ sub build {
my $this=shift; my $this=shift;
chdir $this->unpacked_tree; chdir $this->unpacked_tree;
my $log=`debian/rules binary 2>&1`; my $log=$this->runpipe("debian/rules binary 2>&1");
if ($?) { if ($?) {
die "Package build failed. Here's the log:\n", $log; die "Package build failed. Here's the log:\n", $log;
} }
@@ -503,15 +506,15 @@ sub cleantree {
if (! -e "$dir/$olddir" && -d "$dir/$dirtrans{$olddir}") { if (! -e "$dir/$olddir" && -d "$dir/$dirtrans{$olddir}") {
# Ignore failure.. (should I?) # Ignore failure.. (should I?)
my ($dirbase)=$dir=~/(.*)\//; my ($dirbase)=$dir=~/(.*)\//;
system("install", "-d", "$dir/$dirbase"); $this->do("install", "-d", "$dir/$dirbase");
system("mv", "$dir/$dirtrans{$olddir}", "$dir/$olddir"); $this->do("mv", "$dir/$dirtrans{$olddir}", "$dir/$olddir");
if (-d "$dir/$dirtrans{$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 =item package
@@ -643,7 +646,7 @@ Returns the date, in rfc822 format.
sub date { sub date {
my $this=shift; my $this=shift;
my $date=`822-date`; my $date=$this->runpipe("822-date");
chomp $date; chomp $date;
if (!$date) { if (!$date) {
die "822-date did not return a valid result. You probably need to install the dpkg-dev debian package"; 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; close MAILNAME;
} }
if (!$mailname) { if (!$mailname) {
$mailname=`hostname -f`; $mailname=$this->runpipe("hostname -f");
chomp $mailname; chomp $mailname;
} }
return "$login\@$mailname"; return "$login\@$mailname";

6
Alien/Package/Lsb.pm
View File

@@ -15,10 +15,6 @@ use base qw(Alien::Package::Rpm);
This is an object class that represents a lsb package. It is derived from This is an object class that represents a lsb package. It is derived from
Alien::Package::Rpm. Alien::Package::Rpm.
=head1 FIELDS
=over 4
=head1 METHODS =head1 METHODS
=over 4 =over 4
@@ -34,7 +30,7 @@ sub checkfile {
my $this=shift; my $this=shift;
my $file=shift; my $file=shift;
return unless $file =~ m/^lsb-.*\.rpm$/; 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 1 if grep { s/\s+//g; $_ eq 'lsb' } @deps;
return; return;
} }

24
Alien/Package/Pkg.pm
View File

@@ -104,7 +104,7 @@ sub install {
my $pkg=shift; my $pkg=shift;
if (-x "/usr/sbin/pkgadd") { if (-x "/usr/sbin/pkgadd") {
(system("/usr/sbin/pkgadd", "-d .", "$pkg") == 0) $this->do("/usr/sbin/pkgadd", "-d .", "$pkg")
or die "Unable to install"; or die "Unable to install";
} }
else { else {
@@ -124,7 +124,7 @@ sub scan {
my $file=$this->filename; my $file=$this->filename;
my $tdir="pkg-scan-tmp.$$"; my $tdir="pkg-scan-tmp.$$";
mkdir($tdir, 0755) || die "Error making $tdir: $!\n"; $this->do("mkdir", $tdir) || die "Error making $tdir: $!\n";
my $pkgname; my $pkgname;
if (-x "/usr/bin/pkginfo" && -x "/usr/bin/pkgtrans") { if (-x "/usr/bin/pkginfo" && -x "/usr/bin/pkgtrans") {
@@ -137,7 +137,7 @@ sub scan {
close INFO; close INFO;
# Extract the files # 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"; || die "Error running pkgtrans: $!\n";
open(INFO, "$tdir/$pkgname/pkginfo") open(INFO, "$tdir/$pkgname/pkginfo")
@@ -205,7 +205,7 @@ sub scan {
if -e "$file/".scripttrans()->{$script}; if -e "$file/".scripttrans()->{$script};
} }
system ("rm -rf $tdir"); $this->do("rm -rf $tdir");
return 1; return 1;
} }
@@ -230,8 +230,8 @@ sub unpack {
if (-x "/usr/bin/pkgtrans") { if (-x "/usr/bin/pkgtrans") {
my $workdir = $this->name."-".$this->version;; my $workdir = $this->name."-".$this->version;;
mkdir($workdir, 0755) || die "unable to mkdir $workdir: $!\n"; $this->do("mkdir", $workdir) || die "unable to mkdir $workdir: $!\n";
(system("/usr/bin/pkgtrans $file $workdir $pkgname") == 0) $this->do("/usr/bin/pkgtrans $file $workdir $pkgname")
|| die "unable to extract $file: $!\n"; || die "unable to extract $file: $!\n";
rename("$workdir/$pkgname", "$ {workdir}_1") rename("$workdir/$pkgname", "$ {workdir}_1")
|| die "unable rename $workdir/$pkgname: $!\n"; || die "unable rename $workdir/$pkgname: $!\n";
@@ -257,7 +257,7 @@ sub prep {
# grep {/^\./} readdir DIR; # grep {/^\./} readdir DIR;
# closedir DIR; # closedir DIR;
(system("cd $dir; find . -print | pkgproto > ./prototype") == 0) $this->do("cd $dir; find . -print | pkgproto > ./prototype")
|| die "error during pkgproto: $!\n"; || die "error during pkgproto: $!\n";
open(PKGPROTO, ">>$dir/prototype") open(PKGPROTO, ">>$dir/prototype")
@@ -280,7 +280,7 @@ sub prep {
close PKGINFO; close PKGINFO;
print PKGPROTO "i pkginfo=./pkginfo\n"; 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") open(COPYRIGHT, ">$dir/install/copyright")
|| die "error creating copyright: $!\n"; || die "error creating copyright: $!\n";
print COPYRIGHT $this->copyright; print COPYRIGHT $this->copyright;
@@ -295,7 +295,7 @@ sub prep {
open (OUT, ">$out") || die "$out: $!"; open (OUT, ">$out") || die "$out: $!";
print OUT $data; print OUT $data;
close OUT; close OUT;
chmod 0755, $out; $this->do("chmod", 755, $out);
print PKGPROTO "i $script=$out\n"; print PKGPROTO "i $script=$out\n";
} }
close PKGPROTO; close PKGPROTO;
@@ -311,14 +311,14 @@ sub build {
my $this = shift; my $this = shift;
my $dir = $this->unpacked_tree; my $dir = $this->unpacked_tree;
(system("cd $dir; pkgmk -r / -d .") == 0) $this->do("cd $dir; pkgmk -r / -d .")
|| die "Error during pkgmk: $!\n"; || die "Error during pkgmk: $!\n";
my $pkgname = $this->converted_name; my $pkgname = $this->converted_name;
my $name = $this->name."-".$this->version.".pkg"; my $name = $this->name."-".$this->version.".pkg";
(system("pkgtrans $dir $name $pkgname") == 0) $this->do("pkgtrans $dir $name $pkgname")
|| die "Error during pkgtrans: $!\n"; || die "Error during pkgtrans: $!\n";
rename "$dir/$name", $name; $this->do("mv", "$dir/$name", $name);
return $name; return $name;
} }

32
Alien/Package/Rpm.pm
View File

@@ -23,6 +23,8 @@ Alien::Package.
Relocatable rpm packages have a prefixes field. Relocatable rpm packages have a prefixes field.
=back
=head1 METHODS =head1 METHODS
=over 4 =over 4
@@ -51,7 +53,7 @@ sub install {
my $this=shift; my $this=shift;
my $rpm=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"; or die "Unable to install";
} }
@@ -81,23 +83,23 @@ sub scan {
# Use --queryformat to pull out all the fields we need. # Use --queryformat to pull out all the fields we need.
foreach my $field (keys(%fieldtrans)) { foreach my $field (keys(%fieldtrans)) {
$_=`LANG=C rpm -qp --queryformat \%{$field} $file`; $_=$this->runpipe("LANG=C rpm -qp --queryformat \%{$field} $file");
$field=$fieldtrans{$field}; $field=$fieldtrans{$field};
$_='' if $_ eq '(none)'; $_='' if $_ eq '(none)';
$this->$field($_); $this->$field($_);
} }
# Get the conffiles list. # 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] && if (defined $this->conffiles->[0] &&
$this->conffiles->[0] eq '(contains no files)') { $this->conffiles->[0] eq '(contains no files)') {
$this->conffiles([]); $this->conffiles([]);
} }
$this->binary_info(scalar `rpm -qpi $file`); $this->binary_info(scalar $this->runpipe("rpm -qpi $file"));
# Get the filelist. # 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] && if (defined $this->filelist->[0] &&
$this->filelist->[0] eq '(contains no files)') { $this->filelist->[0] eq '(contains no files)') {
$this->filelist([]); $this->filelist([]);
@@ -145,8 +147,8 @@ sub unpack {
$this->SUPER::unpack(@_); $this->SUPER::unpack(@_);
my $workdir=$this->unpacked_tree; 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) $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"; or die "Unpacking of '".$this->filename."' failed";
# If the package is relocatable. We'd like to move it to be under # If the package is relocatable. We'd like to move it to be under
# the $this->prefixes directory. However, it's possible that that # the $this->prefixes directory. However, it's possible that that
@@ -168,12 +170,12 @@ sub unpack {
foreach (split m:/:, $this->prefixes) { foreach (split m:/:, $this->prefixes) {
if ($_ ne '') { # this keeps us from using anything but relative paths. if ($_ ne '') { # this keeps us from using anything but relative paths.
$collect.="/$_"; $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. # Now move all files in the package to the directory we made.
if (@filelist) { 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: $!"; 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, # Note that the next section overrides these default permissions,
# if override data exists in the rpm permissions info. And such # if override data exists in the rpm permissions info. And such
# data should always exist, so this is probably a no-op. # 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 # rpm files have two sets of permissions; the set in the cpio
# archive, and the set in the control data; which override them. # 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 next unless -e "$workdir/$file"; # skip broken links
if ($> == 0) { 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); $this->owninfo(\%owninfo);
@@ -339,7 +343,7 @@ sub build {
# Ask rpm how it's set up. We want to know what architecture it # Ask rpm how it's set up. We want to know what architecture it
# will output, and where it will place rpms. # will output, and where it will place rpms.
my ($rpmarch, $rpmdir); my ($rpmarch, $rpmdir);
foreach (`rpm --showrc`) { foreach ($this->runpipe("rpm --showrc")) {
chomp; chomp;
if (/^build arch\s+:\s(.*)$/) { if (/^build arch\s+:\s(.*)$/) {
$rpmarch=$1; $rpmarch=$1;
@@ -381,7 +385,7 @@ sub build {
$opts.=" $ENV{RPMBUILDOPTS}" if exists $ENV{RPMBUILDOPTS}; $opts.=" $ENV{RPMBUILDOPTS}" if exists $ENV{RPMBUILDOPTS};
my $command="cd $dir; $buildcmd -bb $opts ".$this->name."-".$this->version."-".$this->release.".spec"; 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 ($?) { if ($?) {
die "Package build failed. Here's the log of the command ($command):\n", $log; die "Package build failed. Here's the log of the command ($command):\n", $log;
} }

14
Alien/Package/Slp.pm
View File

@@ -85,7 +85,7 @@ Holds the compression type used in the slp file.
Holds the slp package format version of the slp file. Holds the slp package format version of the slp file.
=item =back
=head1 METHODS =head1 METHODS
@@ -114,7 +114,7 @@ sub install {
my $this=shift; my $this=shift;
my $slp=shift; my $slp=shift;
(system("slpi", $slp) == 0) $this->do("slpi", $slp)
or die "Unable to install"; or die "Unable to install";
} }
@@ -163,7 +163,7 @@ sub scan {
# Read in the file list. # Read in the file list.
my @filelist; my @filelist;
# FIXME: support gzip files too! # FIXME: support gzip files too!
foreach (`bzip2 -d < $file | tar -tf -`) { foreach ($this->runpipe("bzip2 -d < $file | tar -tf -")) {
chomp; chomp;
s:^\./:/:; s:^\./:/:;
$_="/$_" unless m:^/:; $_="/$_" unless m:^/:;
@@ -176,7 +176,7 @@ sub scan {
$this->distribution('Stampede'); $this->distribution('Stampede');
$this->origformat('slp'); $this->origformat('slp');
$this->changelogtext(''); $this->changelogtext('');
$this->binary_info(`ls -l $file`); $this->binary_info($this->runpipe("ls -l $file"));
return 1; return 1;
} }
@@ -195,10 +195,10 @@ sub unpack {
my $compresstype=$this->compresstype; my $compresstype=$this->compresstype;
if ($compresstype == 0) { 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) { 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 { else {
die "package uses an unknown compression type, $compresstype (please file a bug report)"; 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 # something like that, becuase it results in a tar file where all
# the files in it start with "./", which is consitent with how # the files in it start with "./", which is consitent with how
# normal stampede files look. # 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: $!"; or die "package build failed: $!";
# Now append the footer. # Now append the footer.

16
Alien/Package/Tgz.pm
View File

@@ -66,7 +66,7 @@ sub install {
my $tgz=shift; my $tgz=shift;
if (-x "/sbin/installpkg") { if (-x "/sbin/installpkg") {
(system("/sbin/installpkg", "$tgz") == 0) $this->do("/sbin/installpkg", "$tgz")
or die "Unable to install"; or die "Unable to install";
} }
else { else {
@@ -111,7 +111,7 @@ sub scan {
$this->group("unknown"); $this->group("unknown");
$this->origformat('tgz'); $this->origformat('tgz');
$this->changelogtext(''); $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 # Now figure out the conffiles. Assume anything in etc/ is a
# conffile. # conffile.
@@ -145,7 +145,7 @@ sub scan {
# Now get the scripts. # Now get the scripts.
foreach my $script (keys %{scripttrans()}) { 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; return 1;
@@ -162,10 +162,10 @@ sub unpack {
$this->SUPER::unpack(@_); $this->SUPER::unpack(@_);
my $file=$this->filename; my $file=$this->filename;
(system("cat $file | (cd ".$this->unpacked_tree."; tar zxpf -)") == 0) $this->do("cat $file | (cd ".$this->unpacked_tree."; tar zxpf -)")
or die "Unpacking of `$file' failed: $!"; or die "Unpacking of '$file' failed: $!";
# Delete the install directory that has slackware info in it. # 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; return 1;
} }
@@ -194,7 +194,7 @@ sub prep {
open (OUT, ">$out") || die "$out: $!"; open (OUT, ">$out") || die "$out: $!";
print OUT $data; print OUT $data;
close OUT; close OUT;
chmod 0755, $out; $this->do("chmod", 755, $out);
} }
} }
} }
@@ -209,7 +209,7 @@ sub build {
my $this=shift; my $this=shift;
my $tgz=$this->name."-".$this->version.".tgz"; 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"; or die "Package build failed";
return $tgz; return $tgz;

3
README
View File

@@ -72,3 +72,6 @@ Programs that use alien:
Please report any bugs in alien to the author: Please report any bugs in alien to the author:
Joey Hess <joeyh@debian.org> 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.

2
alien.lsm.in
View File

@@ -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 Keywords: debian dpkg deb red hat redhat rpm slackware tgz stampede slp convert package LSB
Author: joey@kitenet.net Author: joey@kitenet.net
Primary-site: sunsite.unc.edu /pub/Linux/utils/package Primary-site: sunsite.unc.edu /pub/Linux/utils/package
32 alien-@version@.tar.gz 80 alien-@version@.tar.gz
Copying-policy: GPL Copying-policy: GPL
End End

106
alien.pl
View File

@@ -10,19 +10,19 @@ alien - Convert or install an alien binary package
=head1 DESCRIPTION =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 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 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. package format and install it. It also supports LSB packages.
=head1 WARNING =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 be) rather experimental software. It's been under development for many
years now, but there are still many bugs and limitations. 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 init, libc, or other things that are essential for the functioning of
your system. Many of these packages are set up differently by the your system. Many of these packages are set up differently by the
different distributions, and packages from the different distributions different distributions, and packages from the different distributions
@@ -41,8 +41,7 @@ installed.
=item lsb =item lsb
To convert from lsb packages, the Red Hat Package Manager must be installed. Unlike the other package formats, B<alien> can handle the depenendencies of
Unlike the other package formats, alien can handle the depenendencies of
lsb packages if the destination package format supports dependencies. Note lsb packages if the destination package format supports dependencies. Note
that this means that the package generated from a lsb package will depend on 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 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. by default as well.
To generate lsb packages, the Red Hat Package Manager must be installed, 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 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 compliant, and it's rather unlikely they will unless you build them in the
lsbdev environment. 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 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 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 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 code in them, unless you want this source code to be installed in your root
directory when you install the package! directory when you install the package!
@@ -79,7 +78,7 @@ tools.
=head1 OPTIONS =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 you specify. If no output type is specified, it defaults to converting to
deb format. 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 converting from the tgz package format, which may lack version
information. 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> =item B<-c>, B<--scripts>
@@ -176,8 +175,8 @@ lintian's output displayed.
=item B<-k>, B<--keep-version> =item B<-k>, B<--keep-version>
By default, alien adds one to the minor version number of each package it By default, B<alien> adds one to the minor version number of each package it
converts. If this option is given, alien will not do this. converts. If this option is given, B<alien> will not do this.
=item B<--fixperms> =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 so it defaults to off. This can only be used when converting to debian
packages. 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> =item B<-h>, B<--help>
Display a short usage summary. Display a short usage summary.
=item B<-V>, B<--version>
Display the version of B<alien>.
=back =back
=head1 EXAMPLES =head1 EXAMPLES
Here are some examples of the use of alien: Here are some examples of the use of B<alien>:
=over 4 =over 4
@@ -222,7 +235,7 @@ all 4 package formats.
=head1 ENVIRONMENT =head1 ENVIRONMENT
Alien recognizes the following environemnt variables: B<alien> recognizes the following environemnt variables:
=over 4 =over 4
@@ -236,24 +249,24 @@ Options to pass to rpm when it is installing a package.
=item EMAIL =item EMAIL
If set, alien assumes this is your email address. Email addresses are included If set, B<alien> assumes this is your email address. Email addresses are
in generated debian packages. included in generated debian packages.
=back =back
=head1 NOTES =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. 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. incorrect owners and permissions.
=head1 AUTHOR =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>>. Randolph Chung, B<<tausq@debian.org>>.
The Solaris pkg code was written by Mark A. Hershberger B<<mah@everybody.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 [...] Usage: alien [options] file [...]
file [...] Package file or files to convert. file [...] Package file or files to convert.
-d, --to-deb Generate a Debian deb package (default). -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 --patch=<patch> Specify patch file to use instead of automatically
looking for patch in /var/lib/alien. looking for patch in /var/lib/alien.
--nopatch Do not use patches. --nopatch Do not use patches.
@@ -305,20 +318,22 @@ Usage: alien [options] file [...]
directory. directory.
--fixperms Munge/fix permissions and owners. --fixperms Munge/fix permissions and owners.
--test Test generated packages with lintian. --test Test generated packages with lintian.
-r, --to-rpm Generate a RedHat rpm package. -r, --to-rpm Generate a Red Hat rpm package.
--to-slp Generate a Stampede slp package. --to-slp Generate a Stampede slp package.
-l, --to-lsb Generate a LSB package. -l, --to-lsb Generate a LSB package.
-t, --to-tgz Generate a Slackware tgz package. -t, --to-tgz Generate a Slackware tgz package.
Enables the following option: Enables these options:
--description=<desc> Specify package description. --description=<desc> Specify package description.
--version=<version> Specify package version. --version=<version> Specify package version.
-p, --to-pkg Generate a Solaris pkg package. -p, --to-pkg Generate a Solaris pkg package.
-i, --install Install generated package. -i, --install Install generated package.
-g, --generate Unpack, but do not generate a new package. -g, --generate Unpack, but do not generate a new package.
-c, --scripts Include scripts in 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. -k, --keep-version Do not change version of generated package.
-h, --help Display this help message. -h, --help Display this help message.
-v, --version Display alien's version number. -V, --version Display alien's version number.
EOF EOF
exit 1; exit 1;
@@ -334,25 +349,28 @@ my (%destformats, $generate, $install, $single, $scripts, $patchfile,
Getopt::Long::Configure("bundling"); Getopt::Long::Configure("bundling");
GetOptions( GetOptions(
"to-deb|d", sub { $destformats{deb}=1 }, "to-deb|d" => sub { $destformats{deb}=1 },
"to-rpm|r", sub { $destformats{rpm}=1 }, "to-rpm|r" => sub { $destformats{rpm}=1 },
"to-lsb|l", sub { $destformats{lsb}=1 }, "to-lsb|l" => sub { $destformats{lsb}=1 },
"to-tgz|t", sub { $destformats{tgz}=1 }, "to-tgz|t" => sub { $destformats{tgz}=1 },
"to-slp", sub { $destformats{slp}=1 }, "to-slp" => sub { $destformats{slp}=1 },
"to-pkg|p", sub { $destformats{pkg}=1 }, "to-pkg|p" => sub { $destformats{pkg}=1 },
"test|T", \$test, "test|T" => \$test,
"generate|g", \$generate, "generate|g" => \$generate,
"install|i", \$install, "install|i" => \$install,
"single|s", sub { $single=1; $generate=1 }, "single|s" => sub { $single=1; $generate=1 },
"scripts|c", \$scripts, "scripts|c" => \$scripts,
"patch=s", \$patchfile, "patch=s" => \$patchfile,
"nopatch", \$nopatch, "nopatch" => \$nopatch,
"anypatch", \$anypatch, "anypatch" => \$anypatch,
"description=s", \$tgzdescription, "description=s" => \$tgzdescription,
"version:s", sub { length $_[1] ? $tgzversion=$_[1] : version() }, "V" => \&version,
"keep-version|k", \$keepversion, "version:s" => sub { length $_[1] ? $tgzversion=$_[1] : version() },
"fixperms", \$fixperms, "verbose|v" => \$Alien::Package::verbose,
"help|h", \&usage, "veryverbose" => sub { $Alien::Package::verbose=2 },
"keep-version|k" => \$keepversion,
"fixperms" => \$fixperms,
"help|h" => \&usage,
) || usage(); ) || usage();
# Default to deb conversion. # Default to deb conversion.
@@ -450,7 +468,7 @@ foreach my $file (@ARGV) {
# Make .orig.tar.gz directory? # Make .orig.tar.gz directory?
if ($format eq 'deb' && ! $single && $generate) { if ($format eq 'deb' && ! $single && $generate) {
# Make .orig.tar.gz directory. # 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"; or die "cp -fa failed";
} }

2
alien.spec.in
View File

@@ -14,7 +14,7 @@ BuildArchitectures: noarch
Alien allows you to convert Debian, Slackware, and Stampede Packages into Red Alien allows you to convert Debian, Slackware, and Stampede Packages into Red
Hat packages, which can be installed with rpm. 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. This is a tool only suitable for binary packages.

9
debian/changelog vendored
View File

@@ -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 (8.26) unstable; urgency=low
* alien.spec: pass PREFIX to Makefile.PL so it works on systems * alien.spec: pass PREFIX to Makefile.PL so it works on systems

2
debian/rules vendored
View File

@@ -5,6 +5,8 @@ build-stamp:
dh_testdir dh_testdir
perl Makefile.PL perl Makefile.PL
$(MAKE) $(MAKE)
# simple smoke test
./alien.pl -V
touch build-stamp touch build-stamp
clean: clean: