diff --git a/Alien/Package.pm b/Alien/Package.pm index e914fe8..7effdc3 100644 --- a/Alien/Package.pm +++ b/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 diff --git a/Alien/Package/Deb.pm b/Alien/Package/Deb.pm index 7e8fd5a..002313c 100644 --- a/Alien/Package/Deb.pm +++ b/Alien/Package/Deb.pm @@ -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"; diff --git a/Alien/Package/Lsb.pm b/Alien/Package/Lsb.pm index 1af1e24..b31af31 100644 --- a/Alien/Package/Lsb.pm +++ b/Alien/Package/Lsb.pm @@ -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; } diff --git a/Alien/Package/Pkg.pm b/Alien/Package/Pkg.pm index daa5b0b..9af2c8c 100644 --- a/Alien/Package/Pkg.pm +++ b/Alien/Package/Pkg.pm @@ -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; } diff --git a/Alien/Package/Rpm.pm b/Alien/Package/Rpm.pm index d3b27c7..4384db2 100644 --- a/Alien/Package/Rpm.pm +++ b/Alien/Package/Rpm.pm @@ -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; } diff --git a/Alien/Package/Slp.pm b/Alien/Package/Slp.pm index 32fe76b..5b631c3 100644 --- a/Alien/Package/Slp.pm +++ b/Alien/Package/Slp.pm @@ -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. diff --git a/Alien/Package/Tgz.pm b/Alien/Package/Tgz.pm index 4cb4f67..648fd0c 100644 --- a/Alien/Package/Tgz.pm +++ b/Alien/Package/Tgz.pm @@ -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; diff --git a/README b/README index 0442e09..e32a48d 100644 --- a/README +++ b/README @@ -72,3 +72,6 @@ Programs that use alien: Please report any bugs in alien to the author: Joey Hess + + 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. diff --git a/alien.lsm.in b/alien.lsm.in index 1f36330..af0c641 100644 --- a/alien.lsm.in +++ b/alien.lsm.in @@ -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 diff --git a/alien.pl b/alien.pl index 5505c5e..24f2ef8 100755 --- a/alien.pl +++ b/alien.pl @@ -10,19 +10,19 @@ alien - Convert or install an alien binary package =head1 DESCRIPTION -B is a program that converts between Redhat rpm, Debian deb, +B 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 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 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 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 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 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 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 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 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 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 adds one to the minor version number of each package it +converts. If this option is given, B 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 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. + =back =head1 EXAMPLES -Here are some examples of the use of alien: +Here are some examples of the use of B: =over 4 @@ -222,7 +235,7 @@ all 4 package formats. =head1 ENVIRONMENT -Alien recognizes the following environemnt variables: +B 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 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 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 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<>. +B was written by Christoph Lameter, B<>. -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<>. The Solaris pkg code was written by Mark A. Hershberger B<>. @@ -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= Specify patch file to use instead of automatically looking for patch in /var/lib/alien. --nopatch Do not use patches. @@ -305,20 +318,22 @@ Usage: alien [options] file [...] directory. --fixperms Munge/fix permissions and owners. --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. -l, --to-lsb Generate a LSB package. -t, --to-tgz Generate a Slackware tgz package. - Enables the following option: + Enables these options: --description= Specify package description. --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"; } diff --git a/alien.spec.in b/alien.spec.in index 72fc7ec..596fb99 100644 --- a/alien.spec.in +++ b/alien.spec.in @@ -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. diff --git a/debian/changelog b/debian/changelog index b60a802..a3f2106 100644 --- a/debian/changelog +++ b/debian/changelog @@ -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 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 diff --git a/debian/rules b/debian/rules index 505783f..5438ca9 100755 --- a/debian/rules +++ b/debian/rules @@ -5,6 +5,8 @@ build-stamp: dh_testdir perl Makefile.PL $(MAKE) + # simple smoke test + ./alien.pl -V touch build-stamp clean: