mirror of
https://github.com/Project-OSS-Revival/alien.git
synced 2026-04-24 14:00:17 +00:00
alien (8.88) unstable; urgency=low
* Ensure that version numbers begin with well, a number, when building a
deb, otherwise dpkg-deb will refuse to build it.
# imported from the archive
This commit is contained in:
Joey Hess
505
Alien/Package.pm
Normal file
505
Alien/Package.pm
Normal file
@@ -0,0 +1,505 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Alien::Package - an object that represents a package
|
||||
|
||||
=cut
|
||||
|
||||
package Alien::Package;
|
||||
use strict;
|
||||
use vars qw($AUTOLOAD);
|
||||
our $verbose=0;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a perl object class that represents a package in an internal format
|
||||
usable by alien. The package may be a deb, a rpm, a tgz, or a slp package,
|
||||
etc. Objects in this class hold various fields of metadata from the actual
|
||||
packages they represent, as well as some fields pointing to the actual
|
||||
contents of the package. They can also examine an actual package on disk,
|
||||
and populate those fields. And they can build the actual package using the
|
||||
data stored in the fields.
|
||||
|
||||
A typical use of this object class will be to instantiate an object from
|
||||
a class derived from this one, such as Alien::Package::Rpm. Feed the object
|
||||
a rpm file, thus populating all of its fields. Then rebless the object into
|
||||
the destination class, such as Alien::Package::Deb. Finally, ask the object
|
||||
to build a package, and the package has been converted.
|
||||
|
||||
=head1 FIELDS
|
||||
|
||||
These fields are of course really just methods that all act similarly;
|
||||
allowing a value to be passed in to set them, or simply returning the value
|
||||
of the field if nothing is passed in. Child classes may override these
|
||||
fields to process input data, or to format output data. The general rule is
|
||||
that input data is modified to get things into a package-independant form,
|
||||
which is how the data is stored in the fields. When the value of a field is
|
||||
read, it too may be modified before it is returned, to change things into a
|
||||
form more suitable for the particular type of package.
|
||||
|
||||
=over 4
|
||||
|
||||
=item name
|
||||
|
||||
The package's name.
|
||||
|
||||
=item version
|
||||
|
||||
The package's upstream version.
|
||||
|
||||
=item release
|
||||
|
||||
The package's distribution specific release number.
|
||||
|
||||
=item arch
|
||||
|
||||
The package's architecture, in the format used by Debian.
|
||||
|
||||
=item maintainer
|
||||
|
||||
The package's maintainer.
|
||||
|
||||
=item depends
|
||||
|
||||
The package's dependancies. Only dependencies that should exist on all
|
||||
target distributions can be put in here though (ie: lsb).
|
||||
|
||||
=item group
|
||||
|
||||
The section the package is in.
|
||||
|
||||
=item summary
|
||||
|
||||
A one line description of the package.
|
||||
|
||||
=item description
|
||||
|
||||
A longer description of the package. May contain multiple paragraphs.
|
||||
|
||||
=item copyright
|
||||
|
||||
A short statement of copyright.
|
||||
|
||||
=item origformat
|
||||
|
||||
What format the package was originally in.
|
||||
|
||||
=item distribution
|
||||
|
||||
What distribution family the package originated from.
|
||||
|
||||
=item binary_info
|
||||
|
||||
Whatever the package's package tool says when told to display info about
|
||||
the package.
|
||||
|
||||
=item conffiles
|
||||
|
||||
A reference to a list of all the conffiles in the package.
|
||||
|
||||
=item files
|
||||
|
||||
A reference to a list of all the files in the package.
|
||||
|
||||
=item changelogtext
|
||||
|
||||
The text of the changelog
|
||||
|
||||
=item postinst
|
||||
|
||||
The postinst script of the package.
|
||||
|
||||
=item postrm
|
||||
|
||||
The postrm script of the package.
|
||||
|
||||
=item preinst
|
||||
|
||||
The preinst script of the package.
|
||||
|
||||
=item prerm
|
||||
|
||||
The prerm script of the package.
|
||||
|
||||
=item usescripts
|
||||
|
||||
Only use the above scripts fields when generating the package if this is set
|
||||
to a true value.
|
||||
|
||||
=item unpacked_tree
|
||||
|
||||
Points to a directory where the package has been unpacked.
|
||||
|
||||
=item owninfo
|
||||
|
||||
If set this will be a reference to a hash, with filename as key, that holds
|
||||
ownership/group information for files that cannot be represented on the
|
||||
filesystem. Typically that is because the owners or groups just don't exist
|
||||
yet. It will be set at unpack time.
|
||||
|
||||
=item modeinfo
|
||||
|
||||
If set this will be a reference to a hash, with filename as key, that
|
||||
holds mode information for setuid files that have an entry in owninfo.
|
||||
It will be set at unpack time.
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item init
|
||||
|
||||
This is called by new(). It's a handy place to set fields, etc, without
|
||||
having to write your own new() method.
|
||||
|
||||
=cut
|
||||
|
||||
sub init {}
|
||||
|
||||
=item install
|
||||
|
||||
Simply installs a package file. The filename is passed.
|
||||
This has to be overridden in child classes.
|
||||
|
||||
=cut
|
||||
|
||||
sub install {
|
||||
my $this=shift;
|
||||
}
|
||||
|
||||
=item test
|
||||
|
||||
Test a package file. The filename is passed, should return an array of lines
|
||||
of test results. Child classses may implement this.
|
||||
|
||||
=cut
|
||||
|
||||
sub test {
|
||||
my $this=shift;
|
||||
return;
|
||||
}
|
||||
|
||||
=item filename
|
||||
|
||||
Set/get the filename of the package the object represents.
|
||||
|
||||
When it is set, it performs a scan of the file, populating most other
|
||||
fields with data from it.
|
||||
|
||||
(This is just a stub; child classes should override it to actually do
|
||||
something.)
|
||||
|
||||
=cut
|
||||
|
||||
sub filename {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
if (@_) {
|
||||
$this->{filename} = shift;
|
||||
$this->scan;
|
||||
}
|
||||
|
||||
return $this->{filename};
|
||||
}
|
||||
|
||||
=item scripts
|
||||
|
||||
Returns a list of all non-empty maintainer scripts in the package.
|
||||
|
||||
=cut
|
||||
|
||||
sub scripts {
|
||||
my $this=shift;
|
||||
|
||||
my @ret;
|
||||
foreach my $s (qw{postinst postrm preinst prerm}) {
|
||||
my $val=$this->$s;
|
||||
push(@ret, $s) if defined $val && length $val;
|
||||
}
|
||||
return @ret;
|
||||
}
|
||||
|
||||
=item scan
|
||||
|
||||
This method scans the file associated with an object, and populates as many
|
||||
other fields as it can with data from it.
|
||||
|
||||
=cut
|
||||
|
||||
sub scan {
|
||||
my $this=shift;
|
||||
my $file=$this->filename;
|
||||
|
||||
if (! -e $file) {
|
||||
die "$file does not exist; cannot read.";
|
||||
}
|
||||
}
|
||||
|
||||
=item unpack
|
||||
|
||||
This method unpacks the package into a temporary directory. It sets
|
||||
unpacked_tree to point to that directory.
|
||||
|
||||
(This is just a stub method that makes a directory below the current
|
||||
working directory, and sets unpacked_tree to point to it. It should be
|
||||
overridden by child classes to actually unpack the package as well.)
|
||||
|
||||
=cut
|
||||
|
||||
sub unpack {
|
||||
my $this=shift;
|
||||
|
||||
my $workdir = $this->name."-".$this->version;
|
||||
$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.
|
||||
$this->do("chmod 755 $workdir");
|
||||
$this->unpacked_tree($workdir);
|
||||
}
|
||||
|
||||
=item prep
|
||||
|
||||
This method causes the object to prepare a build tree to be used in
|
||||
building the object. It expects that the unpack method has already been
|
||||
called. It takes the tree generated by that method, and mangles it somehow,
|
||||
to produce a suitable build tree.
|
||||
|
||||
(This is just a stub method that all child classes should override.)
|
||||
|
||||
=cut
|
||||
|
||||
sub prep {}
|
||||
|
||||
=item cleantree
|
||||
|
||||
This method should clean the unpacked_tree of any effects the prep and
|
||||
build methods might have on it.
|
||||
|
||||
=cut
|
||||
|
||||
sub cleantree {}
|
||||
|
||||
=item revert
|
||||
|
||||
This method should ensure that the object is in the same state it was in
|
||||
before the prep method was called.
|
||||
|
||||
=cut
|
||||
|
||||
sub revert {}
|
||||
|
||||
=item build
|
||||
|
||||
This method takes a prepped build tree, and simply builds a package from
|
||||
it. It should put the package in the current directory, and should return
|
||||
the filename of the generated package.
|
||||
|
||||
(This is just a stub method that all child classes should override.)
|
||||
|
||||
=cut
|
||||
|
||||
sub build {}
|
||||
|
||||
=item incrementrelease
|
||||
|
||||
This method should increment the release field of the package by
|
||||
the specified number.
|
||||
|
||||
=cut
|
||||
|
||||
sub incrementrelease {
|
||||
my $this=shift;
|
||||
my $number=shift;
|
||||
$^W=0; # Shut of possible "is not numeric" warning.
|
||||
$this->release($this->release + $number);
|
||||
$^W=1; # Re-enable warnings.
|
||||
}
|
||||
|
||||
=item DESTROY
|
||||
|
||||
When an object is destroyed, it cleans some stuff up. In particular, if the
|
||||
package was unpacked, it is time now to wipe out the temporary directory.
|
||||
|
||||
=cut
|
||||
|
||||
sub DESTROY {
|
||||
my $this=shift;
|
||||
|
||||
my $exitcode=$?;
|
||||
|
||||
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!";
|
||||
}
|
||||
|
||||
if (-d $this->unpacked_tree) {
|
||||
# Just in case some dir perms are too screwed up for
|
||||
# rm to work and we're not running as root. NB: can't
|
||||
# use xargs
|
||||
$this->do('find', $this->unpacked_tree, '-type', 'd',
|
||||
'-exec', 'chmod', '755', '{}', ';');
|
||||
|
||||
$this->do('rm', '-rf', $this->unpacked_tree)
|
||||
or die "unable to delete temporary directory '".$this->unpacked_tree."': $!";
|
||||
$this->unpacked_tree('');
|
||||
}
|
||||
|
||||
$?=$exitcode;
|
||||
}
|
||||
|
||||
=item AUTOLOAD
|
||||
|
||||
Handles all fields, by creating accessor methods for them the first time
|
||||
they are accessed.
|
||||
|
||||
=cut
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $field;
|
||||
($field = $AUTOLOAD) =~ s/.*://;
|
||||
|
||||
no strict 'refs';
|
||||
*$AUTOLOAD = sub {
|
||||
my $this=shift;
|
||||
|
||||
return $this->{$field} unless @_;
|
||||
return $this->{$field}=shift;
|
||||
};
|
||||
goto &$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
|
||||
my $ret=(waitpid($pid, 0) > 0);
|
||||
return ! $ret || ! $?;
|
||||
}
|
||||
}
|
||||
|
||||
=item runpipe
|
||||
|
||||
This is similar to backticks, but honors $Alien::Package::verbose, logging
|
||||
the command run if asked to. The output of the command is returned.
|
||||
|
||||
The first parameter controls what to do on error. If it's true then any
|
||||
errors from the command will be ignored (and $? will be set). If it's
|
||||
false, errors will abort alien.
|
||||
|
||||
=cut
|
||||
|
||||
sub runpipe {
|
||||
my $whatever=shift;
|
||||
my $ignoreerror=shift;
|
||||
my @command=@_;
|
||||
if ($Alien::Package::verbose) {
|
||||
print "\t@command\n";
|
||||
}
|
||||
if (wantarray) {
|
||||
my @ret=`@command`;
|
||||
die "Error executing \"@command\": $!" if ! $ignoreerror && $? ne 0;
|
||||
if ($Alien::Package::verbose >= 2) {
|
||||
print @ret;
|
||||
}
|
||||
return @ret;
|
||||
}
|
||||
else {
|
||||
my $ret=`@command`;
|
||||
die "Error executing \"@command\": $!" if ! $ignoreerror && $? ne 0;
|
||||
if ($Alien::Package::verbose >= 2) {
|
||||
print $ret."\n";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Joey Hess <joey@kitenet.net>
|
||||
|
||||
=cut
|
||||
|
||||
1
|
||||
798
Alien/Package/Deb.pm
Normal file
798
Alien/Package/Deb.pm
Normal file
@@ -0,0 +1,798 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Alien::Package::Deb - an object that represents a deb package
|
||||
|
||||
=cut
|
||||
|
||||
package Alien::Package::Deb;
|
||||
use strict;
|
||||
use base qw(Alien::Package);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is an object class that represents a deb package. It is derived from
|
||||
Alien::Package.
|
||||
|
||||
=head1 FIELDS
|
||||
|
||||
=over 4
|
||||
|
||||
=item have_dpkg_deb
|
||||
|
||||
Set to a true value if dpkg-deb is available.
|
||||
|
||||
=item dirtrans
|
||||
|
||||
After the build stage, set to a hash reference of the directories we moved
|
||||
files from and to, so these moves can be reverted in the cleantree stage.
|
||||
|
||||
=item fixperms
|
||||
|
||||
If this is set to true, the generated debian/rules will run dh_fixperms.
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item init
|
||||
|
||||
Sets have_dpkg_deb if dpkg-deb is in the path. I prefer to use dpkg-deb,
|
||||
if it is available since it is a lot more future-proof.
|
||||
|
||||
=cut
|
||||
|
||||
sub _inpath {
|
||||
my $this=shift;
|
||||
my $program=shift;
|
||||
|
||||
foreach (split(/:/,$ENV{PATH})) {
|
||||
if (-x "$_/$program") {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return '';
|
||||
}
|
||||
|
||||
sub init {
|
||||
my $this=shift;
|
||||
$this->SUPER::init(@_);
|
||||
|
||||
$this->have_dpkg_deb($this->_inpath('dpkg-deb'));
|
||||
}
|
||||
|
||||
=item checkfile
|
||||
|
||||
Detect deb files by their extention.
|
||||
|
||||
=cut
|
||||
|
||||
sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
|
||||
return $file =~ m/.*\.u?deb$/;
|
||||
}
|
||||
|
||||
=item install
|
||||
|
||||
Install a deb with dpkg. Pass in the filename of the deb to install.
|
||||
|
||||
=cut
|
||||
|
||||
sub install {
|
||||
my $this=shift;
|
||||
my $deb=shift;
|
||||
|
||||
my $v=$Alien::Package::verbose;
|
||||
$Alien::Package::verbose=2;
|
||||
$this->do("dpkg", "--no-force-overwrite", "-i", $deb)
|
||||
or die "Unable to install";
|
||||
$Alien::Package::verbose=$v;
|
||||
}
|
||||
|
||||
=item test
|
||||
|
||||
Test a deb with lintian. Pass in the filename of the deb to test.
|
||||
|
||||
=cut
|
||||
|
||||
sub test {
|
||||
my $this=shift;
|
||||
my $deb=shift;
|
||||
|
||||
if ($this->_inpath("lintian")) {
|
||||
# Ignore some lintian warnings that don't matter for
|
||||
# aliened packages.
|
||||
return map { s/\n//; $_ }
|
||||
grep {
|
||||
! /unknown-section alien/
|
||||
} $this->runpipe(1, "lintian '$deb'");
|
||||
}
|
||||
else {
|
||||
return "lintian not available, so not testing";
|
||||
}
|
||||
}
|
||||
|
||||
=item getcontrolfile
|
||||
|
||||
Helper method. Pass it the name of a control file, and it will pull it out
|
||||
of the deb and return it.
|
||||
|
||||
=cut
|
||||
|
||||
sub getcontrolfile {
|
||||
my $this=shift;
|
||||
my $controlfile=shift;
|
||||
my $file=$this->filename;
|
||||
|
||||
if ($this->have_dpkg_deb) {
|
||||
return $this->runpipe(1, "dpkg-deb --info '$file' $controlfile 2>/dev/null");
|
||||
}
|
||||
else {
|
||||
# Solaris tar doesn't support O
|
||||
sub tar_out {
|
||||
my $file = shift;
|
||||
|
||||
return "(mkdir /tmp/tar_out.$$ &&".
|
||||
" cd /tmp/tar_out.$$ &&".
|
||||
" tar xf - './$file' &&".
|
||||
" 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 $this->runpipe(1, $getcontrol);
|
||||
}
|
||||
}
|
||||
|
||||
=item scan
|
||||
|
||||
Implement the scan method to read a deb file.
|
||||
|
||||
=cut
|
||||
|
||||
sub scan {
|
||||
my $this=shift;
|
||||
$this->SUPER::scan(@_);
|
||||
my $file=$this->filename;
|
||||
|
||||
my @control=$this->getcontrolfile('control');
|
||||
die "Control file couldn't be read!"
|
||||
if @control == 0;
|
||||
# Parse control file and extract fields. Use a translation table
|
||||
# to map between the debian names and the internal field names,
|
||||
# which more closely resemble those used by rpm (for historical
|
||||
# reasons; TODO: change to deb style names).
|
||||
my $description='';
|
||||
my $field;
|
||||
my %fieldtrans=(
|
||||
Package => 'name',
|
||||
Version => 'version',
|
||||
Architecture => 'arch',
|
||||
Maintainer => 'maintainer',
|
||||
Section => 'group',
|
||||
Description => 'summary',
|
||||
);
|
||||
for (my $i=0; $i <= $#control; $i++) {
|
||||
$_ = $control[$i];
|
||||
chomp;
|
||||
if (/^(\w.*?):\s+(.*)/) {
|
||||
# Really old debs might have oddly capitalized
|
||||
# field names.
|
||||
$field=ucfirst(lc($1));
|
||||
if (exists $fieldtrans{$field}) {
|
||||
$field=$fieldtrans{$field};
|
||||
$this->$field($2);
|
||||
}
|
||||
}
|
||||
elsif (/^ / && $field eq 'summary') {
|
||||
# Handle extended description.
|
||||
s/^ //g;
|
||||
$_="" if $_ eq ".";
|
||||
$description.="$_\n";
|
||||
}
|
||||
}
|
||||
$this->description($description);
|
||||
|
||||
$this->copyright("see /usr/share/doc/".$this->name."/copyright");
|
||||
$this->group("unknown") if ! $this->group;
|
||||
$this->distribution("Debian");
|
||||
$this->origformat("deb");
|
||||
$this->binary_info(scalar $this->getcontrolfile('control'));
|
||||
|
||||
# Read in the list of conffiles, if any.
|
||||
my @conffiles;
|
||||
@conffiles=map { chomp; $_ } $this->getcontrolfile('conffiles');
|
||||
$this->conffiles(\@conffiles);
|
||||
|
||||
# Read in the list of all files.
|
||||
# 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:\./::; "/$_" }
|
||||
$this->runpipe(0, "dpkg-deb --fsys-tarfile '$file' | tar tf -");
|
||||
}
|
||||
else {
|
||||
@filelist=map { chomp; s:\./::; "/$_" }
|
||||
$this->runpipe(0, "ar -p '$file' data.tar.gz | gzip -dc | tar tf -");
|
||||
}
|
||||
$this->filelist(\@filelist);
|
||||
|
||||
# Read in the scripts, if any.
|
||||
foreach my $field (qw{postinst postrm preinst prerm}) {
|
||||
$this->$field(scalar $this->getcontrolfile($field));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item unpack
|
||||
|
||||
Implement the unpack method to unpack a deb file.
|
||||
|
||||
=cut
|
||||
|
||||
sub unpack {
|
||||
my $this=shift;
|
||||
$this->SUPER::unpack(@_);
|
||||
my $file=$this->filename;
|
||||
|
||||
if ($this->have_dpkg_deb) {
|
||||
$this->do("dpkg-deb", "-x", $file, $this->unpacked_tree)
|
||||
or die "Unpacking of '$file' failed: $!";
|
||||
}
|
||||
else {
|
||||
$this->do("ar -p $file data.tar.gz | gzip -dc | (cd ".$this->unpacked_tree."; tar xpf -)")
|
||||
or die "Unpacking of '$file' failed: $!";
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item getpatch
|
||||
|
||||
This method tries to find a patch file to use in the prep stage. If it
|
||||
finds one, it returns it. Pass in a list of directories to search for
|
||||
patches in.
|
||||
|
||||
=cut
|
||||
|
||||
sub getpatch {
|
||||
my $this=shift;
|
||||
my $anypatch=shift;
|
||||
|
||||
my @patches;
|
||||
foreach my $dir (@_) {
|
||||
push @patches, glob("$dir/".$this->name."_".$this->version."-".$this->release."*.diff.gz");
|
||||
}
|
||||
if (! @patches) {
|
||||
# Try not matching the release, see if that helps.
|
||||
foreach my $dir (@_) {
|
||||
push @patches,glob("$dir/".$this->name."_".$this->version."*.diff.gz");
|
||||
}
|
||||
if (@patches && $anypatch) {
|
||||
# Fallback to anything that matches the name.
|
||||
foreach my $dir (@_) {
|
||||
push @patches,glob("$dir/".$this->name."_*.diff.gz");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# If we ended up with multiple matches, return the first.
|
||||
return $patches[0];
|
||||
}
|
||||
|
||||
=item prep
|
||||
|
||||
Adds a populated debian directory the unpacked package tree, making it
|
||||
ready for building. This can either be done automatically, or via a patch
|
||||
file.
|
||||
|
||||
=cut
|
||||
|
||||
sub prep {
|
||||
my $this=shift;
|
||||
my $dir=$this->unpacked_tree || die "The package must be unpacked first!";
|
||||
|
||||
$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.
|
||||
$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 $this->runpipe(1, "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.
|
||||
open (my $changelog, "<$dir/debian/changelog") || return;
|
||||
my $line=<$changelog>;
|
||||
if ($line=~/^[^ ]+\s+\(([^)]+)\)\s/) {
|
||||
my $version=$1;
|
||||
$version=~s/\s+//; # ensure no whitespace
|
||||
if ($version=~/(.*)-(.*)/) {
|
||||
$version=$1;
|
||||
$this->release($2);
|
||||
}
|
||||
$this->version($1);
|
||||
}
|
||||
close $changelog;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# Automatic debianization.
|
||||
# Changelog file.
|
||||
open (OUT, ">$dir/debian/changelog") || die "$dir/debian/changelog: $!";
|
||||
print OUT $this->name." (".$this->version."-".$this->release.") experimental; urgency=low\n";
|
||||
print OUT "\n";
|
||||
print OUT " * Converted from .".$this->origformat." format to .deb by alien version $Alien::Version\n";
|
||||
print OUT " \n";
|
||||
if (defined $this->changelogtext) {
|
||||
my $ct=$this->changelogtext;
|
||||
$ct=~s/^/ /gm;
|
||||
print OUT $ct."\n";
|
||||
}
|
||||
print OUT "\n";
|
||||
print OUT " -- ".$this->username." <".$this->email."> ".$this->date."\n";
|
||||
close OUT;
|
||||
|
||||
# Control file.
|
||||
open (OUT, ">$dir/debian/control") || die "$dir/debian/control: $!";
|
||||
print OUT "Source: ".$this->name."\n";
|
||||
print OUT "Section: alien\n";
|
||||
print OUT "Priority: extra\n";
|
||||
print OUT "Maintainer: ".$this->username." <".$this->email.">\n";
|
||||
print OUT "\n";
|
||||
print OUT "Package: ".$this->name."\n";
|
||||
print OUT "Architecture: ".$this->arch."\n";
|
||||
if (defined $this->depends) {
|
||||
print OUT "Depends: ".join(", ", "\${shlibs:Depends}", $this->depends)."\n";
|
||||
}
|
||||
else {
|
||||
print OUT "Depends: \${shlibs:Depends}\n";
|
||||
}
|
||||
print OUT "Description: ".$this->summary."\n";
|
||||
print OUT $this->description."\n";
|
||||
close OUT;
|
||||
|
||||
# Copyright file.
|
||||
open (OUT, ">$dir/debian/copyright") || die "$dir/debian/copyright: $!";
|
||||
print OUT "This package was debianized by the alien program by converting\n";
|
||||
print OUT "a binary .".$this->origformat." package on ".$this->date."\n";
|
||||
print OUT "\n";
|
||||
print OUT "Copyright: ".$this->copyright."\n";
|
||||
print OUT "\n";
|
||||
print OUT "Information from the binary package:\n";
|
||||
print OUT $this->binary_info."\n";
|
||||
close OUT;
|
||||
|
||||
# Conffiles, if any. Note that debhelper takes care of files in /etc.
|
||||
my @conffiles=grep { $_ !~ /^\/etc/ } @{$this->conffiles};
|
||||
if (@conffiles) {
|
||||
open (OUT, ">$dir/debian/conffiles") || die "$dir/debian/conffiles: $!";
|
||||
print OUT join("\n", @conffiles)."\n";
|
||||
close OUT;
|
||||
}
|
||||
|
||||
# Use debhelper v7
|
||||
open (OUT, ">$dir/debian/compat") || die "$dir/debian/compat: $!";
|
||||
print OUT "7\n";
|
||||
close OUT;
|
||||
|
||||
# A minimal rules file.
|
||||
open (OUT, ">$dir/debian/rules") || die "$dir/debian/rules: $!";
|
||||
my $fixpermscomment = $this->fixperms ? "" : "#";
|
||||
print OUT << "EOF";
|
||||
#!/usr/bin/make -f
|
||||
# debian/rules for alien
|
||||
|
||||
PACKAGE=\$(shell dh_listpackages)
|
||||
|
||||
build:
|
||||
dh_testdir
|
||||
|
||||
clean:
|
||||
dh_testdir
|
||||
dh_testroot
|
||||
dh_clean -d
|
||||
|
||||
binary-indep: build
|
||||
|
||||
binary-arch: build
|
||||
dh_testdir
|
||||
dh_testroot
|
||||
dh_prep
|
||||
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)
|
||||
|
||||
#
|
||||
# If you need to move files around in debian/\$(PACKAGE) or do some
|
||||
# binary patching, do it here
|
||||
#
|
||||
|
||||
|
||||
# This has been known to break on some wacky binaries.
|
||||
# dh_strip
|
||||
dh_compress
|
||||
$fixpermscomment dh_fixperms
|
||||
dh_makeshlibs
|
||||
dh_installdeb
|
||||
-dh_shlibdeps
|
||||
dh_gencontrol
|
||||
dh_md5sums
|
||||
dh_builddeb
|
||||
|
||||
binary: binary-indep binary-arch
|
||||
.PHONY: build clean binary-indep binary-arch binary
|
||||
EOF
|
||||
close OUT;
|
||||
$this->do("chmod", 755, "$dir/debian/rules");
|
||||
|
||||
if ($this->usescripts) {
|
||||
foreach my $script (qw{postinst postrm preinst prerm}) {
|
||||
$this->savescript($script, $this->$script());
|
||||
}
|
||||
}
|
||||
else {
|
||||
# There may be a postinst with permissions fixups even when
|
||||
# scripts are disabled.
|
||||
$this->savescript("postinst", undef);
|
||||
}
|
||||
|
||||
my %dirtrans=( # Note: no trailing slashes on these directory names!
|
||||
# Move files to FHS-compliant locations, if possible.
|
||||
'/usr/man' => '/usr/share/man',
|
||||
'/usr/info' => '/usr/share/info',
|
||||
'/usr/doc' => '/usr/share/doc',
|
||||
);
|
||||
foreach my $olddir (keys %dirtrans) {
|
||||
if (-d "$dir/$olddir" && ! -e "$dir/$dirtrans{$olddir}") {
|
||||
# Ignore failure..
|
||||
my ($dirbase)=$dirtrans{$olddir}=~/(.*)\//;
|
||||
$this->do("install", "-d", "$dir/$dirbase");
|
||||
$this->do("mv", "$dir/$olddir", "$dir/$dirtrans{$olddir}");
|
||||
if (-d "$dir/$olddir") {
|
||||
$this->do("rmdir", "-p", "$dir/$olddir");
|
||||
}
|
||||
}
|
||||
else {
|
||||
delete $dirtrans{$olddir};
|
||||
}
|
||||
}
|
||||
$this->dirtrans(\%dirtrans); # store for cleantree
|
||||
}
|
||||
|
||||
=item build
|
||||
|
||||
Build a deb.
|
||||
|
||||
=cut
|
||||
|
||||
sub build {
|
||||
my $this=shift;
|
||||
|
||||
# Detect architecture mismatch and abort with a comprehensible
|
||||
# error message.
|
||||
my $arch=$this->arch;
|
||||
if ($arch ne 'all') {
|
||||
my $ret=system("dpkg-architecture", "-i".$arch);
|
||||
if ($ret != 0) {
|
||||
die $this->filename." is for architecture ".$this->arch." ; the package cannot be built on this system"."\n";
|
||||
}
|
||||
}
|
||||
|
||||
chdir $this->unpacked_tree;
|
||||
my $log=$this->runpipe(1, "debian/rules binary 2>&1");
|
||||
chdir "..";
|
||||
my $err=$?;
|
||||
if ($err) {
|
||||
if (! defined $log) {
|
||||
die "Package build failed; could not run generated debian/rules file.\n";
|
||||
}
|
||||
die "Package build failed. Here's the log:\n", $log;
|
||||
}
|
||||
|
||||
return $this->name."_".$this->version."-".$this->release."_".$this->arch.".deb";
|
||||
}
|
||||
|
||||
=item cleantree
|
||||
|
||||
Delete the entire debian/ directory.
|
||||
|
||||
=cut
|
||||
|
||||
sub cleantree {
|
||||
my $this=shift;
|
||||
my $dir=$this->unpacked_tree || die "The package must be unpacked first!";
|
||||
|
||||
my %dirtrans=%{$this->dirtrans};
|
||||
foreach my $olddir (keys %dirtrans) {
|
||||
if (! -e "$dir/$olddir" && -d "$dir/$dirtrans{$olddir}") {
|
||||
# Ignore failure.. (should I?)
|
||||
my ($dirbase)=$dir=~/(.*)\//;
|
||||
$this->do("install", "-d", "$dir/$dirbase");
|
||||
$this->do("mv", "$dir/$dirtrans{$olddir}", "$dir/$olddir");
|
||||
if (-d "$dir/$dirtrans{$olddir}") {
|
||||
$this->do("rmdir", "-p", "$dir/$dirtrans{$olddir}");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$this->do("rm", "-rf", "$dir/debian");
|
||||
}
|
||||
|
||||
=item package
|
||||
|
||||
Set/get package name.
|
||||
|
||||
Always returns the packge name in lowercase with all invalid characters
|
||||
rmoved. The name is however, stored unchanged.
|
||||
|
||||
=cut
|
||||
|
||||
sub name {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
$this->{name} = shift if @_;
|
||||
return unless defined wantarray; # optimization
|
||||
|
||||
# get
|
||||
$_=lc($this->{name});
|
||||
tr/_/-/;
|
||||
s/[^a-z0-9-\.\+]//g;
|
||||
return $_;
|
||||
}
|
||||
|
||||
=item version
|
||||
|
||||
Set/get package version.
|
||||
|
||||
When the version is set, it will be stripped of any epoch. If there is a
|
||||
release, the release will be stripped away and used to set the release
|
||||
field as a side effect. Otherwise, the release will be set to 1.
|
||||
|
||||
More sanitization of the version is done when the field is retrieved, to
|
||||
make sure it is a valid debian version field.
|
||||
|
||||
=cut
|
||||
|
||||
sub version {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
if (@_) {
|
||||
my $version=shift;
|
||||
if ($version =~ /(.+)-(.+)/) {
|
||||
$version=$1;
|
||||
$this->release($2);
|
||||
}
|
||||
else {
|
||||
$this->release(1);
|
||||
}
|
||||
# Kill epochs.
|
||||
$version=~s/^\d+://;
|
||||
|
||||
$this->{version}=$version;
|
||||
}
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
$_=$this->{version};
|
||||
# Make sure the version contains a digit at the start, as required
|
||||
# by dpkg-deb.
|
||||
unless (/^[0-9]/) {
|
||||
$_="0".$_;
|
||||
}
|
||||
# filter out some characters not allowed in debian versions
|
||||
s/[^-.+~:A-Za-z0-9]//g; # see lib/dpkg/parsehelp.c parseversion
|
||||
return $_;
|
||||
}
|
||||
|
||||
=item release
|
||||
|
||||
Set/get package release.
|
||||
|
||||
Always returns a sanitized release version. The release is however, stored
|
||||
unchanged.
|
||||
|
||||
=cut
|
||||
|
||||
sub release {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
$this->{release} = shift if @_;
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
$_=$this->{release};
|
||||
# Make sure the release contains digets.
|
||||
return $_."-1" unless /[0-9]/;
|
||||
return $_;
|
||||
}
|
||||
|
||||
=item description
|
||||
|
||||
Set/get description
|
||||
|
||||
Although the description is stored internally unchanged, this will always
|
||||
return a sanitized form of it that is compliant with Debian standards.
|
||||
|
||||
=cut
|
||||
|
||||
sub description {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
$this->{description} = shift if @_;
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
my $ret='';
|
||||
foreach (split /\n/,$this->{description}) {
|
||||
s/\t/ /g; # change tabs to spaces
|
||||
s/\s+$//g; # remove trailing whitespace
|
||||
$_="." if $_ eq ''; # empty lines become dots
|
||||
$ret.=" $_\n";
|
||||
}
|
||||
$ret=~s/^\n+//g; # kill leading blank lines
|
||||
$ret.=" .\n" if length $ret;
|
||||
$ret.=" (Converted from a ".$this->origformat." package by alien version $Alien::Version.)";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
=item date
|
||||
|
||||
Returns the date, in rfc822 format.
|
||||
|
||||
=cut
|
||||
|
||||
sub date {
|
||||
my $this=shift;
|
||||
|
||||
my $date=$this->runpipe(1, "date -R");
|
||||
chomp $date;
|
||||
if (!$date) {
|
||||
die "date -R did not return a valid result.";
|
||||
}
|
||||
|
||||
return $date;
|
||||
}
|
||||
|
||||
=item email
|
||||
|
||||
Returns an email address for the current user.
|
||||
|
||||
=cut
|
||||
|
||||
sub email {
|
||||
my $this=shift;
|
||||
|
||||
return $ENV{EMAIL} if exists $ENV{EMAIL};
|
||||
|
||||
my $login = getlogin || (getpwuid($<))[0] || $ENV{USER};
|
||||
my $mailname='';
|
||||
if (open (MAILNAME,"</etc/mailname")) {
|
||||
$mailname=<MAILNAME>;
|
||||
if (defined $mailname) {
|
||||
chomp $mailname;
|
||||
}
|
||||
close MAILNAME;
|
||||
}
|
||||
if (!$mailname) {
|
||||
$mailname=$this->runpipe(1, "hostname");
|
||||
chomp $mailname;
|
||||
}
|
||||
return "$login\@$mailname";
|
||||
}
|
||||
|
||||
=item username
|
||||
|
||||
Returns the user name of the real uid.
|
||||
|
||||
=cut
|
||||
|
||||
sub username {
|
||||
my $this=shift;
|
||||
|
||||
my $username;
|
||||
my $login = getlogin || (getpwuid($<))[0] || $ENV{USER};
|
||||
(undef, undef, undef, undef, undef, undef, $username) = getpwnam($login);
|
||||
|
||||
# Remove GECOS fields from username.
|
||||
$username=~s/,.*//g;
|
||||
|
||||
# The ultimate fallback.
|
||||
if ($username eq '') {
|
||||
$username=$login;
|
||||
}
|
||||
|
||||
return $username;
|
||||
}
|
||||
|
||||
=item savescript
|
||||
|
||||
Saves script to debian directory.
|
||||
|
||||
=cut
|
||||
|
||||
sub savescript {
|
||||
my $this=shift;
|
||||
my $script=shift;
|
||||
my $data=shift;
|
||||
|
||||
if ($script eq 'postinst') {
|
||||
$data=$this->gen_postinst($data);
|
||||
}
|
||||
|
||||
my $dir=$this->unpacked_tree;
|
||||
|
||||
return unless defined $data;
|
||||
next if $data =~ m/^\s*$/;
|
||||
open (OUT,">$dir/debian/$script") ||
|
||||
die "$dir/debian/$script: $!";
|
||||
print OUT $data;
|
||||
close OUT;
|
||||
}
|
||||
|
||||
=item gen_postinst
|
||||
|
||||
Modifies or creates a postinst. This may include generated shell code to set
|
||||
owners and groups from the owninfo field, and update modes from the modeinfo
|
||||
field.
|
||||
|
||||
=cut
|
||||
|
||||
sub gen_postinst {
|
||||
my $this=shift;
|
||||
my $postinst=shift;
|
||||
|
||||
my $owninfo = $this->owninfo;
|
||||
my $modeinfo = $this->modeinfo;
|
||||
return $postinst unless ref $owninfo && %$owninfo;
|
||||
|
||||
# If there is no postinst, let's make one up..
|
||||
$postinst="#!/bin/sh\n" unless defined $postinst && length $postinst;
|
||||
|
||||
my ($firstline, $rest)=split(/\n/, $postinst, 2);
|
||||
if ($firstline !~ m/^#!\s*\/bin\/(ba)?sh/) {
|
||||
print STDERR "warning: unable to add ownership fixup code to postinst as the postinst is not a shell script!\n";
|
||||
return $postinst;
|
||||
}
|
||||
|
||||
my $permscript="# alien added permissions fixup code\n";
|
||||
foreach my $file (sort keys %$owninfo) {
|
||||
my $quotedfile=$file;
|
||||
$quotedfile=~s/'/'"'"'/g; # no single quotes in single quotes..
|
||||
$permscript.="chown '".$owninfo->{$file}."' '$quotedfile'\n";
|
||||
$permscript.="chmod '".$modeinfo->{$file}."' '$quotedfile'\n"
|
||||
if (defined $modeinfo->{$file});
|
||||
}
|
||||
return "$firstline\n$permscript\n$rest";
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Joey Hess <joey@kitenet.net>
|
||||
|
||||
=cut
|
||||
|
||||
1
|
||||
132
Alien/Package/Lsb.pm
Normal file
132
Alien/Package/Lsb.pm
Normal file
@@ -0,0 +1,132 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Alien::Package::Lsb - an object that represents a lsb package
|
||||
|
||||
=cut
|
||||
|
||||
package Alien::Package::Lsb;
|
||||
use strict;
|
||||
use base qw(Alien::Package::Rpm);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is an object class that represents a lsb package. It is derived from
|
||||
Alien::Package::Rpm.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item checkfile
|
||||
|
||||
Lsb files are rpm's with a lsb- prefix, that depend on a package called 'lsb'
|
||||
and nothing else.
|
||||
|
||||
=cut
|
||||
|
||||
sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
return unless $file =~ m/^lsb-.*\.rpm$/;
|
||||
my @deps=$this->runpipe(1, "LANG=C rpm -qp -R '$file'");
|
||||
return 1 if grep { s/\s+//g; $_ eq 'lsb' } @deps;
|
||||
return;
|
||||
}
|
||||
|
||||
=item scan
|
||||
|
||||
Uses the parent scan method to read the file. lsb is added to the depends.
|
||||
|
||||
=cut
|
||||
|
||||
sub scan {
|
||||
my $this=shift;
|
||||
$this->SUPER::scan(@_);
|
||||
|
||||
$this->distribution("Linux Standard Base");
|
||||
$this->origformat("lsb");
|
||||
$this->depends("lsb");
|
||||
# Converting from lsb, so the scripts should be portable and safe.
|
||||
# Haha.
|
||||
$this->usescripts(1);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item prep
|
||||
|
||||
The parent's prep method is used to generate the spec file. First though,
|
||||
the package's name is munged to make it lsb compliant (sorta) and lsb is added
|
||||
to its dependencies.
|
||||
|
||||
=cut
|
||||
|
||||
sub prep {
|
||||
my $this=shift;
|
||||
|
||||
$this->_orig_name($this->name);
|
||||
if ($this->name !~ /^lsb-/) {
|
||||
$this->name("lsb-".$this->name);
|
||||
}
|
||||
$this->_orig_depends($this->depends);
|
||||
$this->depends("lsb");
|
||||
# Always include scripts when generating lsb package.
|
||||
$this->_orig_usescripts($this->usescripts);
|
||||
$this->usescripts(1);
|
||||
|
||||
$this->SUPER::prep(@_);
|
||||
}
|
||||
|
||||
=item revert
|
||||
|
||||
Undo the changes made by prep.
|
||||
|
||||
=cut
|
||||
|
||||
sub revert {
|
||||
my $this=shift;
|
||||
$this->name($this->_orig_name);
|
||||
$this->depends($this->_orig_depends);
|
||||
$this->usescripts($this->_orig_usescripts);
|
||||
$this->SUPER::revert(@_);
|
||||
}
|
||||
|
||||
|
||||
=item build
|
||||
|
||||
Uses the parent's build method. If a lsb-rpmbuild is available, uses it to
|
||||
build the package.
|
||||
|
||||
=cut
|
||||
|
||||
sub build {
|
||||
my $this=shift;
|
||||
my $buildcmd=shift || 'rpmbuild';
|
||||
foreach (split(/:/,$ENV{PATH})) {
|
||||
if (-x "$_/lsb-rpmbuild") {
|
||||
$buildcmd='lsb-rpmbuild';
|
||||
last;
|
||||
}
|
||||
}
|
||||
$this->SUPER::build($buildcmd);
|
||||
}
|
||||
|
||||
=item incrementrelease
|
||||
|
||||
LSB package versions are not changed.
|
||||
|
||||
=cut
|
||||
|
||||
sub incrementrelease {}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Joey Hess <joey@kitenet.net>
|
||||
|
||||
=cut
|
||||
|
||||
1
|
||||
338
Alien/Package/Pkg.pm
Normal file
338
Alien/Package/Pkg.pm
Normal file
@@ -0,0 +1,338 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Alien::Package::Pkg - an object that represents a Solaris pkg package
|
||||
|
||||
=cut
|
||||
|
||||
package Alien::Package::Pkg;
|
||||
use strict;
|
||||
use base qw(Alien::Package);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is an object class that represents a pkg package, as used in Solaris.
|
||||
It is derived from Alien::Package.
|
||||
|
||||
=head1 CLASS DATA
|
||||
|
||||
=over 4
|
||||
|
||||
=item scripttrans
|
||||
|
||||
Translation table between canoical script names and the names used in
|
||||
pkg's.
|
||||
|
||||
=cut
|
||||
|
||||
use constant scripttrans => {
|
||||
postinst => 'postinstall',
|
||||
preinst => 'preinstall',
|
||||
};
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item init
|
||||
|
||||
This class needs the Solaris pkginfo and kgtrans tools to work.
|
||||
|
||||
=cut
|
||||
|
||||
sub init {
|
||||
foreach (qw(/usr/bin/pkginfo /usr/bin/pkgtrans)) {
|
||||
-x || die "$_ is needed to use ".__PACKAGE__."\n";
|
||||
}
|
||||
}
|
||||
|
||||
=item converted_name
|
||||
|
||||
Convert name from something debian-like to something that the
|
||||
Solaris constraints will handle (i.e. 9 chars max).
|
||||
|
||||
=cut
|
||||
|
||||
sub converted_name {
|
||||
my $this = shift;
|
||||
my $prefix = "ALN";
|
||||
my $name = $this->name;
|
||||
|
||||
for ($name) { # A Short list to start us off.
|
||||
# Still, this is risky since we need
|
||||
# unique names.
|
||||
s/^lib/l/;
|
||||
s/-perl$/p/;
|
||||
s/^perl-/pl/;
|
||||
}
|
||||
|
||||
$name = substr($name, 0, 9);
|
||||
|
||||
return $prefix.$name;
|
||||
}
|
||||
|
||||
=item checkfile
|
||||
|
||||
Detect pkg files by their contents.
|
||||
|
||||
=cut
|
||||
|
||||
sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
|
||||
open(F, $file) || die "Couldn't open $file: $!\n";
|
||||
my $line = <F>;
|
||||
close F;
|
||||
|
||||
return unless defined $line;
|
||||
|
||||
if($line =~ "# PaCkAgE DaTaStReAm") {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
=item install
|
||||
|
||||
Install a pkg with pkgadd. Pass in the filename of the pkg to install.
|
||||
|
||||
=cut
|
||||
|
||||
sub install {
|
||||
my $this=shift;
|
||||
my $pkg=shift;
|
||||
|
||||
if (-x "/usr/sbin/pkgadd") {
|
||||
my $v=$Alien::Package::verbose;
|
||||
$Alien::Package::verbose=2;
|
||||
$this->do("/usr/sbin/pkgadd", "-d .", "$pkg")
|
||||
or die "Unable to install";
|
||||
$Alien::Package::verbose=$v;
|
||||
}
|
||||
else {
|
||||
die "Sorry, I cannot install the generated .pkg file because /usr/sbin/pkgadd is not present.\n";
|
||||
}
|
||||
}
|
||||
|
||||
=item scan
|
||||
|
||||
Scan a pkg file for fields.
|
||||
|
||||
=cut
|
||||
|
||||
sub scan {
|
||||
my $this=shift;
|
||||
$this->SUPER::scan(@_);
|
||||
my $file=$this->filename;
|
||||
my $tdir="pkg-scan-tmp.$$";
|
||||
|
||||
$this->do("mkdir", $tdir) || die "Error making $tdir: $!\n";
|
||||
|
||||
my $pkgname;
|
||||
if (-x "/usr/bin/pkginfo" && -x "/usr/bin/pkgtrans") {
|
||||
my $pkginfo;
|
||||
|
||||
open(INFO, "/usr/bin/pkginfo -d $file|")
|
||||
|| die "Couldn't open pkginfo: $!\n";
|
||||
$_ = <INFO>;
|
||||
($pkgname) = /\S+\s+(\S+)/;
|
||||
close INFO;
|
||||
|
||||
# Extract the files
|
||||
$this->do("/usr/bin/pkgtrans -i $file $tdir $pkgname")
|
||||
|| die "Error running pkgtrans: $!\n";
|
||||
|
||||
open(INFO, "$tdir/$pkgname/pkginfo")
|
||||
|| die "Couldn't open pkgparam: $!\n";
|
||||
my ($key, $value);
|
||||
while (<INFO>) {
|
||||
if (/^([^=]+)=(.*)$/) {
|
||||
$key = $1;
|
||||
$value = $2;
|
||||
}
|
||||
else {
|
||||
$value = $_;
|
||||
}
|
||||
push @{$pkginfo->{$key}}, $value
|
||||
}
|
||||
close INFO;
|
||||
$file =~ m,([^/]+)-[^-]+(?:.pkg)$,;
|
||||
$this->name($1);
|
||||
$this->arch($pkginfo->{ARCH}->[0]);
|
||||
$this->summary("Converted Solaris pkg package");
|
||||
$this->description(join("", @{[$pkginfo->{DESC} || "."]}));
|
||||
$this->version($pkginfo->{VERSION}->[0]);
|
||||
$this->distribution("Solaris");
|
||||
$this->group("unknown"); # *** FIXME
|
||||
$this->origformat('pkg');
|
||||
$this->changelogtext('');
|
||||
$this->binary_info('unknown'); # *** FIXME
|
||||
|
||||
if (-f "$tdir/$pkgname/copyright") {
|
||||
open (COPYRIGHT, "$file/install/copyright")
|
||||
|| die "Couldn't open copyright: $!\n";
|
||||
$this->copyright(join("\n",<COPYRIGHT>));
|
||||
close(COPYRIGHT);
|
||||
}
|
||||
else {
|
||||
$this->copyright("unknown");
|
||||
}
|
||||
}
|
||||
|
||||
# Now figure out the conffiles. Assume anything in etc/ is a
|
||||
# conffile.
|
||||
my @conffiles;
|
||||
my @filelist;
|
||||
my @scripts;
|
||||
open (FILELIST,"$tdir/$pkgname/pkgmap") ||
|
||||
die "getting filelist ($file/pkgmap): $!";
|
||||
while (<FILELIST>) {
|
||||
if (m,^1 f \S+ etc/([^\s=]+),) {
|
||||
push @conffiles, "/etc/$1";
|
||||
}
|
||||
if (m,^1 [fd] \S+ ([^\s=]+),) {
|
||||
push @filelist, $1;
|
||||
}
|
||||
if (m,^1 i (\S+),) {
|
||||
push @scripts, $1;
|
||||
}
|
||||
}
|
||||
|
||||
$this->filelist(\@filelist);
|
||||
$this->conffiles(\@conffiles);
|
||||
|
||||
# Now get the scripts.
|
||||
foreach my $script (keys %{scripttrans()}) {
|
||||
$this->$script(scripttrans()->{$script})
|
||||
if -e "$file/".scripttrans()->{$script};
|
||||
}
|
||||
|
||||
$this->do("rm -rf $tdir");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item unpack
|
||||
|
||||
Unpack pkg.
|
||||
|
||||
=cut
|
||||
|
||||
sub unpack {
|
||||
my $this=shift;
|
||||
$this->SUPER::unpack(@_);
|
||||
my $file=$this->filename;
|
||||
|
||||
my $pkgname;
|
||||
open(INFO, "/usr/bin/pkginfo -d $file|")
|
||||
|| die "Couldn't open pkginfo: $!\n";
|
||||
$_ = <INFO>;
|
||||
($pkgname) = /\S+\s+(\S+)/;
|
||||
close INFO;
|
||||
|
||||
if (-x "/usr/bin/pkgtrans") {
|
||||
my $workdir = $this->name."-".$this->version;;
|
||||
$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";
|
||||
rmdir $workdir;
|
||||
rename("$ {workdir}_1", $workdir)
|
||||
|| die "unable to rename $ {workdir}_1: $!\n";
|
||||
$this->unpacked_tree($workdir);
|
||||
}
|
||||
}
|
||||
|
||||
=item prep
|
||||
|
||||
Adds a populated install directory to the build tree.
|
||||
|
||||
=cut
|
||||
|
||||
sub prep {
|
||||
my $this=shift;
|
||||
my $dir=$this->unpacked_tree || die "The package must be unpacked first!";
|
||||
|
||||
# opendir(DIR, $this->unpacked_tree);
|
||||
# my @sub = map {$this->unpacked_tree . "$_"}
|
||||
# grep {/^\./} readdir DIR;
|
||||
# closedir DIR;
|
||||
|
||||
$this->do("cd $dir; find . -print | sed -e '/.\\/prototype\$/d' | pkgproto > ./prototype")
|
||||
|| die "error during pkgproto: $!\n";
|
||||
|
||||
open(PKGPROTO, ">>$dir/prototype")
|
||||
|| die "error appending to prototype: $!\n";
|
||||
|
||||
open(PKGINFO, ">$dir/pkginfo")
|
||||
|| die "error creating pkginfo: $!\n";
|
||||
print PKGINFO qq{PKG="}.$this->converted_name.qq{"\n};
|
||||
print PKGINFO qq{NAME="}.$this->name.qq{"\n};
|
||||
print PKGINFO qq{ARCH="}.$this->arch.qq{"\n};
|
||||
print PKGINFO qq{VERSION="}.$this->version.qq{"\n};
|
||||
print PKGINFO qq{CATEGORY="application"\n};
|
||||
print PKGINFO qq{VENDOR="Alien-converted package"\n};
|
||||
print PKGINFO qq{EMAIL=\n};
|
||||
print PKGINFO qq{PSTAMP=alien\n};
|
||||
print PKGINFO qq{MAXINST=1000\n};
|
||||
print PKGINFO qq{BASEDIR="/"\n};
|
||||
print PKGINFO qq{CLASSES="none"\n};
|
||||
print PKGINFO qq{DESC="}.$this->description.qq{"\n};
|
||||
close PKGINFO;
|
||||
print PKGPROTO "i pkginfo=./pkginfo\n";
|
||||
|
||||
$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;
|
||||
close COPYRIGHT;
|
||||
print PKGPROTO "i copyright=./install/copyright\n";
|
||||
|
||||
foreach my $script (keys %{scripttrans()}) {
|
||||
my $data=$this->$script();
|
||||
my $out=$this->unpacked_tree."/install/".${scripttrans()}{$script};
|
||||
next if ! defined $data || $data =~ m/^\s*$/;
|
||||
|
||||
open (OUT, ">$out") || die "$out: $!";
|
||||
print OUT $data;
|
||||
close OUT;
|
||||
$this->do("chmod", 755, $out);
|
||||
print PKGPROTO "i $script=$out\n";
|
||||
}
|
||||
close PKGPROTO;
|
||||
}
|
||||
|
||||
=item build
|
||||
|
||||
Build a pkg.
|
||||
|
||||
=cut
|
||||
|
||||
sub build {
|
||||
my $this = shift;
|
||||
my $dir = $this->unpacked_tree;
|
||||
|
||||
$this->do("cd $dir; pkgmk -r / -d .")
|
||||
|| die "Error during pkgmk: $!\n";
|
||||
|
||||
my $pkgname = $this->converted_name;
|
||||
my $name = $this->name."-".$this->version.".pkg";
|
||||
$this->do("pkgtrans $dir $name $pkgname")
|
||||
|| die "Error during pkgtrans: $!\n";
|
||||
$this->do("mv", "$dir/$name", $name);
|
||||
return $name;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Mark Hershberger <mah@everybody.org>
|
||||
|
||||
=cut
|
||||
|
||||
1
|
||||
644
Alien/Package/Rpm.pm
Normal file
644
Alien/Package/Rpm.pm
Normal file
@@ -0,0 +1,644 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Alien::Package::Rpm - an object that represents a rpm package
|
||||
|
||||
=cut
|
||||
|
||||
package Alien::Package::Rpm;
|
||||
use strict;
|
||||
use base qw(Alien::Package);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is an object class that represents a rpm package. It is derived from
|
||||
Alien::Package.
|
||||
|
||||
=head1 FIELDS
|
||||
|
||||
=over 4
|
||||
|
||||
=item prefixes
|
||||
|
||||
Relocatable rpm packages have a prefixes field.
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item checkfile
|
||||
|
||||
Detect rpm files by their extention.
|
||||
|
||||
=cut
|
||||
|
||||
sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
|
||||
return $file =~ m/.*\.rpm$/;
|
||||
}
|
||||
|
||||
=item install
|
||||
|
||||
Install a rpm. If RPMINSTALLOPT is set in the environement, the options in
|
||||
it are passed to rpm on its command line.
|
||||
|
||||
=cut
|
||||
|
||||
sub install {
|
||||
my $this=shift;
|
||||
my $rpm=shift;
|
||||
|
||||
my $v=$Alien::Package::verbose;
|
||||
$Alien::Package::verbose=2;
|
||||
$this->do("rpm -ivh ".(exists $ENV{RPMINSTALLOPT} ? $ENV{RPMINSTALLOPT} : '').$rpm)
|
||||
or die "Unable to install";
|
||||
$Alien::Package::verbose=$v;
|
||||
}
|
||||
|
||||
=item scan
|
||||
|
||||
Implement the scan method to read a rpm file.
|
||||
|
||||
=cut
|
||||
|
||||
sub scan {
|
||||
my $this=shift;
|
||||
$this->SUPER::scan(@_);
|
||||
my $file=$this->filename;
|
||||
|
||||
my %fieldtrans=(
|
||||
PREIN => 'preinst',
|
||||
POSTIN => 'postinst',
|
||||
PREUN => 'prerm',
|
||||
POSTUN => 'postrm',
|
||||
LICENSE => 'copyright',
|
||||
);
|
||||
|
||||
# Use --queryformat to pull out all the fields we need.
|
||||
foreach my $field (qw{NAME VERSION RELEASE ARCH CHANGELOGTEXT
|
||||
SUMMARY DESCRIPTION PREFIXES},
|
||||
keys(%fieldtrans)) {
|
||||
my $value=$this->runpipe(0, "LANG=C rpm -qp --queryformat \%{$field} '$file'");
|
||||
next if $? || $value eq '(none)';
|
||||
my $key;
|
||||
if (exists $fieldtrans{$field}) {
|
||||
$key=$fieldtrans{$field};
|
||||
}
|
||||
else {
|
||||
$key=lc($field);
|
||||
}
|
||||
$this->$key($value);
|
||||
}
|
||||
|
||||
# Get the conffiles list.
|
||||
$this->conffiles([map { chomp; $_ } $this->runpipe(0, "LANG=C rpm -qcp '$file'")]);
|
||||
if (defined $this->conffiles->[0] &&
|
||||
$this->conffiles->[0] eq '(contains no files)') {
|
||||
$this->conffiles([]);
|
||||
}
|
||||
|
||||
$this->binary_info(scalar $this->runpipe(0, "rpm -qpi '$file'"));
|
||||
|
||||
# Get the filelist.
|
||||
$this->filelist([map { chomp; $_ } $this->runpipe(0, "LANG=C rpm -qpl '$file'")]);
|
||||
if (defined $this->filelist->[0] &&
|
||||
$this->filelist->[0] eq '(contains no files)') {
|
||||
$this->filelist([]);
|
||||
}
|
||||
|
||||
# Sanity check and sanitize fields.
|
||||
unless (defined $this->summary) {
|
||||
# Older rpms will have no summary, but will have a
|
||||
# description. We'll take the 1st line out of the
|
||||
# description, and use it for the summary.
|
||||
$this->summary($this->description."\n")=~m/(.*?)\n/m;
|
||||
|
||||
# Fallback.
|
||||
if (! $this->summary) {
|
||||
$this->summary('Converted RPM package');
|
||||
}
|
||||
}
|
||||
unless (defined $this->description) {
|
||||
$this->description($this->summary);
|
||||
}
|
||||
unless (defined $this->copyright) {
|
||||
# Older rpms have no licence tag, but have a copyright.
|
||||
$this->copyright($this->runpipe(0, "LANG=C rpm -qp --queryformat \%{COPYRIGHT} '$file'"));
|
||||
|
||||
# Fallback.
|
||||
if (! $this->copyright) {
|
||||
$this->copyright('unknown');
|
||||
}
|
||||
}
|
||||
if (! defined $this->release || ! defined $this->version ||
|
||||
! defined $this->name) {
|
||||
die "Error querying rpm file";
|
||||
}
|
||||
|
||||
$this->distribution("Red Hat");
|
||||
$this->origformat("rpm");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item unpack
|
||||
|
||||
Implement the unpack method to unpack a rpm file. This is a little nasty
|
||||
because it has to handle relocatable rpms and has to do a bit of
|
||||
permissions fixing as well.
|
||||
|
||||
=cut
|
||||
|
||||
sub unpack {
|
||||
my $this=shift;
|
||||
$this->SUPER::unpack(@_);
|
||||
my $workdir=$this->unpacked_tree;
|
||||
|
||||
# Check if we need to use lzma to uncompress the cpio archive
|
||||
my $decomp='';
|
||||
if ($this->do("rpm2cpio ".$this->filename." | lzma -t -q > /dev/null 2>&1")) {
|
||||
$decomp = 'lzma -d -q |';
|
||||
}
|
||||
|
||||
$this->do("rpm2cpio ".$this->filename." | (cd $workdir; $decomp cpio --extract --make-directories --no-absolute-filenames --preserve-modification-time) 2>&1")
|
||||
or die "Unpacking of '".$this->filename."' failed";
|
||||
|
||||
# cpio does not necessarily store all parent directories in an
|
||||
# archive, and so some directories, if it has to make them and has
|
||||
# no permission info, will come out with some random permissions.
|
||||
# Find those directories and make them mode 755, which is more
|
||||
# reasonable.
|
||||
my %seenfiles;
|
||||
open (RPMLIST, "rpm2cpio ".$this->filename." | $decomp cpio -it --quiet |")
|
||||
or die "File list of '".$this->filename."' failed";
|
||||
while (<RPMLIST>) {
|
||||
chomp;
|
||||
$seenfiles{$_}=1;
|
||||
}
|
||||
close RPMLIST;
|
||||
foreach my $file (`cd $workdir; find ./`) {
|
||||
chomp $file;
|
||||
if (! $seenfiles{$file} && -d "$workdir/$file" && ! -l "$workdir/$file") {
|
||||
$this->do("chmod 755 $workdir/$file");
|
||||
}
|
||||
}
|
||||
|
||||
# If the package is relocatable. We'd like to move it to be under
|
||||
# the $this->prefixes directory. However, it's possible that that
|
||||
# directory is in the package - it seems some rpm's are marked as
|
||||
# relocatable and unpack already in the directory they can relocate
|
||||
# to, while some are marked relocatable and the directory they can
|
||||
# relocate to is removed from all filenames in the package. I
|
||||
# suppose this is due to some change between versions of rpm, but
|
||||
# none of this is adequatly documented, so we'll just muddle
|
||||
# through.
|
||||
#
|
||||
# Test to see if the package contains the prefix directory already.
|
||||
if (defined $this->prefixes && ! -e "$workdir/".$this->prefixes) {
|
||||
my $relocate=1;
|
||||
|
||||
# Get the files to move.
|
||||
my @filelist=glob("$workdir/*");
|
||||
|
||||
# Now, make the destination directory.
|
||||
my $collect=$workdir;
|
||||
foreach (split m:/:, $this->prefixes) {
|
||||
if ($_ ne '') { # this keeps us from using anything but relative paths.
|
||||
$collect.="/$_";
|
||||
if (-d $collect) {
|
||||
# The package contains a parent
|
||||
# directory of the relocation
|
||||
# directory. Since it's impossible
|
||||
# to move a parent directory into
|
||||
# its child, bail out and do
|
||||
# nothing.
|
||||
$relocate=0;
|
||||
last;
|
||||
}
|
||||
$this->do("mkdir", $collect) || die "unable to mkdir $collect: $!";
|
||||
}
|
||||
}
|
||||
|
||||
if ($relocate) {
|
||||
# Now move all files in the package to the directory we made.
|
||||
if (@filelist) {
|
||||
$this->do("mv", @filelist, "$workdir/".$this->prefixes)
|
||||
or die "error moving unpacked files into the default prefix directory: $!";
|
||||
}
|
||||
|
||||
# Deal with relocating conffiles.
|
||||
my @cf;
|
||||
foreach my $cf (@{$this->conffiles}) {
|
||||
$cf=$this->prefixes.$cf;
|
||||
push @cf, $cf;
|
||||
}
|
||||
$this->conffiles([@cf]);
|
||||
}
|
||||
}
|
||||
|
||||
# rpm files have two sets of permissions; the set in the cpio
|
||||
# archive, and the set in the control data; which override them.
|
||||
# The set in the control data are more correct, so let's use those.
|
||||
# Some permissions setting may have to be postponed until the
|
||||
# postinst.
|
||||
my %owninfo = ();
|
||||
my %modeinfo = ();
|
||||
open (GETPERMS, 'rpm --queryformat \'[%{FILEMODES} %{FILEUSERNAME} %{FILEGROUPNAME} %{FILENAMES}\n]\' -qp '.$this->filename.' |');
|
||||
while (<GETPERMS>) {
|
||||
chomp;
|
||||
my ($mode, $owner, $group, $file) = split(/ /, $_, 4);
|
||||
|
||||
next if -l "$workdir/$file";
|
||||
|
||||
$mode = $mode & 07777; # remove filetype
|
||||
my $uid = getpwnam($owner);
|
||||
if (! defined $uid || $uid != 0) {
|
||||
$owninfo{$file}=$owner;
|
||||
$uid=0;
|
||||
}
|
||||
my $gid = getgrnam($group);
|
||||
if (! defined $gid || $gid != 0) {
|
||||
if (exists $owninfo{$file}) {
|
||||
$owninfo{$file}.=":$group";
|
||||
}
|
||||
else {
|
||||
$owninfo{$file}=":$group";
|
||||
}
|
||||
$gid=0;
|
||||
}
|
||||
if (defined($owninfo{$file}) && (($mode & 07000) > 0)) {
|
||||
$modeinfo{$file} = sprintf "%lo", $mode;
|
||||
}
|
||||
# Note that ghost files exist in the metadata but not
|
||||
# in the cpio archive, so check that the file exists
|
||||
# before trying to access it
|
||||
if (-e "$workdir/$file") {
|
||||
if ($> == 0) {
|
||||
$this->do("chown", "$uid:$gid", "$workdir/$file")
|
||||
|| die "failed chowning $file to $uid\:$gid\: $!";
|
||||
}
|
||||
$this->do("chmod", sprintf("%lo", $mode), "$workdir/$file")
|
||||
|| die "failed changing mode of $file to $mode\: $!";
|
||||
}
|
||||
}
|
||||
$this->owninfo(\%owninfo);
|
||||
$this->modeinfo(\%modeinfo);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item prep
|
||||
|
||||
Prepare for package building by generating the spec file.
|
||||
|
||||
=cut
|
||||
|
||||
sub prep {
|
||||
my $this=shift;
|
||||
my $dir=$this->unpacked_tree || die "The package must be unpacked first!";
|
||||
|
||||
# Place %config in front of files that are conffiles.
|
||||
my @conffiles = @{$this->conffiles};
|
||||
my $filelist;
|
||||
foreach my $fn (@{$this->filelist}) {
|
||||
# Unquote any escaped characters in filenames - needed for
|
||||
# non ascii characters. (eg. iso_8859-1 latin set)
|
||||
if ($fn =~ /\\/) {
|
||||
$fn=eval qq{"$fn"};
|
||||
}
|
||||
|
||||
# Note all filenames are quoted in case they contain
|
||||
# spaces.
|
||||
if ($fn =~ m:/$:) {
|
||||
$filelist.=qq{%dir "$fn"\n};
|
||||
}
|
||||
elsif (grep(m:^\Q$fn\E$:,@conffiles)) { # it's a conffile
|
||||
$filelist.=qq{%config "$fn"\n};
|
||||
}
|
||||
else { # normal file
|
||||
$filelist.=qq{"$fn"\n};
|
||||
}
|
||||
}
|
||||
|
||||
# Write out the spec file.
|
||||
my $spec="$dir/".$this->name."-".$this->version."-".$this->release.".spec";
|
||||
open (OUT, ">$spec") || die "$spec: $!";
|
||||
my $pwd=`pwd`;
|
||||
chomp $pwd;
|
||||
print OUT "Buildroot: $pwd/$dir\n"; # must be absolute dirname
|
||||
print OUT "Name: ".$this->name."\n";
|
||||
print OUT "Version: ".$this->version."\n";
|
||||
print OUT "Release: ".$this->release."\n";
|
||||
print OUT "Requires: ".$this->depends."\n"
|
||||
if defined $this->depends && length $this->depends;
|
||||
print OUT "Summary: ".$this->summary."\n";
|
||||
print OUT "License: ".$this->copyright."\n";
|
||||
print OUT "Distribution: ".$this->distribution."\n";
|
||||
print OUT "Group: Converted/".$this->group."\n";
|
||||
print OUT "\n";
|
||||
print OUT "\%define _rpmdir ../\n"; # write rpm to current directory
|
||||
print OUT "\%define _rpmfilename %%{NAME}-%%{VERSION}-%%{RELEASE}.%%{ARCH}.rpm\n";
|
||||
print OUT "\%define _unpackaged_files_terminate_build 0\n"; # work on SuSE
|
||||
print OUT "\n";
|
||||
if ($this->usescripts) {
|
||||
if ($this->preinst) {
|
||||
print OUT "\%pre\n";
|
||||
print OUT $this->preinst."\n";
|
||||
print OUT "\n";
|
||||
}
|
||||
if ($this->postinst) {
|
||||
print OUT "\%post\n";
|
||||
print OUT $this->postinst."\n";
|
||||
print OUT "\n";
|
||||
}
|
||||
if ($this->prerm) {
|
||||
print OUT "\%preun\n";
|
||||
print OUT $this->prerm."\n";
|
||||
print OUT "\n";
|
||||
}
|
||||
if ($this->postrm) {
|
||||
print OUT "\%postun\n";
|
||||
print OUT $this->postrm."\n";
|
||||
print OUT "\n";
|
||||
}
|
||||
}
|
||||
print OUT "\%description\n";
|
||||
print OUT $this->description."\n";
|
||||
print OUT "\n";
|
||||
print OUT "(Converted from a ".$this->origformat." package by alien version $Alien::Version.)\n";
|
||||
print OUT "\n";
|
||||
print OUT "%files\n";
|
||||
print OUT $filelist if defined $filelist;
|
||||
close OUT;
|
||||
}
|
||||
|
||||
=item cleantree
|
||||
|
||||
Delete the spec file.
|
||||
|
||||
=cut
|
||||
|
||||
sub cleantree {
|
||||
my $this=shift;
|
||||
my $dir=$this->unpacked_tree || die "The package must be unpacked first!";
|
||||
|
||||
unlink "$dir/".$this->name."-".$this->version."-".$this->release.".spec";
|
||||
}
|
||||
|
||||
=item build
|
||||
|
||||
Build a rpm. If RPMBUILDOPT is set in the environement, the options in
|
||||
it are passed to rpm on its command line.
|
||||
|
||||
An optional parameter, if passed, can be used to specify the program to use
|
||||
to build the rpm. It defaults to rpmbuild.
|
||||
|
||||
=cut
|
||||
|
||||
sub build {
|
||||
my $this=shift;
|
||||
my $buildcmd=shift || 'rpmbuild';
|
||||
my $dir=$this->unpacked_tree || die "The package must be unpacked first!";
|
||||
|
||||
# Ask rpm how it's set up. We want to know where it will place rpms.
|
||||
my $rpmdir;
|
||||
foreach ($this->runpipe(1, "rpm --showrc")) {
|
||||
chomp;
|
||||
if (/^rpmdir\s+:\s(.*)$/) {
|
||||
$rpmdir=$1;
|
||||
}
|
||||
}
|
||||
|
||||
my $rpm=$this->name."-".$this->version."-".$this->release.".".$this->arch.".rpm";
|
||||
my $opts='';
|
||||
if ($rpmdir) {
|
||||
# Old versions of rpm toss it off in the middle of nowhere.
|
||||
$rpm="$rpmdir/".$this->arch."/$rpm";
|
||||
|
||||
# This is the old command line argument to set the arch.
|
||||
$opts="--buildarch ".$this->arch;
|
||||
}
|
||||
else {
|
||||
# Presumably we're dealing with rpm 3.0 or above, which
|
||||
# doesn't output rpmdir in any format I'd care to try to
|
||||
# parse. Instead, rpm is now of a late enough version to
|
||||
# notice the %define's in the spec file, that will make the
|
||||
# file end up in the directory we started in.
|
||||
# Anyway, let's assume this is version 3 or above.
|
||||
|
||||
# This is the new command line arcgument to set the arch
|
||||
# rpms. It appeared in rpm version 3.
|
||||
$opts="--target ".$this->arch;
|
||||
}
|
||||
|
||||
$opts.=" $ENV{RPMBUILDOPT}" if exists $ENV{RPMBUILDOPT};
|
||||
my $pwd=`pwd`;
|
||||
chomp $pwd;
|
||||
my $command="cd $dir; $buildcmd --buildroot='$pwd/$dir' -bb $opts '".$this->name."-".$this->version."-".$this->release.".spec'";
|
||||
my $log=$this->runpipe(1, "$command 2>&1");
|
||||
if ($?) {
|
||||
die "Package build failed. Here's the log of the command ($command):\n", $log;
|
||||
}
|
||||
|
||||
return $rpm;
|
||||
}
|
||||
|
||||
=item version
|
||||
|
||||
Set/get version.
|
||||
|
||||
When retreiving the version, remove any dashes in it.
|
||||
|
||||
=cut
|
||||
|
||||
sub version {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
$this->{version} = shift if @_;
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
$_=$this->{version};
|
||||
tr/-/_/;
|
||||
return $_;
|
||||
}
|
||||
|
||||
=item postinst
|
||||
|
||||
=item postrm
|
||||
|
||||
=item preinst
|
||||
|
||||
=item prerm
|
||||
|
||||
Set/get script fields.
|
||||
|
||||
When retrieving a value, we have to do some truely sick mangling. Since
|
||||
debian/slackware scripts can be anything -- perl programs or binary files
|
||||
-- and rpm is limited to only shell scripts, we need to encode the files
|
||||
and add a scrap of shell script to make it unextract and run on the fly.
|
||||
|
||||
When setting a value, we do some mangling too. Rpm maintainer scripts
|
||||
are typically shell scripts, but often lack the leading shebang line.
|
||||
This can confuse dpkg, so add the shebang if it looks like there
|
||||
is no shebang magic already in place.
|
||||
|
||||
Additionally, it's not uncommon for rpm maintainer scripts to contain
|
||||
bashisms, which can be triggered when they are ran on systems where /bin/sh
|
||||
is not bash. To work around this, the shebang line of the scripts is
|
||||
changed to use bash.
|
||||
|
||||
Also, if the rpm is relocatable, the script could refer to
|
||||
RPM_INSTALL_PREFIX, which is set by rpm at run time. Deal with this by
|
||||
adding code to the script to set RPM_INSTALL_PREFIX.
|
||||
|
||||
=cut
|
||||
|
||||
# This helper function deals with all the scripts.
|
||||
sub _script_helper {
|
||||
my $this=shift;
|
||||
my $script=shift;
|
||||
|
||||
# set
|
||||
if (@_) {
|
||||
my $prefixcode="";
|
||||
if (defined $this->prefixes) {
|
||||
$prefixcode="RPM_INSTALL_PREFIX=".$this->prefixes."\n";
|
||||
$prefixcode.="export RPM_INSTALL_PREFIX\n";
|
||||
}
|
||||
|
||||
my $value=shift;
|
||||
if (length $value and $value !~ m/^#!\s*\//) {
|
||||
$value="#!/bin/bash\n$prefixcode$value";
|
||||
}
|
||||
else {
|
||||
$value=~s@^#!\s*/bin/sh(\s)@#!/bin/bash$1@;
|
||||
$value=~s/\n/\n$prefixcode/s;
|
||||
}
|
||||
$this->{$script} = $value;
|
||||
}
|
||||
$this->{$script} = shift if @_;
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
$_=$this->{$script};
|
||||
return '' unless defined $_;
|
||||
return $_ if m/^\s*$/;
|
||||
return $_ if m/^#!\s*\/bin\/sh/; # looks like a shell script already
|
||||
my $f = pack("u",$_);
|
||||
$f =~ s/%/%%/g; # Rpm expands %S, so escape such things.
|
||||
return "#!/bin/sh\n".
|
||||
"set -e\n".
|
||||
"mkdir /tmp/alien.\$\$\n".
|
||||
qq{perl -pe '\$_=unpack("u",\$_)' << '__EOF__' > /tmp/alien.\$\$/script\n}.
|
||||
$f."__EOF__\n".
|
||||
"chmod 755 /tmp/alien.\$\$/script\n".
|
||||
"/tmp/alien.\$\$/script \"\$@\"\n".
|
||||
"rm -f /tmp/alien.\$\$/script\n".
|
||||
"rmdir /tmp/alien.\$\$";
|
||||
}
|
||||
sub postinst {
|
||||
my $this=shift;
|
||||
$this->_script_helper('postinst', @_);
|
||||
}
|
||||
sub postrm {
|
||||
my $this=shift;
|
||||
$this->_script_helper('postrm', @_);
|
||||
}
|
||||
sub preinst {
|
||||
my $this=shift;
|
||||
$this->_script_helper('preinst', @_);
|
||||
}
|
||||
sub prerm {
|
||||
my $this=shift;
|
||||
$this->_script_helper('prerm', @_);
|
||||
}
|
||||
|
||||
=item arch
|
||||
|
||||
Set/get arch field. When the arch field is set, some sanitizing is done
|
||||
first to convert it to the debian format used internally. When it's
|
||||
retreived it's converted back to rpm form from the internal form.
|
||||
|
||||
=cut
|
||||
|
||||
sub arch {
|
||||
my $this=shift;
|
||||
|
||||
my $arch;
|
||||
if (@_) {
|
||||
$arch=shift;
|
||||
|
||||
if ($arch eq 1) {
|
||||
$arch='i386';
|
||||
}
|
||||
elsif ($arch eq 2) {
|
||||
$arch='alpha';
|
||||
}
|
||||
elsif ($arch eq 3) {
|
||||
$arch='sparc';
|
||||
}
|
||||
elsif ($arch eq 6) {
|
||||
$arch='m68k';
|
||||
}
|
||||
elsif ($arch eq 'noarch') {
|
||||
$arch='all';
|
||||
}
|
||||
elsif ($arch eq 'ppc') {
|
||||
$arch='powerpc';
|
||||
}
|
||||
elsif ($arch eq 'x86_64') {
|
||||
$arch='amd64';
|
||||
}
|
||||
elsif ($arch eq 'em64t') {
|
||||
$arch='amd64';
|
||||
}
|
||||
elsif ($arch =~ m/i\d86/i || $arch =~ m/pentium/i) {
|
||||
# Treat 486, 586, etc, as 386.
|
||||
$arch='i386';
|
||||
}
|
||||
elsif ($arch eq 'armv4l') {
|
||||
# Treat armv4l as arm.
|
||||
$arch='arm';
|
||||
}
|
||||
elsif ($arch eq 'parisc') {
|
||||
$arch='hppa';
|
||||
}
|
||||
|
||||
$this->{arch}=$arch;
|
||||
}
|
||||
|
||||
$arch=$this->{arch};
|
||||
if ($arch eq 'amd64') {
|
||||
$arch='x86_64';
|
||||
}
|
||||
elsif ($arch eq 'powerpc') {
|
||||
# XXX is this the canonical name for powerpc on rpm
|
||||
# systems?
|
||||
$arch='ppc';
|
||||
}
|
||||
elsif ($arch eq 'hppa') {
|
||||
$arch='parisc';
|
||||
}
|
||||
elsif ($arch eq 'all') {
|
||||
$arch='noarch';
|
||||
}
|
||||
|
||||
return $arch
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Joey Hess <joey@kitenet.net>
|
||||
|
||||
=cut
|
||||
|
||||
1
|
||||
369
Alien/Package/Slp.pm
Normal file
369
Alien/Package/Slp.pm
Normal file
@@ -0,0 +1,369 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Alien::Package::Slp - an object that represents a slp package
|
||||
|
||||
=cut
|
||||
|
||||
package Alien::Package::Slp;
|
||||
use strict;
|
||||
use base qw(Alien::Package);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is an object class that represents a slp package. It is derived from
|
||||
Alien::Package.
|
||||
|
||||
=head1 CLASS DATA
|
||||
|
||||
The following data is global to the class, and is used to describe the slp
|
||||
package format, which this class processes directly.
|
||||
|
||||
=over 4
|
||||
|
||||
=item footer_size
|
||||
|
||||
Complete sizeof(slpformat) from slp.h in the stampede package manager
|
||||
source.
|
||||
|
||||
=item footer_packstring
|
||||
|
||||
This is the pack format string for the footer. (A=space terminated
|
||||
character, I=unsigned integer.)
|
||||
|
||||
=item footer_version
|
||||
|
||||
What package format are we up to now? (Lowest one this is still
|
||||
compatable with.)
|
||||
|
||||
=item archtrans
|
||||
|
||||
This is a translation table between architectures and the number
|
||||
that represents them in a slp package.
|
||||
|
||||
=item fieldlist
|
||||
|
||||
This is a list of all the fields in the order they appear in the footer.
|
||||
|
||||
=cut
|
||||
|
||||
use constant footer_size => 3784;
|
||||
use constant footer_packstring => "A756IIIIA128A128A80A1536A512A512A30A30IA20A20III";
|
||||
use constant footer_version => 5;
|
||||
use constant archtrans => {
|
||||
0 => 'all',
|
||||
1 => 'i386',
|
||||
2 => 'sparc',
|
||||
3 => 'alpha',
|
||||
4 => 'powerpc',
|
||||
5 => 'm68k',
|
||||
};
|
||||
use constant copyrighttrans => {
|
||||
0 => 'GPL',
|
||||
1 => 'BSD',
|
||||
2 => 'LGPL',
|
||||
3 => 'unknown',
|
||||
254 => 'unknown',
|
||||
};
|
||||
use constant fieldlist => [qw{conffiles priority compresstype release copyright
|
||||
conflicts setupscript summary description depends
|
||||
provides maintainer date compiler version name
|
||||
arch group slpkgversion}];
|
||||
|
||||
=back
|
||||
|
||||
=head1 FIELDS
|
||||
|
||||
=over 4
|
||||
|
||||
=item compresstype
|
||||
|
||||
Holds the compression type used in the slp file.
|
||||
|
||||
=item slpkgversion
|
||||
|
||||
Holds the slp package format version of the slp file.
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item checkfile
|
||||
|
||||
Detect slp files by their extention.
|
||||
|
||||
=cut
|
||||
|
||||
sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
|
||||
return $file =~ m/.*\.slp$/;
|
||||
}
|
||||
|
||||
=item install
|
||||
|
||||
Install a slp. Pass in the filename of the slp to install.
|
||||
|
||||
=cut
|
||||
|
||||
sub install {
|
||||
my $this=shift;
|
||||
my $slp=shift;
|
||||
|
||||
my $v=$Alien::Package::verbose;
|
||||
$Alien::Package::verbose=2;
|
||||
$this->do("slpi", $slp)
|
||||
or die "Unable to install";
|
||||
$Alien::Package::verbose=$v;
|
||||
}
|
||||
|
||||
=item getfooter
|
||||
|
||||
Pulls the footer out of the slp file and returns it.
|
||||
|
||||
=cut
|
||||
|
||||
sub getfooter {
|
||||
my $this=shift;
|
||||
my $file=$this->filename;
|
||||
|
||||
open (SLP,"<$file") || die "$file: $!";
|
||||
# position at beginning of footer (2 = seek from EOF)
|
||||
seek SLP,(- footer_size),2;
|
||||
read SLP,$_,footer_size;
|
||||
close SLP;
|
||||
return $_;
|
||||
}
|
||||
|
||||
=item scan
|
||||
|
||||
Implement the scan method to read a slp file.
|
||||
|
||||
=cut
|
||||
|
||||
sub scan {
|
||||
my $this=shift;
|
||||
$this->SUPER::scan(@_);
|
||||
my $file=$this->filename;
|
||||
|
||||
# Decode the footer.
|
||||
my @values=unpack(footer_packstring(),$this->getfooter);
|
||||
# Populate fields.
|
||||
foreach my $field (@{fieldlist()}) {
|
||||
$_=shift @values;
|
||||
$this->$field($_);
|
||||
}
|
||||
|
||||
# A simple sanity check.
|
||||
if (! defined $this->slpkgversion || $this->slpkgversion < footer_version()) {
|
||||
die "unsupported stampede package version";
|
||||
}
|
||||
|
||||
# Read in the file list.
|
||||
my @filelist;
|
||||
# FIXME: support gzip files too!
|
||||
foreach ($this->runpipe(0, "bzip2 -d < '$file' | tar -tf -")) {
|
||||
chomp;
|
||||
s:^\./:/:;
|
||||
$_="/$_" unless m:^/:;
|
||||
push @filelist, $_;
|
||||
}
|
||||
$this->filelist(\@filelist);
|
||||
|
||||
# TODO: read in postinst script.
|
||||
|
||||
$this->distribution('Stampede');
|
||||
$this->origformat('slp');
|
||||
$this->changelogtext('');
|
||||
$this->binary_info($this->runpipe(0, "ls -l '$file'"));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item unpack
|
||||
|
||||
Unpack a slp file. They can be compressed in various ways, depending on
|
||||
what is in the compresstype field.
|
||||
|
||||
=cut
|
||||
|
||||
sub unpack {
|
||||
my $this=shift;
|
||||
$this->SUPER::unpack(@_);
|
||||
my $file=$this->filename;
|
||||
my $compresstype=$this->compresstype;
|
||||
|
||||
if ($compresstype == 0) {
|
||||
$this->do("bzip2 -d < $file | (cd ".$this->unpacked_tree."; tar xpf -)")
|
||||
}
|
||||
elsif ($compresstype == 1) {
|
||||
$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)";
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item build
|
||||
|
||||
Build a slp.
|
||||
|
||||
=cut
|
||||
|
||||
sub build {
|
||||
my $this=shift;
|
||||
my $slp=$this->name."-".$this->version.".slp";
|
||||
|
||||
# Now generate the footer.
|
||||
# We cannot use the actual $slp::footer_packstring, becuase it uses
|
||||
# space terminated strings (A) instead of null terminated strings
|
||||
# (a). That is good for decoding, but not for encoding.
|
||||
my $fmt=footer_packstring();
|
||||
$fmt=~tr/A/a/;
|
||||
my $footer=pack($fmt,
|
||||
$this->conffiles,
|
||||
2, # Use priority optional for alien packages.
|
||||
0, # Always use bzip2 as the compression type.
|
||||
$this->release,
|
||||
254, # Don't try to guess copyright, just use unknown.
|
||||
'', # Conflicts.
|
||||
'', # Set up script. TODO
|
||||
$this->summary,
|
||||
$this->description,
|
||||
'', # $this->depends would go here, but slp uses some weird format
|
||||
'', # Provides.
|
||||
$this->maintainer,
|
||||
scalar localtime, # Use current date.
|
||||
252, # Unknown compiler.
|
||||
$this->version,
|
||||
$this->name,
|
||||
$this->arch,
|
||||
252, # Unknown group.
|
||||
footer_version(),
|
||||
);
|
||||
|
||||
# Generate .tar.bz2 file.
|
||||
# Note that it's important I use "./*" instead of just "." or
|
||||
# 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.
|
||||
$this->do("(cd ".$this->unpacked_tree."; tar cf - ./*) | bzip2 - > $slp")
|
||||
or die "package build failed: $!";
|
||||
|
||||
# Now append the footer.
|
||||
open (OUT,">>$slp") || die "$slp: $!";
|
||||
print OUT $footer;
|
||||
close OUT;
|
||||
|
||||
return $slp;
|
||||
}
|
||||
|
||||
=item conffiles
|
||||
|
||||
Set/get conffiles.
|
||||
|
||||
When the conffiles are set, the format used by slp (a colon-delimited list)
|
||||
is turned into the real list that is used internally. The list is changed
|
||||
back into slp's internal format when it is retreived.
|
||||
|
||||
=cut
|
||||
|
||||
sub conffiles {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
$this->{conffiles}=[split /:/, shift] if @_;
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
return join(':',@{$this->{conffiles}});
|
||||
}
|
||||
|
||||
=item copyright
|
||||
|
||||
Set/get copyright.
|
||||
|
||||
When the copyright is set, the number used by slp is changed into a textual
|
||||
description. This is changed back into a number when the value is
|
||||
retreived.
|
||||
|
||||
=cut
|
||||
|
||||
sub copyright {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
$this->{copyright}=(${copyrighttrans()}{shift} || 'unknown') if @_;
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
my %transcopyright=reverse %{copyrighttrans()};
|
||||
return $transcopyright{$this->{copyright}}
|
||||
if (exists $transcopyright{$this->{copyright}});
|
||||
return 254; # unknown
|
||||
}
|
||||
|
||||
=item arch
|
||||
|
||||
Set/get arch.
|
||||
|
||||
When the arch is set, the number used by slp is changed into a textual
|
||||
description. This is changed back into a number when the value is
|
||||
retreived.
|
||||
|
||||
=cut
|
||||
|
||||
sub arch {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
if (@_) {
|
||||
my $arch=shift;
|
||||
$this->{arch}=${archtrans()}{$arch};
|
||||
die "unknown architecture $arch" unless defined $this->{arch};
|
||||
}
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
my %transarch=reverse %{archtrans()};
|
||||
return $transarch{$this->{arch}}
|
||||
if (exists $transarch{$this->{arch}});
|
||||
die "Stampede does not support architecture ".$this->{arch}." packages";
|
||||
}
|
||||
|
||||
=item release
|
||||
|
||||
Set/get release version.
|
||||
|
||||
When the release version is retreived, it is converted to an unsigned
|
||||
integer, as is required by the slp package format.
|
||||
|
||||
=cut
|
||||
|
||||
sub release {
|
||||
my $this=shift;
|
||||
|
||||
# set
|
||||
$this->{release}=shift if @_;
|
||||
|
||||
# get
|
||||
return unless defined wantarray; # optimization
|
||||
return int($this->{release});
|
||||
}
|
||||
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Joey Hess <joey@kitenet.net>
|
||||
|
||||
=cut
|
||||
|
||||
1
|
||||
233
Alien/Package/Tgz.pm
Normal file
233
Alien/Package/Tgz.pm
Normal file
@@ -0,0 +1,233 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Alien::Package::Tgz - an object that represents a tgz package
|
||||
|
||||
=cut
|
||||
|
||||
package Alien::Package::Tgz;
|
||||
use strict;
|
||||
use base qw(Alien::Package);
|
||||
use Cwd qw(abs_path);
|
||||
|
||||
my $tarext=qr/\.(?:tgz|tar(?:\.(?:gz|Z|z|bz|bz2))?|taz)$/;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is an object class that represents a tgz package, as used in Slackware.
|
||||
It also allows conversion of raw tar files.
|
||||
It is derived from Alien::Package.
|
||||
|
||||
=head1 CLASS DATA
|
||||
|
||||
=over 4
|
||||
|
||||
=item scripttrans
|
||||
|
||||
Translation table between canoical script names and the names used in
|
||||
tgz's.
|
||||
|
||||
=cut
|
||||
|
||||
use constant scripttrans => {
|
||||
postinst => 'doinst.sh',
|
||||
postrm => 'delete.sh',
|
||||
prerm => 'predelete.sh',
|
||||
preinst => 'predoinst.sh',
|
||||
};
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item checkfile
|
||||
|
||||
Detect tgz files by their extention.
|
||||
|
||||
=cut
|
||||
|
||||
sub checkfile {
|
||||
my $this=shift;
|
||||
my $file=shift;
|
||||
|
||||
return $file =~ m/$tarext$/;
|
||||
}
|
||||
|
||||
=item install
|
||||
|
||||
Install a tgz with installpkg. Pass in the filename of the tgz to install.
|
||||
|
||||
installpkg (a slackware program) is used because I'm not sanguine about
|
||||
just untarring a tgz file. It might trash a system.
|
||||
|
||||
=cut
|
||||
|
||||
sub install {
|
||||
my $this=shift;
|
||||
my $tgz=shift;
|
||||
|
||||
if (-x "/sbin/installpkg") {
|
||||
my $v=$Alien::Package::verbose;
|
||||
$Alien::Package::verbose=2;
|
||||
$this->do("/sbin/installpkg", "$tgz")
|
||||
or die "Unable to install";
|
||||
$Alien::Package::verbose=$v;
|
||||
}
|
||||
else {
|
||||
die "Sorry, I cannot install the generated .tgz file because /sbin/installpkg is not present. You can use tar to install it yourself.\n"
|
||||
}
|
||||
}
|
||||
|
||||
=item scan
|
||||
|
||||
Scan a tgz file for fields. Has to scan the filename for most of the
|
||||
information, since there is little useful metadata in the file itself.
|
||||
|
||||
=cut
|
||||
|
||||
sub scan {
|
||||
my $this=shift;
|
||||
$this->SUPER::scan(@_);
|
||||
my $file=$this->filename;
|
||||
|
||||
# Get basename of the filename.
|
||||
my ($basename)=('/'.$file)=~m#^/?.*/(.*?)$#;
|
||||
|
||||
# Strip out any tar extentions.
|
||||
$basename=~s/$tarext//;
|
||||
|
||||
if ($basename=~m/([\w-]+)-([0-9\.?]+).*/) {
|
||||
$this->name($1);
|
||||
$this->version($2);
|
||||
}
|
||||
else {
|
||||
$this->name($basename);
|
||||
$this->version(1);
|
||||
}
|
||||
|
||||
$this->arch('all');
|
||||
|
||||
$this->summary("Converted tgz package");
|
||||
$this->description($this->summary);
|
||||
$this->copyright('unknown');
|
||||
$this->release(1);
|
||||
$this->distribution("Slackware/tarball");
|
||||
$this->group("unknown");
|
||||
$this->origformat('tgz');
|
||||
$this->changelogtext('');
|
||||
$this->binary_info($this->runpipe(0, "ls -l '$file'"));
|
||||
|
||||
# Now figure out the conffiles. Assume anything in etc/ is a
|
||||
# conffile.
|
||||
my @conffiles;
|
||||
open (FILELIST,"tar vtf $file | grep etc/ |") ||
|
||||
die "getting filelist: $!";
|
||||
while (<FILELIST>) {
|
||||
# Make sure it's a normal file. This is looking at the
|
||||
# permissions, and making sure the first character is '-'.
|
||||
# Ie: -rw-r--r--
|
||||
if (m:^-:) {
|
||||
# Strip it down to the filename.
|
||||
m/^(.*) (.*)$/;
|
||||
push @conffiles, "/$2";
|
||||
}
|
||||
}
|
||||
$this->conffiles(\@conffiles);
|
||||
|
||||
# Now get the whole filelist. We have to add leading /'s to the
|
||||
# filenames. We have to ignore all files under /install/
|
||||
my @filelist;
|
||||
open (FILELIST, "tar tf $file |") ||
|
||||
die "getting filelist: $!";
|
||||
while (<FILELIST>) {
|
||||
chomp;
|
||||
unless (m:^install/:) {
|
||||
push @filelist, "/$_";
|
||||
}
|
||||
}
|
||||
$this->filelist(\@filelist);
|
||||
|
||||
# Now get the scripts.
|
||||
foreach my $script (keys %{scripttrans()}) {
|
||||
$this->$script(scalar $this->runpipe(1, "tar Oxf '$file' install/${scripttrans()}{$script} 2>/dev/null"));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item unpack
|
||||
|
||||
Unpack tgz.
|
||||
|
||||
=cut
|
||||
|
||||
sub unpack {
|
||||
my $this=shift;
|
||||
$this->SUPER::unpack(@_);
|
||||
my $file=abs_path($this->filename);
|
||||
|
||||
$this->do("cd ".$this->unpacked_tree."; tar xpf $file")
|
||||
or die "Unpacking of '$file' failed: $!";
|
||||
# Delete the install directory that has slackware info in it.
|
||||
$this->do("cd ".$this->unpacked_tree."; rm -rf ./install");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=item prep
|
||||
|
||||
Adds a populated install directory to the build tree.
|
||||
|
||||
=cut
|
||||
|
||||
sub prep {
|
||||
my $this=shift;
|
||||
my $dir=$this->unpacked_tree || die "The package must be unpacked first!";
|
||||
|
||||
my $install_made=0;
|
||||
if ($this->usescripts) {
|
||||
foreach my $script (keys %{scripttrans()}) {
|
||||
my $data=$this->$script();
|
||||
my $out=$this->unpacked_tree."/install/".${scripttrans()}{$script};
|
||||
next if ! defined $data || $data =~ m/^\s*$/;
|
||||
if (!$install_made) {
|
||||
mkdir($this->unpacked_tree."/install", 0755)
|
||||
|| die "unable to mkdir ".$this->unpacked_tree."/install: $!";
|
||||
$install_made=1;
|
||||
}
|
||||
open (OUT, ">$out") || die "$out: $!";
|
||||
print OUT $data;
|
||||
close OUT;
|
||||
$this->do("chmod", 755, $out);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
=item build
|
||||
|
||||
Build a tgz.
|
||||
|
||||
=cut
|
||||
|
||||
sub build {
|
||||
my $this=shift;
|
||||
my $tgz=$this->name."-".$this->version.".tgz";
|
||||
|
||||
$this->do("cd ".$this->unpacked_tree."; tar czf ../$tgz .")
|
||||
or die "Package build failed";
|
||||
|
||||
return $tgz;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Joey Hess <joey@kitenet.net>
|
||||
|
||||
=cut
|
||||
|
||||
1
|
||||
339
GPL
Normal file
339
GPL
Normal file
@@ -0,0 +1,339 @@
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 2, June 1991
|
||||
|
||||
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
|
||||
675 Mass Ave, Cambridge, MA 02139, USA
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
The licenses for most software are designed to take away your
|
||||
freedom to share and change it. By contrast, the GNU General Public
|
||||
License is intended to guarantee your freedom to share and change free
|
||||
software--to make sure the software is free for all its users. This
|
||||
General Public License applies to most of the Free Software
|
||||
Foundation's software and to any other program whose authors commit to
|
||||
using it. (Some other Free Software Foundation software is covered by
|
||||
the GNU Library General Public License instead.) You can apply it to
|
||||
your programs, too.
|
||||
|
||||
When we speak of free software, we are referring to freedom, not
|
||||
price. Our General Public Licenses are designed to make sure that you
|
||||
have the freedom to distribute copies of free software (and charge for
|
||||
this service if you wish), that you receive source code or can get it
|
||||
if you want it, that you can change the software or use pieces of it
|
||||
in new free programs; and that you know you can do these things.
|
||||
|
||||
To protect your rights, we need to make restrictions that forbid
|
||||
anyone to deny you these rights or to ask you to surrender the rights.
|
||||
These restrictions translate to certain responsibilities for you if you
|
||||
distribute copies of the software, or if you modify it.
|
||||
|
||||
For example, if you distribute copies of such a program, whether
|
||||
gratis or for a fee, you must give the recipients all the rights that
|
||||
you have. You must make sure that they, too, receive or can get the
|
||||
source code. And you must show them these terms so they know their
|
||||
rights.
|
||||
|
||||
We protect your rights with two steps: (1) copyright the software, and
|
||||
(2) offer you this license which gives you legal permission to copy,
|
||||
distribute and/or modify the software.
|
||||
|
||||
Also, for each author's protection and ours, we want to make certain
|
||||
that everyone understands that there is no warranty for this free
|
||||
software. If the software is modified by someone else and passed on, we
|
||||
want its recipients to know that what they have is not the original, so
|
||||
that any problems introduced by others will not reflect on the original
|
||||
authors' reputations.
|
||||
|
||||
Finally, any free program is threatened constantly by software
|
||||
patents. We wish to avoid the danger that redistributors of a free
|
||||
program will individually obtain patent licenses, in effect making the
|
||||
program proprietary. To prevent this, we have made it clear that any
|
||||
patent must be licensed for everyone's free use or not licensed at all.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow.
|
||||
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||
|
||||
0. This License applies to any program or other work which contains
|
||||
a notice placed by the copyright holder saying it may be distributed
|
||||
under the terms of this General Public License. The "Program", below,
|
||||
refers to any such program or work, and a "work based on the Program"
|
||||
means either the Program or any derivative work under copyright law:
|
||||
that is to say, a work containing the Program or a portion of it,
|
||||
either verbatim or with modifications and/or translated into another
|
||||
language. (Hereinafter, translation is included without limitation in
|
||||
the term "modification".) Each licensee is addressed as "you".
|
||||
|
||||
Activities other than copying, distribution and modification are not
|
||||
covered by this License; they are outside its scope. The act of
|
||||
running the Program is not restricted, and the output from the Program
|
||||
is covered only if its contents constitute a work based on the
|
||||
Program (independent of having been made by running the Program).
|
||||
Whether that is true depends on what the Program does.
|
||||
|
||||
1. You may copy and distribute verbatim copies of the Program's
|
||||
source code as you receive it, in any medium, provided that you
|
||||
conspicuously and appropriately publish on each copy an appropriate
|
||||
copyright notice and disclaimer of warranty; keep intact all the
|
||||
notices that refer to this License and to the absence of any warranty;
|
||||
and give any other recipients of the Program a copy of this License
|
||||
along with the Program.
|
||||
|
||||
You may charge a fee for the physical act of transferring a copy, and
|
||||
you may at your option offer warranty protection in exchange for a fee.
|
||||
|
||||
2. You may modify your copy or copies of the Program or any portion
|
||||
of it, thus forming a work based on the Program, and copy and
|
||||
distribute such modifications or work under the terms of Section 1
|
||||
above, provided that you also meet all of these conditions:
|
||||
|
||||
a) You must cause the modified files to carry prominent notices
|
||||
stating that you changed the files and the date of any change.
|
||||
|
||||
b) You must cause any work that you distribute or publish, that in
|
||||
whole or in part contains or is derived from the Program or any
|
||||
part thereof, to be licensed as a whole at no charge to all third
|
||||
parties under the terms of this License.
|
||||
|
||||
c) If the modified program normally reads commands interactively
|
||||
when run, you must cause it, when started running for such
|
||||
interactive use in the most ordinary way, to print or display an
|
||||
announcement including an appropriate copyright notice and a
|
||||
notice that there is no warranty (or else, saying that you provide
|
||||
a warranty) and that users may redistribute the program under
|
||||
these conditions, and telling the user how to view a copy of this
|
||||
License. (Exception: if the Program itself is interactive but
|
||||
does not normally print such an announcement, your work based on
|
||||
the Program is not required to print an announcement.)
|
||||
|
||||
These requirements apply to the modified work as a whole. If
|
||||
identifiable sections of that work are not derived from the Program,
|
||||
and can be reasonably considered independent and separate works in
|
||||
themselves, then this License, and its terms, do not apply to those
|
||||
sections when you distribute them as separate works. But when you
|
||||
distribute the same sections as part of a whole which is a work based
|
||||
on the Program, the distribution of the whole must be on the terms of
|
||||
this License, whose permissions for other licensees extend to the
|
||||
entire whole, and thus to each and every part regardless of who wrote it.
|
||||
|
||||
Thus, it is not the intent of this section to claim rights or contest
|
||||
your rights to work written entirely by you; rather, the intent is to
|
||||
exercise the right to control the distribution of derivative or
|
||||
collective works based on the Program.
|
||||
|
||||
In addition, mere aggregation of another work not based on the Program
|
||||
with the Program (or with a work based on the Program) on a volume of
|
||||
a storage or distribution medium does not bring the other work under
|
||||
the scope of this License.
|
||||
|
||||
3. You may copy and distribute the Program (or a work based on it,
|
||||
under Section 2) in object code or executable form under the terms of
|
||||
Sections 1 and 2 above provided that you also do one of the following:
|
||||
|
||||
a) Accompany it with the complete corresponding machine-readable
|
||||
source code, which must be distributed under the terms of Sections
|
||||
1 and 2 above on a medium customarily used for software interchange; or,
|
||||
|
||||
b) Accompany it with a written offer, valid for at least three
|
||||
years, to give any third party, for a charge no more than your
|
||||
cost of physically performing source distribution, a complete
|
||||
machine-readable copy of the corresponding source code, to be
|
||||
distributed under the terms of Sections 1 and 2 above on a medium
|
||||
customarily used for software interchange; or,
|
||||
|
||||
c) Accompany it with the information you received as to the offer
|
||||
to distribute corresponding source code. (This alternative is
|
||||
allowed only for noncommercial distribution and only if you
|
||||
received the program in object code or executable form with such
|
||||
an offer, in accord with Subsection b above.)
|
||||
|
||||
The source code for a work means the preferred form of the work for
|
||||
making modifications to it. For an executable work, complete source
|
||||
code means all the source code for all modules it contains, plus any
|
||||
associated interface definition files, plus the scripts used to
|
||||
control compilation and installation of the executable. However, as a
|
||||
special exception, the source code distributed need not include
|
||||
anything that is normally distributed (in either source or binary
|
||||
form) with the major components (compiler, kernel, and so on) of the
|
||||
operating system on which the executable runs, unless that component
|
||||
itself accompanies the executable.
|
||||
|
||||
If distribution of executable or object code is made by offering
|
||||
access to copy from a designated place, then offering equivalent
|
||||
access to copy the source code from the same place counts as
|
||||
distribution of the source code, even though third parties are not
|
||||
compelled to copy the source along with the object code.
|
||||
|
||||
4. You may not copy, modify, sublicense, or distribute the Program
|
||||
except as expressly provided under this License. Any attempt
|
||||
otherwise to copy, modify, sublicense or distribute the Program is
|
||||
void, and will automatically terminate your rights under this License.
|
||||
However, parties who have received copies, or rights, from you under
|
||||
this License will not have their licenses terminated so long as such
|
||||
parties remain in full compliance.
|
||||
|
||||
5. You are not required to accept this License, since you have not
|
||||
signed it. However, nothing else grants you permission to modify or
|
||||
distribute the Program or its derivative works. These actions are
|
||||
prohibited by law if you do not accept this License. Therefore, by
|
||||
modifying or distributing the Program (or any work based on the
|
||||
Program), you indicate your acceptance of this License to do so, and
|
||||
all its terms and conditions for copying, distributing or modifying
|
||||
the Program or works based on it.
|
||||
|
||||
6. Each time you redistribute the Program (or any work based on the
|
||||
Program), the recipient automatically receives a license from the
|
||||
original licensor to copy, distribute or modify the Program subject to
|
||||
these terms and conditions. You may not impose any further
|
||||
restrictions on the recipients' exercise of the rights granted herein.
|
||||
You are not responsible for enforcing compliance by third parties to
|
||||
this License.
|
||||
|
||||
7. If, as a consequence of a court judgment or allegation of patent
|
||||
infringement or for any other reason (not limited to patent issues),
|
||||
conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot
|
||||
distribute so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you
|
||||
may not distribute the Program at all. For example, if a patent
|
||||
license would not permit royalty-free redistribution of the Program by
|
||||
all those who receive copies directly or indirectly through you, then
|
||||
the only way you could satisfy both it and this License would be to
|
||||
refrain entirely from distribution of the Program.
|
||||
|
||||
If any portion of this section is held invalid or unenforceable under
|
||||
any particular circumstance, the balance of the section is intended to
|
||||
apply and the section as a whole is intended to apply in other
|
||||
circumstances.
|
||||
|
||||
It is not the purpose of this section to induce you to infringe any
|
||||
patents or other property right claims or to contest validity of any
|
||||
such claims; this section has the sole purpose of protecting the
|
||||
integrity of the free software distribution system, which is
|
||||
implemented by public license practices. Many people have made
|
||||
generous contributions to the wide range of software distributed
|
||||
through that system in reliance on consistent application of that
|
||||
system; it is up to the author/donor to decide if he or she is willing
|
||||
to distribute software through any other system and a licensee cannot
|
||||
impose that choice.
|
||||
|
||||
This section is intended to make thoroughly clear what is believed to
|
||||
be a consequence of the rest of this License.
|
||||
|
||||
8. If the distribution and/or use of the Program is restricted in
|
||||
certain countries either by patents or by copyrighted interfaces, the
|
||||
original copyright holder who places the Program under this License
|
||||
may add an explicit geographical distribution limitation excluding
|
||||
those countries, so that distribution is permitted only in or among
|
||||
countries not thus excluded. In such case, this License incorporates
|
||||
the limitation as if written in the body of this License.
|
||||
|
||||
9. The Free Software Foundation may publish revised and/or new versions
|
||||
of the General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the Program
|
||||
specifies a version number of this License which applies to it and "any
|
||||
later version", you have the option of following the terms and conditions
|
||||
either of that version or of any later version published by the Free
|
||||
Software Foundation. If the Program does not specify a version number of
|
||||
this License, you may choose any version ever published by the Free Software
|
||||
Foundation.
|
||||
|
||||
10. If you wish to incorporate parts of the Program into other free
|
||||
programs whose distribution conditions are different, write to the author
|
||||
to ask for permission. For software which is copyrighted by the Free
|
||||
Software Foundation, write to the Free Software Foundation; we sometimes
|
||||
make exceptions for this. Our decision will be guided by the two goals
|
||||
of preserving the free status of all derivatives of our free software and
|
||||
of promoting the sharing and reuse of software generally.
|
||||
|
||||
NO WARRANTY
|
||||
|
||||
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
||||
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
||||
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
||||
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
||||
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
||||
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
||||
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
||||
REPAIR OR CORRECTION.
|
||||
|
||||
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
||||
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
||||
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
||||
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
||||
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
||||
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGES.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
How to Apply These Terms to Your New Programs
|
||||
|
||||
If you develop a new program, and you want it to be of the greatest
|
||||
possible use to the public, the best way to achieve this is to make it
|
||||
free software which everyone can redistribute and change under these terms.
|
||||
|
||||
To do so, attach the following notices to the program. It is safest
|
||||
to attach them to the start of each source file to most effectively
|
||||
convey the exclusion of warranty; and each file should have at least
|
||||
the "copyright" line and a pointer to where the full notice is found.
|
||||
|
||||
<one line to give the program's name and a brief idea of what it does.>
|
||||
Copyright (C) 19yy <name of author>
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
If the program is interactive, make it output a short notice like this
|
||||
when it starts in an interactive mode:
|
||||
|
||||
Gnomovision version 69, Copyright (C) 19yy name of author
|
||||
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||
This is free software, and you are welcome to redistribute it
|
||||
under certain conditions; type `show c' for details.
|
||||
|
||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
||||
parts of the General Public License. Of course, the commands you use may
|
||||
be called something other than `show w' and `show c'; they could even be
|
||||
mouse-clicks or menu items--whatever suits your program.
|
||||
|
||||
You should also get your employer (if you work as a programmer) or your
|
||||
school, if any, to sign a "copyright disclaimer" for the program, if
|
||||
necessary. Here is a sample; alter the names:
|
||||
|
||||
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
|
||||
`Gnomovision' (which makes passes at compilers) written by James Hacker.
|
||||
|
||||
<signature of Ty Coon>, 1 April 1989
|
||||
Ty Coon, President of Vice
|
||||
|
||||
This General Public License does not permit incorporating your program into
|
||||
proprietary programs. If your program is a subroutine library, you may
|
||||
consider it more useful to permit linking proprietary applications with the
|
||||
library. If this is what you want to do, use the GNU Library General
|
||||
Public License instead of this License.
|
||||
8
INSTALL
Normal file
8
INSTALL
Normal file
@@ -0,0 +1,8 @@
|
||||
To try alien before installing, just run ./alien.pl from this directory. Most
|
||||
features will work prior to installation.
|
||||
|
||||
To install alien, become root and type:
|
||||
perl Makefile.PL; make; make install
|
||||
|
||||
To use alien, you'll need a variety of other software. See the README for
|
||||
details.
|
||||
42
Makefile.PL
Executable file
42
Makefile.PL
Executable file
@@ -0,0 +1,42 @@
|
||||
#!/usr/bin/perl -w
|
||||
use ExtUtils::MakeMaker;
|
||||
use strict;
|
||||
|
||||
# Just to make it ignore editor backup files.
|
||||
sub MY::libscan {
|
||||
$_ = $_[1];
|
||||
|
||||
return '' if $_ eq 'alien.pl';
|
||||
return '' if m/\/(RCS|CVS|SCCS)\// || m/[~%]$/ || m/\.(orig|rej)$/;
|
||||
return $_;
|
||||
}
|
||||
|
||||
# Add a few more targets.
|
||||
sub MY::postamble {
|
||||
return q{
|
||||
|
||||
VER=$(shell perl -e '$$_=<>;print m/\((.*?)\)/'<debian/changelog)
|
||||
|
||||
all:: extra_build
|
||||
clean:: extra_build
|
||||
install:: extra_install
|
||||
pure_install:: extra_install
|
||||
|
||||
extra_build:
|
||||
perl -i -pe "s/\@version\@/$(VER)/g" <alien.lsm.in >alien.lsm
|
||||
perl -i -pe "s/\@version\@/$(VER)/g" <alien.spec.in >alien.spec
|
||||
|
||||
extra_install:
|
||||
install -d $(PREFIX)/share/alien/patches \
|
||||
$(VARPREFIX)/var/lib/alien
|
||||
|
||||
alien:
|
||||
perl -pe '$$_="" if /use lib/; $$_="our \$$Version=\"$(VER)\";\n" if /VERSION_AUTOREPLACE/' alien.pl > alien
|
||||
}
|
||||
}
|
||||
|
||||
WriteMakefile(
|
||||
'NAME' => 'Alien',
|
||||
'EXE_FILES' => ['alien'],
|
||||
'clean' => {FILES => 'alien'},
|
||||
);
|
||||
65
README
Normal file
65
README
Normal file
@@ -0,0 +1,65 @@
|
||||
Please read alien's man page for general documentation.
|
||||
|
||||
Getting alien:
|
||||
|
||||
The newest versions of alien are available at the alien home page; drop by
|
||||
http://kitenet.net/~joey/code/alien/
|
||||
|
||||
Other things you'll need:
|
||||
|
||||
To use alien, you will need several other programs. Alien is a perl
|
||||
program, and requires perl version 5.004 or greater. If you use slackware,
|
||||
make sure you get perl 5.004, the perl 5.003 in slackware does not work
|
||||
with alien!
|
||||
|
||||
To convert packages to or from rpms, you need the Red Hat Package Manager;
|
||||
get it from Red Hat's ftp site. If your distribution (eg, Red Hat)
|
||||
provides a rpm-build package, you will need it as well to generate rpms.
|
||||
|
||||
If you want to convert packages into debian packages, you will need the
|
||||
dpkg, dpkg-dev, and debhelper (version 3 or above) packages, which are
|
||||
available on http://packages.debian.org
|
||||
|
||||
To convert to/from stampede packages, you will need bzip2.
|
||||
|
||||
Attention, Slackware, Red Hat, and Stampede users: Bruce S. Babcock
|
||||
<babcock@math.psu.edu> has put together an "alien-extra"
|
||||
package of all the extra files you need to use alien on
|
||||
a Red Hat or Slackware system. (Debian systems automatically have all
|
||||
required files.)
|
||||
|
||||
The Slackware version is at
|
||||
ftp://ykbsb2.yk.psu.edu/pub/alien/alien-extra.tgz
|
||||
The RedHat version is at
|
||||
ftp://ykbsb2.yk.psu.edu/pub/alien/alien-extra.rpm
|
||||
The Stampede version is at
|
||||
ftp://ykbsb2.yk.psu.edu/pub/alien/alien-extra.slp
|
||||
|
||||
Note:
|
||||
|
||||
Alien is really designed to be used to convert from alien file formats to
|
||||
the packaging format used by the distribution you run it on. Of course,
|
||||
it can also convert from your distribution's native format to alien
|
||||
formats, or from one alien format to another. Do be warned though, that
|
||||
if these latter types of conversions are done, the generated packages may
|
||||
have incorrect dependancy information. This is known to be true if you
|
||||
convert a rpm into a deb on a Red Hat system, for example. Even with
|
||||
alien-extra installed, dpkg will be unable to properly calculate library
|
||||
dependancies for the deb it is creating, and you will get a package
|
||||
without any library dependancies.
|
||||
|
||||
Programs that use alien:
|
||||
|
||||
I know of one program that acts as a frontend to alien - kpackviewer is a
|
||||
package viewer that can convert between package formats by using alien. Its
|
||||
homepage is at http://www.momentus.com.br/users/hook/kpackviewer.html
|
||||
|
||||
Corel also appears to have (or had) something in Corel linux that
|
||||
uses 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.
|
||||
8
TODO
Normal file
8
TODO
Normal file
@@ -0,0 +1,8 @@
|
||||
* handling postinst script when converting to/from .slp packages.
|
||||
* alien needs to handle relocatable conffiles, partially relocatable
|
||||
packages, and packages that have maultiple parts that relocate
|
||||
differently.
|
||||
* rpm ghost file support. On conversion, make preinst move file out of the
|
||||
way, postinst put it back. Thus emulating the behavior of rpm.
|
||||
* seems slackware packages may now incliude an install/slack-desc
|
||||
with a description in it
|
||||
14
alien.lsm
Normal file
14
alien.lsm
Normal file
@@ -0,0 +1,14 @@
|
||||
Begin3
|
||||
Title: alien
|
||||
Version: 8.87
|
||||
Entered-date: 31MAR97
|
||||
Description: Alien converts Slackware .tgz packages, Red Hat .rpm packages,
|
||||
Debian .deb packages, and Stampede .slp packages. It can
|
||||
convert from any of the formats to any other format. It works
|
||||
only on binary packages. It also support LSB 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
|
||||
80 alien-8.87.tar.gz
|
||||
Copying-policy: GPL
|
||||
End
|
||||
14
alien.lsm.in
Normal file
14
alien.lsm.in
Normal file
@@ -0,0 +1,14 @@
|
||||
Begin3
|
||||
Title: alien
|
||||
Version: @version@
|
||||
Entered-date: 31MAR97
|
||||
Description: Alien converts Slackware .tgz packages, Red Hat .rpm packages,
|
||||
Debian .deb packages, and Stampede .slp packages. It can
|
||||
convert from any of the formats to any other format. It works
|
||||
only on binary packages. It also support LSB 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
|
||||
80 alien-@version@.tar.gz
|
||||
Copying-policy: GPL
|
||||
End
|
||||
540
alien.pl
Executable file
540
alien.pl
Executable file
@@ -0,0 +1,540 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
alien - Convert or install an alien binary package
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
alien [--to-deb] [--to-rpm] [--to-tgz] [--to-slp] [options] file [...]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
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 B<alien> to convert it to your preferred
|
||||
package format and install it. It also supports LSB packages.
|
||||
|
||||
=head1 WARNING
|
||||
|
||||
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
|
||||
cannot be used interchangeably. In general, if you can't remove a
|
||||
package without breaking your system, don't try to replace it with an
|
||||
alien version.
|
||||
|
||||
=head1 PACKAGE FORMAT NOTES
|
||||
|
||||
=over 4
|
||||
|
||||
=item rpm
|
||||
|
||||
For converting to and from rpm format the Red Hat Package Manager must be
|
||||
installed.
|
||||
|
||||
=item lsb
|
||||
|
||||
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
|
||||
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 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.
|
||||
|
||||
Note that unlike other package formats, converting an LSB package to
|
||||
another format will not cause its minor version number to be changed.
|
||||
|
||||
=item deb
|
||||
|
||||
For converting to (but not from) deb format, the gcc, make, debhelper,
|
||||
dpkg-dev, and dpkg packages must be installed.
|
||||
|
||||
=item tgz
|
||||
|
||||
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 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!
|
||||
|
||||
When using B<alien> to convert a tgz package, all files in /etc in are assumed
|
||||
to be configuration files.
|
||||
|
||||
=item pkg
|
||||
|
||||
To manipulate packages in the Solaris pkg format (which is really the SV
|
||||
datastream package format), you will need the Solaris pkginfo and pkgtrans
|
||||
tools.
|
||||
|
||||
=back
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
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.
|
||||
|
||||
=over 4
|
||||
|
||||
=item file [...]
|
||||
|
||||
The list of package files to convert.
|
||||
|
||||
=item B<-d>, B<--to-deb>
|
||||
|
||||
Make debian packages. This is the default.
|
||||
|
||||
=item B<-r>, B<--to-rpm>
|
||||
|
||||
Make rpm packages.
|
||||
|
||||
=item B<-t>, B<--to-tgz>
|
||||
|
||||
Make tgz packages.
|
||||
|
||||
=item B<--to-slp>
|
||||
|
||||
Make slp packages.
|
||||
|
||||
=item B<-p>, B<--to-pkg>
|
||||
|
||||
Make Solaris pkg packages.
|
||||
|
||||
=item B<-i>, B<--install>
|
||||
|
||||
Automatically install each generated package, and remove the package file
|
||||
after it has been installed.
|
||||
|
||||
=item B<-g>, B<--generate>
|
||||
|
||||
Generate a temporary directory suitable for building a package from, but do
|
||||
not actually create the package. This is useful if you want to move files
|
||||
around in the package before building it. The package can be built from
|
||||
this temporary directory by running "debian/rules binary", if you were creating
|
||||
a Debian package, or by running "rpmbuild -bb <packagename>.spec" if you were
|
||||
creating a Red Hat package.
|
||||
|
||||
=item B<-s>, B<--single>
|
||||
|
||||
Like B<-g>, but do not generate the packagename.orig directory. This is only
|
||||
useful when you are very low on disk space and are generating a debian
|
||||
package.
|
||||
|
||||
=item B<-c>, B<--scripts>
|
||||
|
||||
Try to convert the scripts that are meant to be run when the
|
||||
package is installed and removed. Use this with caution, because these
|
||||
scripts might be designed to work on a system unlike your own, and could
|
||||
cause problems. It is recommended that you examine the scripts by hand
|
||||
and check to see what they do before using this option.
|
||||
|
||||
This is enabled by default when converting from lsb packages.
|
||||
|
||||
=item B<--patch=>I<patch>
|
||||
|
||||
Specify the patch to be used instead of automatically looking the patch up
|
||||
in B</var/lib/alien>. This has no effect unless a debian package is being
|
||||
built.
|
||||
|
||||
=item B<--anypatch>
|
||||
|
||||
Be less strict about which patch file is used, perhaps attempting to use a patch
|
||||
file for an older verson of the package. This is not guaranteed to always work;
|
||||
older patches may not necessarily work with newer packages.
|
||||
|
||||
=item B<--nopatch>
|
||||
|
||||
Do not use any patch files.
|
||||
|
||||
=item B<--description=>I<desc>
|
||||
|
||||
Specifiy a description for the package. This only has an effect when
|
||||
converting from the tgz package format, which lacks descriptions.
|
||||
|
||||
=item B<--version=>I<version>
|
||||
|
||||
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 B<alien> instead.
|
||||
|
||||
=item B<-T>, B<--test>
|
||||
|
||||
Test the generated packages. Currently this is only supported for debian
|
||||
packages, which, if lintian is installed, will be tested with lintian and
|
||||
lintian's output displayed.
|
||||
|
||||
=item B<-k>, B<--keep-version>
|
||||
|
||||
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<--bump=>I<number>
|
||||
|
||||
Instead of incrementing the version number of the converted package by 1,
|
||||
increment it by the given number.
|
||||
|
||||
=item B<--fixperms>
|
||||
|
||||
Sanitize all file owners and permissions when building a deb. This may be
|
||||
useful if the original package is a mess. On the other hand, it may break
|
||||
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 B<alien>:
|
||||
|
||||
=over 4
|
||||
|
||||
=item alien --to-deb package.rpm
|
||||
|
||||
Convert the package.rpm into a package.deb
|
||||
|
||||
=item alien --to-rpm package.deb
|
||||
|
||||
Convert the package.deb into a package.rpm
|
||||
|
||||
=item alien -i package.rpm
|
||||
|
||||
Convert the package.rpm into a package.deb (converting to a .deb package is
|
||||
default, so you need not specify --to-deb), and install the generated
|
||||
package.
|
||||
|
||||
=item alien --to-deb --to-rpm --to-tgz --to-slp foo.deb bar.rpm baz.tgz
|
||||
|
||||
Creates 9 new packages. When it is done, foo bar and baz are available in
|
||||
all 4 package formats.
|
||||
|
||||
=back
|
||||
|
||||
=head1 ENVIRONMENT
|
||||
|
||||
B<alien> recognizes the following environment variables:
|
||||
|
||||
=over 4
|
||||
|
||||
=item RPMBUILDOPTS
|
||||
|
||||
Options to pass to rpm when it is building a package.
|
||||
|
||||
=item RPMINSTALLOPT
|
||||
|
||||
Options to pass to rpm when it is installing a package.
|
||||
|
||||
=item EMAIL
|
||||
|
||||
If set, B<alien> assumes this is your email address. Email addresses are
|
||||
included in generated debian packages.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
B<alien> was written by Christoph Lameter, B<<clameter@debian.org>>.
|
||||
|
||||
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>>.
|
||||
|
||||
alien has been extensively rewritten (3 times) and is now maintained by
|
||||
Joey Hess, B<<joeyh@debian.org>>.
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
alien may be copied and modified under the terms of the GNU General Public
|
||||
License.
|
||||
|
||||
=cut
|
||||
|
||||
package Alien;
|
||||
our $Version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
|
||||
|
||||
use strict;
|
||||
use lib '.'; # For debugging, removed by Makefile.
|
||||
use Getopt::Long;
|
||||
use Alien::Package::Deb;
|
||||
use Alien::Package::Rpm;
|
||||
use Alien::Package::Tgz;
|
||||
use Alien::Package::Slp;
|
||||
use Alien::Package::Pkg;
|
||||
use Alien::Package::Lsb;
|
||||
|
||||
# Display alien's version number.
|
||||
sub version {
|
||||
print "alien version $Alien::Version\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
# Returns a list of directories to search for patches.
|
||||
sub patchdirs {
|
||||
return '/var/lib/alien',"/usr/share/alien/patches";
|
||||
}
|
||||
|
||||
# Display usage help.
|
||||
sub usage {
|
||||
print STDERR <<EOF;
|
||||
Usage: alien [options] file [...]
|
||||
file [...] Package file or files to convert.
|
||||
-d, --to-deb Generate a Debian deb package (default).
|
||||
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.
|
||||
--anypatch Use even old version os patches.
|
||||
-s, --single Like --generate, but do not create .orig
|
||||
directory.
|
||||
--fixperms Munge/fix permissions and owners.
|
||||
--test Test generated packages with lintian.
|
||||
-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 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 Generate build tree, but do not build 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.
|
||||
--bump=number Increment package version by this number.
|
||||
-h, --help Display this help message.
|
||||
-V, --version Display alien's version number.
|
||||
|
||||
EOF
|
||||
exit 1;
|
||||
}
|
||||
|
||||
# Start by processing the parameters.
|
||||
my (%destformats, $generate, $install, $single, $scripts, $patchfile,
|
||||
$nopatch, $tgzdescription, $tgzversion, $keepversion, $fixperms,
|
||||
$test, $anypatch);
|
||||
my $versionbump=1;
|
||||
|
||||
# Bundling is nice anyway, and it is required or Getopt::Long will confuse
|
||||
# -T and -t.
|
||||
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,
|
||||
"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,
|
||||
"bump=s" => \$versionbump,
|
||||
"fixperms" => \$fixperms,
|
||||
"help|h" => \&usage,
|
||||
) || usage();
|
||||
|
||||
# Default to deb conversion.
|
||||
if (! %destformats) {
|
||||
$destformats{deb}=1;
|
||||
}
|
||||
|
||||
# A few sanity checks.
|
||||
if (($generate || $single) && $install) {
|
||||
die "You can not use --generate or --single with --install.\n";
|
||||
}
|
||||
if (($generate || $single) && keys %destformats > 1) {
|
||||
die "--generate and --single may only be used when converting to a single format.\n";
|
||||
}
|
||||
if ($patchfile && ! -f $patchfile) {
|
||||
die "Specified patch file, \"$patchfile\" cannot be found.\n";
|
||||
}
|
||||
if ($patchfile && $nopatch) {
|
||||
die "The options --nopatch and --patchfile cannot be used together.\n";
|
||||
}
|
||||
unless (@ARGV) {
|
||||
print STDERR "You must specify a file to convert.\n\n";
|
||||
usage();
|
||||
}
|
||||
|
||||
# Check alien's working anvironment.
|
||||
if (! -w '.') {
|
||||
die("Cannot write to current directory. Try moving to /tmp and re-running alien.\n");
|
||||
}
|
||||
if ($> != 0) {
|
||||
if ($destformats{deb} && ! $generate && ! $single) {
|
||||
die "Must run as root to convert to deb format (or you may use fakeroot).\n";
|
||||
}
|
||||
print STDERR "Warning: alien is not running as root!\n";
|
||||
print STDERR "Warning: Ownerships of files in the generated packages will probably be wrong.\n";
|
||||
}
|
||||
|
||||
foreach my $file (@ARGV) {
|
||||
if (! -e $file) {
|
||||
die "File \"$file\" not found.\n";
|
||||
}
|
||||
|
||||
# Figure out what kind of file this is.
|
||||
my $package;
|
||||
|
||||
# Check lsb before rpm, since lsb packages are really just
|
||||
# glorified rpms.
|
||||
if (Alien::Package::Lsb->checkfile($file)) {
|
||||
$package=Alien::Package::Lsb->new(filename => $file);
|
||||
}
|
||||
elsif (Alien::Package::Rpm->checkfile($file)) {
|
||||
$package=Alien::Package::Rpm->new(filename => $file);
|
||||
}
|
||||
elsif (Alien::Package::Deb->checkfile($file)) {
|
||||
$package=Alien::Package::Deb->new(filename => $file);
|
||||
}
|
||||
elsif (Alien::Package::Tgz->checkfile($file)) {
|
||||
$package=Alien::Package::Tgz->new(filename => $file);
|
||||
$package->description($tgzdescription) if defined $tgzdescription;
|
||||
$package->version($tgzversion) if defined $tgzversion;
|
||||
}
|
||||
elsif (Alien::Package::Slp->checkfile($file)) {
|
||||
$package=Alien::Package::Slp->new(filename => $file);
|
||||
}
|
||||
elsif (Alien::Package::Pkg->checkfile($file)) {
|
||||
$package=Alien::Package::Pkg->new(filename => $file);
|
||||
}
|
||||
else {
|
||||
die "Unknown type of package, $file.\n";
|
||||
}
|
||||
|
||||
if (! $package->usescripts && $package->scripts) {
|
||||
$package->usescripts($scripts);
|
||||
if (! $scripts) {
|
||||
print STDERR "Warning: Skipping conversion of scripts in package ".$package->name.": ".join(" ", $package->scripts)."\n";
|
||||
print STDERR "Warning: Use the --scripts parameter to include the scripts.\n";
|
||||
}
|
||||
}
|
||||
|
||||
# Increment release.
|
||||
unless (defined $keepversion) {
|
||||
$package->incrementrelease($versionbump);
|
||||
}
|
||||
|
||||
foreach my $format (keys %destformats) {
|
||||
# Skip conversion if package is already the correct format.
|
||||
# Howver, generate build tree even if the format is
|
||||
# unchanged.
|
||||
if ($package->origformat ne $format || $generate) {
|
||||
# Only unpack once.
|
||||
if ($package->unpacked_tree) {
|
||||
$package->cleantree;
|
||||
}
|
||||
else {
|
||||
$package->unpack;
|
||||
}
|
||||
|
||||
# Mutate package into desired format.
|
||||
bless($package, "Alien::Package::".ucfirst($format));
|
||||
|
||||
# Make .orig.tar.gz directory?
|
||||
if ($format eq 'deb' && ! $single && $generate) {
|
||||
# Make .orig.tar.gz directory.
|
||||
Alien::Package->do("cp", "-fa", "--", $package->unpacked_tree, $package->unpacked_tree.".orig")
|
||||
or die "cp -fa failed";
|
||||
}
|
||||
|
||||
# See if a patch file should be used.
|
||||
if ($format eq 'deb' && ! $nopatch) {
|
||||
if (defined $patchfile) {
|
||||
$package->patchfile($patchfile)
|
||||
}
|
||||
else {
|
||||
$package->patchfile($package->getpatch($anypatch, patchdirs()));
|
||||
}
|
||||
}
|
||||
|
||||
$package->fixperms($fixperms);
|
||||
|
||||
$package->prep;
|
||||
|
||||
# If generating build tree only, stop here
|
||||
# with message.
|
||||
if ($generate) {
|
||||
if ($format eq 'deb' && ! $single) {
|
||||
print "Directories ".$package->unpacked_tree." and ".$package->unpacked_tree.".orig prepared.\n"
|
||||
}
|
||||
else {
|
||||
print "Directory ".$package->unpacked_tree." prepared.\n";
|
||||
}
|
||||
# Make sure $package does not wipe out the
|
||||
# directory when it is destroyed.
|
||||
$package->unpacked_tree('');
|
||||
next;
|
||||
}
|
||||
|
||||
my $newfile=$package->build;
|
||||
if ($test) {
|
||||
my @results = $package->test($newfile);
|
||||
if (@results) {
|
||||
print "Test results:\n";
|
||||
print "\t$_\n" foreach @results;
|
||||
}
|
||||
}
|
||||
if ($install) {
|
||||
$package->install($newfile);
|
||||
unlink $newfile;
|
||||
}
|
||||
else {
|
||||
# Tell them where the package ended up.
|
||||
print "$newfile generated\n";
|
||||
}
|
||||
}
|
||||
elsif ($install) {
|
||||
# Don't convert the package, but do install it.
|
||||
$package->install($file);
|
||||
# Note I don't unlink it. I figure that might annoy
|
||||
# people, since it was an input file.
|
||||
}
|
||||
|
||||
$package->revert;
|
||||
}
|
||||
}
|
||||
34
alien.spec
Normal file
34
alien.spec
Normal file
@@ -0,0 +1,34 @@
|
||||
Summary: Install Debian, Slackware, and Stampede packages with rpm.
|
||||
Name: alien
|
||||
Packager: Joey Hess <joey@kitenet.net>
|
||||
Version: 8.87
|
||||
Release: 1
|
||||
Source: ftp://kitenet.net/pub/code/debian/alien_8.87.tar.gz
|
||||
License: GPL
|
||||
Group: Utilities/File
|
||||
Buildroot: /tmp/alien-8.87.build
|
||||
Requires: perl
|
||||
BuildArchitectures: noarch
|
||||
|
||||
%description
|
||||
Alien allows you to convert Debian, Slackware, and Stampede Packages into Red
|
||||
Hat packages, which can be installed with rpm.
|
||||
|
||||
It can also generate Slackware, Debian and Stampede packages.
|
||||
|
||||
This is a tool only suitable for binary packages.
|
||||
|
||||
%prep
|
||||
%setup -n alien
|
||||
rm -rf /tmp/alien-8.87.build
|
||||
|
||||
%install
|
||||
perl Makefile.PL PREFIX=$RPM_BUILD_ROOT/usr
|
||||
make
|
||||
make pure_install VARPREFIX=$RPM_BUILD_ROOT
|
||||
find $RPM_BUILD_ROOT -not -type d -printf "/%%P\n" | \
|
||||
sed '/\/man\//s/$/\*/' > manifest
|
||||
|
||||
%files -f manifest
|
||||
%defattr(-,root,root)
|
||||
%doc debian/changelog GPL README alien.lsm
|
||||
34
alien.spec.in
Normal file
34
alien.spec.in
Normal file
@@ -0,0 +1,34 @@
|
||||
Summary: Install Debian, Slackware, and Stampede packages with rpm.
|
||||
Name: alien
|
||||
Packager: Joey Hess <joey@kitenet.net>
|
||||
Version: @version@
|
||||
Release: 1
|
||||
Source: ftp://kitenet.net/pub/code/debian/alien_@version@.tar.gz
|
||||
License: GPL
|
||||
Group: Utilities/File
|
||||
Buildroot: /tmp/alien-@version@.build
|
||||
Requires: perl
|
||||
BuildArchitectures: noarch
|
||||
|
||||
%description
|
||||
Alien allows you to convert Debian, Slackware, and Stampede Packages into Red
|
||||
Hat packages, which can be installed with rpm.
|
||||
|
||||
It can also generate Slackware, Debian and Stampede packages.
|
||||
|
||||
This is a tool only suitable for binary packages.
|
||||
|
||||
%prep
|
||||
%setup -n alien
|
||||
rm -rf /tmp/alien-@version@.build
|
||||
|
||||
%install
|
||||
perl Makefile.PL PREFIX=$RPM_BUILD_ROOT/usr
|
||||
make
|
||||
make pure_install VARPREFIX=$RPM_BUILD_ROOT
|
||||
find $RPM_BUILD_ROOT -not -type d -printf "/%%P\n" | \
|
||||
sed '/\/man\//s/$/\*/' > manifest
|
||||
|
||||
%files -f manifest
|
||||
%defattr(-,root,root)
|
||||
%doc debian/changelog GPL README alien.lsm
|
||||
2657
debian/changelog
vendored
Normal file
2657
debian/changelog
vendored
Normal file
File diff suppressed because it is too large
Load Diff
1
debian/compat
vendored
Normal file
1
debian/compat
vendored
Normal file
@@ -0,0 +1 @@
|
||||
7
|
||||
21
debian/control
vendored
Normal file
21
debian/control
vendored
Normal file
@@ -0,0 +1,21 @@
|
||||
Source: alien
|
||||
Section: admin
|
||||
Priority: optional
|
||||
Build-Depends: debhelper (>= 7.0.50)
|
||||
Maintainer: Joey Hess <joeyh@debian.org>
|
||||
Standards-Version: 3.9.3
|
||||
Vcs-Git: git://git.kitenet.net/alien
|
||||
Homepage: http://kitenet.net/~joey/code/alien/
|
||||
|
||||
Package: alien
|
||||
Architecture: all
|
||||
Section: admin
|
||||
Depends: debhelper (>= 7), ${misc:Depends}, ${perl:Depends}, rpm (>= 2.4.4-2), dpkg-dev, make, cpio, rpm2cpio
|
||||
Suggests: patch, bzip2, lsb-rpm, lintian, lzma
|
||||
Description: convert and install rpm and other packages
|
||||
Alien allows you to convert LSB, Red Hat, Stampede and Slackware Packages
|
||||
into Debian packages, which can be installed with dpkg.
|
||||
.
|
||||
It can also generate packages of any of the other formats.
|
||||
.
|
||||
This is a tool only suitable for binary packages.
|
||||
13
debian/copyright
vendored
Normal file
13
debian/copyright
vendored
Normal file
@@ -0,0 +1,13 @@
|
||||
Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
|
||||
Source: native package
|
||||
|
||||
Files: *
|
||||
Copyright:
|
||||
1996, 1997 Christoph Lameter
|
||||
1997 Randolph Chung
|
||||
2001 Mark A. Hershberger
|
||||
1997-2011 Joey Hess
|
||||
License: GPL-2+
|
||||
On Debian systems, the complete text of the GPL can be found in
|
||||
/usr/share/common-licenses/GPL.
|
||||
|
||||
2
debian/docs
vendored
Normal file
2
debian/docs
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
README
|
||||
gendiff.txt
|
||||
20
debian/rules
vendored
Executable file
20
debian/rules
vendored
Executable file
@@ -0,0 +1,20 @@
|
||||
#!/usr/bin/make -f
|
||||
%:
|
||||
dh $@
|
||||
|
||||
override_dh_auto_test:
|
||||
# simple smoke test
|
||||
./alien.pl -V
|
||||
|
||||
override_dh_auto_install:
|
||||
$(MAKE) pure_install INSTALLDIRS=vendor \
|
||||
PREFIX=$(shell pwd)/debian/alien/$(shell perl -MConfig -e 'print $$Config{prefix}') \
|
||||
VARPREFIX=$(shell pwd)/debian/alien
|
||||
|
||||
override_dh_auto_clean:
|
||||
# distclean moans about MANIFEST, this is quieter
|
||||
if [ -e Makefile ]; then $(MAKE) realclean; fi
|
||||
|
||||
# Not intended for use by anyone except the author.
|
||||
announcedir:
|
||||
@echo ${HOME}/src/joeywiki/code/alien/news
|
||||
15
gendiff.txt
Normal file
15
gendiff.txt
Normal file
@@ -0,0 +1,15 @@
|
||||
Alien can use special diff files to help make alien packages conform to
|
||||
debian policy. This is only used when you are converting to deb format. This
|
||||
document briefly explains how to make them. It assumes you are familiar with
|
||||
working with debian source packages.
|
||||
|
||||
* Use "alien -g file.rpm" to generate a "source" directory tree.
|
||||
* Make whatever changes you need to make to debian/rules, add other files,
|
||||
etc.
|
||||
* Use dpkg-buildpackage to generate a standard debian .diff.gz file, and
|
||||
stick it in /var/lib/alien.
|
||||
* Test "alien file.rpm" - it should use your diff. If it works properly,
|
||||
(it's best if lintian is happy with the resulting .deb too), send the
|
||||
.diff.gz file to me for inclusion in alien.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org>
|
||||
Reference in New Issue
Block a user