packaging / dl-rpm_to_deb

#!/usr/bin/perl -w
#
# This Perl script functions as a wrapper for ALIEN(1p)
#   alien - Convert or install an alien binary package
#
# We have two basic modes of operation:
# -m path (Generate a path from a given .rpm path
# -m alien (Run alien)
# Additionally, a mode called epath will generate a different path
# for expanded rpms.
#
# Additional flags:
# -r <rpmpath> Specify path to .rpm file (always required)
# -b <debpath> Specify path to .deb file (only required in alien mode)
#
# -d Debugging enabled
# -h For help

use strict;
use Getopt::Std;
use Data::Dumper;
use File::Basename;
#----------------------------------------------------------------------------
# Exit codes for shell script
use constant EXIT_SUCCESS => ( 0 ); # Operation completed successfully
use constant EXIT_CLI => ( 1 ); # Command-line error (typically syntax, order of ops)
use constant EXIT_RPM => ( 2 ); # Cannot access/read .rpm file, or the rpm file is unacceptable
use constant EXIT_DEB => ( 3 ); # Path to .deb may not be acceptable
use constant EXIT_ALIEN => ( 4 ); # Alien reported an error converting to .deb
use constant EXIT_UNKNOWN => ( 5 );

use constant OPTS => ( 'm:r:b:dh' );

my $Debug = 0;
my %FileExitMap = (
	'rpm' => EXIT_RPM(),
	'deb' => EXIT_DEB()
);

sub Main();
sub Syntax($);
sub SyntaxDetail($$);
sub CheckMode($);
sub DoSanity($$);
sub OptSet($$$);
sub CheckPaths($$);
sub GetFileExtension($$);
sub Process($);
sub GenPath($$);
sub GenEPath($$);
sub DoAlien($$);
sub FnRpmToDeb($);
#----------------------------------------------------------------------------
sub Main()
{
	my $errMsg = undef;
	my $ret = EXIT_SUCCESS();
	my %opts = ( );
	my @specFiles = (
		"$ENV{HOME}/.rpmrc",
		"$ENV{HOME}/.rpmmacros"
	);

	getopts(OPTS(), \%opts);
	if ( defined($opts{'h'}) ) {
		Syntax(1);
		return EXIT_SUCCESS();
	}

	$Debug = 1 if ( defined($opts{'d'}) );
	$ret = DoSanity(\%opts, \$errMsg);
	unless ( $ret == EXIT_SUCCESS() ) {
		printf(STDERR "%s\n", $errMsg) if ( defined($errMsg) );
		Syntax(0) if ( $ret == EXIT_CLI );
		return $ret;
	}

	$ret = Process(\%opts);
	return $ret;
}
#----------------------------------------------------------------------------
sub Syntax($)
{
	my $DoBanner = $_[0];

	my %args = (
		'm' => 'mode',
		'r' => 'rpmpath',
		'b' => 'debpath'
	);

	if ( $DoBanner ) {
		print("dl-rpm_to_deb; RPM to Debian Alien Wrapper for the Daybo Logic package system\n");
		print("(c)Copyright 2010 Daybo Logic.  All rights reserved\n");
		print("\n\n");
	}

	my $cmd = "$0 ";
	my @o = split('', OPTS());
	for ( my $i = 0; $i < scalar(@o); $i++ ) {
		next if ( $o[$i] eq ':' );
		$cmd .= '-' . $o[$i];
		if ( $i != (scalar(@o)-1) && $o[$i+1] eq ':' ) {
			# It's an option which takes an argument
			if ( defined($args{$o[$i]}) ) {
				$cmd .= ' <' . $args{$o[$i]} . '>';
			} else {
				die "-$o[$i] needs an argument, but none is known in the code, add to args hash;\n" .
				sprintf(Dumper \%args);
			}
		}
		$cmd .= ' ' unless ( $i == (scalar(@o)-1) );
	}
	$cmd .= "\n";

	print $cmd; # The basic syntax line

	# This function is long enough now, pass to a SyntaxDetail function for a complete listing
	SyntaxDetail(\@o, \%args);
	return;
}
#----------------------------------------------------------------------------
sub SyntaxDetail($$)
{
	my ( $Opts, $Args ) = @_;
	my %detail = (
		'm' => "Mode of operation, \'path\' produces a .deb path from an .rpm path, \'alien\' converts between the two",
		'h' => "This help/syntax report",
		'r' => 'Path to input RPM file, directory components may be changed, this is always mandatory',
		'b' => 'Path to output DEB file, the path must exist and be writable, only accepted in alien mode',
		'd' => 'Debug at critical sections to trace logic decisions'
	);

	foreach my $o ( @$Opts ) {
		next if ( $o eq ':' ); # Ignore Getopt-speak
		my $a = ''; # Argument to option
		my $d = 'No help provided ;('; # Detail
		$a = '<' . $Args->{$o} . '>' if ( defined($Args->{$o}) );
		$d = $detail{$o} if ( defined($detail{$o}) );
		printf("-%s %s\n\t%s\n", $o, $a, $d);
	}
	return;
}
#----------------------------------------------------------------------------
sub CheckMode($)
{
	my $m;
	my $Opts = $_[0];
	die 'Assertion failed' unless ( $Opts );
	$m = $Opts->{'m'};
	if ( defined($m) ) {
		return 1 if ( $m eq 'alien' || $m eq 'path' || $m eq 'epath' );
	}
	return 0;
}
#----------------------------------------------------------------------------
sub DoSanity($$)
{
	my %pathsToCheck = ( );
	my ( $Opts, $ErrMsg ) = @_;
	unless ( CheckMode($Opts) ) {
		$$ErrMsg = 'Error, -m must specify a valid mode' if ( $ErrMsg );
		return EXIT_CLI();
	}

	if ( $Opts->{'m'} eq 'path' || $Opts->{'m'} eq 'epath' ) { # In path mode we need rpm but not deb
		unless ( OptSet($Opts, 'r', 1) && !OptSet($Opts, 'b', 1) ) {
			$$ErrMsg = '-r must be specified, but not -b in -m path or -m epath mode' if ( $ErrMsg );
			return EXIT_CLI();
		}
	} elsif ( $Opts->{'m'} eq 'alien' ) { # In alien mode, both the rpm and the deb need to be specified
		unless ( OptSet($Opts, 'r', 1) && OptSet($Opts, 'b', 1) ) {
			$$ErrMsg = 'Need both -r and -b in -m alien mode' if ( $ErrMsg );
			return EXIT_CLI();
		}
		$pathsToCheck{$Opts->{'b'}} = 'deb';
	}

	$pathsToCheck{$Opts->{'r'}} = 'rpm';
	return CheckPaths(\%pathsToCheck, $ErrMsg);
}
#----------------------------------------------------------------------------
sub OptSet($$$)
{
	my ( $Opts, $Opt, $Contents ) = @_;
	my $ok = 0;
	return $ok unless ( $Opts && defined($Opt) && length($Opt) == 1 );
	return $ok unless ( defined($Opts->{$Opt}) );
	$ok = 1 unless ( $Contents );
	unless ( $ok ) {
		$ok = 1 if ( length($Opts->{$Opt}) );
	}
	return $ok;
}
#----------------------------------------------------------------------------
sub CheckPaths($$)
{
	my ( $Paths, $ErrMsg ) = @_;
	my $ret = EXIT_SUCCESS();

	die 'Assertion failed' unless ( $Paths );
	print Dumper $Paths if ( $Debug );
	foreach my $p ( keys(%$Paths) ) {
		my $fe;
		die 'Assertion failed, no value for path $p'
			unless ( defined($Paths->{$p}) && length($Paths->{$p}) );

		if ( $Paths->{$p} ne 'deb' && $Paths->{$p} ne 'rpm' ) {
			die 'Assertion failed - unrecognised path type, not rpm or deb for $p (has been set to $Paths->{$p})';
		}

		# Sanity check the paths, rpm has an rpm extensions etc
		unless ( GetFileExtension($p, \$fe) eq $Paths->{$p} ) {
			$$ErrMsg = sprintf(
				'%s file %s does not have the correct extension (%s)',
				$Paths->{$p}, $p, $Paths->{$p}
			) if ( $ErrMsg );
			return $FileExitMap{$Paths->{$p}};
		}

		if ( $Paths->{$p} eq 'rpm' ) { # The RPM must exist
			unless ( -f $p ) {
				$$ErrMsg = sprintf('%s file - %s is not a normal file', $Paths->{$p}, $p) if ( $ErrMsg );
				return $FileExitMap{$Paths->{$p}};
			}
		}

		if ( $Paths->{$p} eq 'deb' ) { # The directory to contain the .deb must exist
			my $d = dirname($p);
			unless ( -d $d ) {
				$$ErrMsg = sprintf(
					'Directory %s does not exist for writing %s file',
					$d, $Paths->{$p}
				) if ( $ErrMsg );
				return $FileExitMap{$Paths->{$p}};
			}
		}
	}

	return $ret;
}
#----------------------------------------------------------------------------
sub GetFileExtension($$)
{
	my $c;
	my @parts;
	my ( $Path, $ExtOut ) = ( @_ );
	die 'Assertion failed' unless ( $ExtOut );
	$$ExtOut = '';
	return $$ExtOut unless ( defined($Path) && length($Path) );
	@parts = split('\.', $Path);
	$c = scalar(@parts);
	return $$ExtOut unless ( $c >= 2 );
	$$ExtOut = $parts[$c-1];
	return $$ExtOut;
}
#----------------------------------------------------------------------------
sub Process($)
{
	my $ret = EXIT_UNKNOWN();
	my $Opts = $_[0];
	my $m = $Opts->{'m'};
	my $debPath = undef;

	if ( $m eq 'path' ) {
		$ret = GenPath($Opts->{'r'}, \$debPath);
	} elsif ( $m eq 'epath' ) {
		$ret = GenEPath($Opts->{'r'}, \$debPath);
	} elsif ( $m eq 'alien' ) {
		$ret = DoAlien($Opts->{'r'}, $Opts->{'b'});
	}

	if ( $ret == EXIT_SUCCESS() && defined($debPath) ) {
		print "$debPath\n";
	}
	return $ret;
}
#----------------------------------------------------------------------------
sub GenPath($$)
{
	# A possible improvement to this code would be to ask the caller about the
	# name of the package, to avoid assumptions and nasty regexes.

	my $c;
	my @tmpd;
	my $fn;
	my $ret = EXIT_SUCCESS();
	my ( $Rpm, $Deb ) = ( @_ );
	$$Deb = $Rpm;
	$$Deb =~ s/RPMS/DEBS/g;
	@tmpd = split(m%/%, $$Deb);
	$c = scalar(@tmpd);
	$fn = $tmpd[$c-1];
	printf(STDERR "Filename for path re-generation is \'%s\'\n", $fn) if ( $Debug );
	$fn = FnRpmToDeb($fn);
	printf(STDERR "Filename transformation is \'%s\'\n", $fn) if ( $Debug );
	$tmpd[$c-1] = $fn;
	$$Deb = join('/', @tmpd);
	printf(STDERR "Path returned from GenPath is \'%s\'\n", $$Deb) if ( $Debug );
	return $ret;
}
#----------------------------------------------------------------------------
sub GenEPath($$)
{
	my $ret = EXIT_SUCCESS();
	my ( $Rpm, $Deb ) = ( @_ );
	my $fn;
	my $c;
	my ( @tmpd, @tmpd2 );
	my $pkg;
	my $ver;

	$$Deb = $Rpm;
	@tmpd = split(m%/%, $$Deb);
	$c = scalar(@tmpd);
	return EXIT_RPM() unless ( $c >= 2 );
	$fn = $tmpd[$c-1];
	return EXIT_RPM() unless ( FnInfoFromRpm($fn, \$pkg, \$ver) );

	@tmpd2 = ( );
	foreach my $d ( @tmpd ) {
		push(@tmpd2, $d);
		last if ( $d eq 'rpmbuild' );
	}
	@tmpd = @tmpd2;
	push(@tmpd, ('BUILD', $pkg . '-' . $ver));
	$$Deb = join('/', @tmpd);
	return $ret;
}
#----------------------------------------------------------------------------
sub DoAlien($$)
{
	my $rpm_m; # RPM with modified path (local)
	my $old_dir = undef;
	my $ret = EXIT_ALIEN();
	my ( $Rpm, $Deb ) = ( @_ );
	my $acmd = 'fakeroot alien -d -c -g -s -v -k -T'; # FIXME: Generates dir in wrong place.
	my @parts = split(m%\s+%, $acmd);

	$rpm_m = '../../' . $Rpm;
	push @parts, $rpm_m;
	$old_dir=`pwd`;
	if ( chdir('./rpmbuild/BUILD/') ) {
		printf("Running: %s\n", join(' ', @parts));
		my $retcode = system(@parts);
		$ret = EXIT_SUCCESS() if ( $retcode == 0 );
		chdir($old_dir);
	} else {
		printf(STDERR "Cannot change directory to $old_dir/rpmbuild/BUILD in DoAlien()\n");
	}
	return $ret;
}
#----------------------------------------------------------------------------
sub FnRpmToDeb($)
{
	# Convert from dl-generic-0.1.0-1.noarch.rpm
	# to dl-generic_0.1.0-1_all.deb

	my $Rpm = $_[0];
	my $deb = '';
	my ( $pkg, $ver, $rev, $arch );

	if ( $Rpm =~ m/^([a-z][a-z-]*)\-(\d+\.\d+.\d+)\-(\d+)\.(\w+)\.rpm$/ ) {
		$pkg = $1;
		$ver = $2;
		$rev = $3;
		$arch = $4;
	}

	$arch = 'all' if ( $arch eq 'noarch' ); # Slightly different terminology
	$deb = $pkg . '_' . $ver . '-' . $rev . '_' . $arch . '.deb';
	return $deb;
}
#----------------------------------------------------------------------------
sub FnInfoFromRpm($$$)
{
	# Acquire package name and version number from dl-generic-0.1.0-1.noarch.rpm

	my ( $Rpm, $Pkg, $Ver ) = @_;
	
	if ( $Rpm =~ m/^([a-z][a-z-]*)\-(\d+\.\d+.\d+)\-(\d+)\.(\w+)\.rpm$/ ) {
		$$Pkg = $1;
		$$Ver = $2;
		return 1;
	}
	return 0;
}
#----------------------------------------------------------------------------
exit Main();
#----------------------------------------------------------------------------
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.