#!/usr/bin/perl
#
# Script to convert dpkg, rpm, tgz packages.
# Original author:
#   Christoph Lameter, <clameter@debian.org> October 30, 1996
# The deb -> rpm conversion code was written by:
#   Randoph Chung <rc42@cornell.edu>
# Current maintainer:
#   Joey Hess <joeyh@master.debian.org>
#
# Copyright: GPL

# Directory where alien templates, etc, are stored.
$libdir='/usr/lib/alien';

# Directory where alien patches are stored.
$patchdir='/var/lib/alien';

use Getopt::Long;

# Display usage help.
sub Usage {
	print <<eof;
Usage: alien [options ...] file
  file                      Packge file to convert.
  -d, --to-deb              Generate a Debian deb package. (default)
     Enables the following  option:
       --patch=<patch>      Specify patch file to use instead of automatically 
                            looking for patch in /var/lib/alien.
  -r, --to-rpm              Generate a RedHat rpm package.
  -t, --to-tgz              Generate a Slackware tgz package.
  -i, --install             Install generated package.
  -g, --generate            Unpack, but do not generate a new package.
  -s, --single              Like --generate, but do not create .orig directory.
  -c, --scripts             Include scripts in package.
  -k, --keep-version        Do not change version of generated package.
      --description=<desc>  Specify package description.
  -h, --help                Display this help message.

eof
}

# Print out a status line.
sub Status { my $message=shift;
	print "-- $message\n";
}

# Print out an error message and exit the program.
sub Error { my $message=shift;
	print STDERR "alien: $message\n";
	exit 1;
}

# Run a system command, and print an error message if it fails.
# The errormessage parameter is optional.
sub SafeSystem { my ($command,$errormessage)=@_;
	my $ret=system $command;
	if (int($ret/256) > 0) {
		$errormessage="Error running: $command" if !$errormessage;
		Error($errormessage);
	}
}

# Make the passed directory. Exits with error if the directory already
# exists.
sub SafeMkdir { my ($dir)=@_;
	if (-e $dir) {
        	Error("Directory $dir already exists.\nRemove it and re-run alien.");
	}
	mkdir $dir,0755 || Error("Unable to make directory, \"$dir\": $!");
}

# Load in the library files we need to preform the specified conversion.
# The library files have code in them that handles unpacking and building
# different types of archives.
sub LoadLibs { my ($filetype,$desttype)=@_;
	push @INC,$libdir;
	require "from$filetype.pl";
	require "to$desttype.pl";
}

# Process parameters.
# Sets some global variables.
sub GetParams {
	# Get options.
	$ret=&GetOptions(
		"to-deb|d",\$todeb,
		"to-rpm|r",\$torpm,
		"to-tgz|t",\$totgz,
		"generate|g", \$generate,
		"install|i", \$install,
		"single|s", \$single,
		"scripts|c", \$scripts,
		"patch|p=s", \$patchfile,
		"description=s", \$tgzdescription,
		"keep-version|k", \$keep_version,
		"help|h", \$help,
	);

	if (!$ret) {
		Usage();
		exit 1;
	}

	if ($help) {
		Usage();
		exit;
	}

	if ($single) {
		$generate=1;
	}

	if ($todeb) {
		$desttype='deb'
	}
	elsif ($torpm) {
		$desttype='rpm';
	}
	elsif ($totgz) {
		$desttype='tgz';
	}
	else {
		$desttype='deb';
	}

	# Sanity check options.
	if ($desttype ne 'deb' && $patchfile) {
		Usage();
		Error("You can not use --patch with --to-rpm or --to-tgz");
	}
	if (($generate || $single) && $install) {
		Usage();
		Error("You can not use --generate or --single with --install");
	}
	if ($patchfile && ! -f $patchfile) {
		Error("Specified patch file, \"$patchfile\" was not be found.");
	}

	# Filename to operate on, passed on command line.
	$file=shift @ARGV;

	if (!$file) {
		Usage();
		Error("You must specify a file to convert.");
	}	
	if (! -f $file) {
		Error("File $file not found.\n");
	}

	$filetype=FileType($file);
	if ($filetype eq $desttype) {
		Error("There is no point in converting a $filetype into a $desttype.");
	}
	if ($filetype ne 'tgz' && $tgzdescription ne undef) {
		Error("You can only use --description when converting from tgz packages.");
	}
}

# Pass the filename of a package.
# Returns "rpm" or "tgz" or "deb", depending on what it thinks the file type
# is, based on the filename.
# Perhaps this should call file(1), instead?
#
# Note that the file type this returns corresponds to directories in 
# $libdir.
sub FileType { my $file=shift;
	if ($file=~m/.*\.rpm/ ne undef) {
		return 'rpm';
	}	
	elsif ($file=~m/.*\.(tgz|tar\.gz)/ ne undef) {
		return 'tgz';
	}
	elsif ($file=~m/.*\.deb/ ne undef) {
		return 'deb';
	}
	else {
		Error("Format of filename bad: $file");
	}
}

# Pass this the name and version and revision of a package, it will return the 
# filename of a patch file for the package or undef if there is none.
sub GetPatch { my ($name,$version,$revision)=@_;
	my @patches=glob("$patchdir/$name\_$version-$revision*.diff.gz");
	if ($#patches < 0) {
		# try not matching the revision, see if that helps.
		@patches=glob("$patchdir/$name\_$version*.diff.gz");
		if ($#patches < 0) {
			# fallback to anything that matches the name.
			@patches=glob("$patchdir/$name\_*.diff.gz");
		}
	}

	# If we ended up with multiple matches, return the first.
	return $patches[0];
}

# Apply the given patch file to the given subdirectory.
sub Patch { my ($patchfile,$subdir)=@_;
	Status("Patching in $patchfile");
	chdir $subdir;
	# cd .. here in case the patchfile's name was a relative path.
	# The -f passed to zcat makes it pass uncompressed files through
	# without error.
	SafeSystem("(cd ..;zcat -f $patchfile) | patch -p1","Patch error.\n");
	# look for .rej files
	if (`find . -name "*.rej"`) {
		Error("Patch failed: giving up.");
	}
	SafeSystem('find . -name \'*.orig\' -exec rm {} \\;',"Error removing .orig files");
	chdir "..";
}

# Returns the 822-date.
sub GetDate {
	my $date=`822-date`;
	chomp $date;
	if (!$date) {
		Error("822-date did not return a valid result.\n");
	}

	return $date;
}

# Returns a email address for the current user.
sub GetEmail {
	if (!$ENV{EMAIL}) {
		my $login = getlogin || (getpwuid($<))[0] || $ENV{USER};
		open (MAILNAME,"</etc/mailname");
		my $mailname=<MAILNAME>;
		chomp $mailname;
		close MAILNAME;
		if (!$mailname) {
			$mailname=`hostname -f`;
			chomp $mailname;
		}
		return "$login\@$mailname";
	}
	else {
		return $ENV{EMAIL};
	}
}

# Returns the user name of the user who is running this.
sub GetUserName {
	my $username;
	my $username_in_passwd=undef;	

	my $login = getlogin || (getpwuid($<))[0] || $ENV{USER};

	open (PASSWD,"</etc/passwd");
	while (<PASSWD>) {
		my (@fields)=split(/:/,$_);
		if ($fields[0] eq $login) {
			$username=$fields[4];
			$username_in_passwd=1; # don't try NIS, no matter what.
			close PASSWD;
		}
	}
	close PASSWD;

	if (!$username_in_passwd && !$username && -x "/usr/bin/ypmatch") {
		# Give NIS a try.
		open (YPMATCH,"ypmatch $login passwd.byname |");
		my (@fields)=split(/:/,<YPMATCH>);
		$username=$fields[4];
		close YPMATCH;
	}

	# Remove GECOS(?) fields from username.
	$username=~s/,.*//g;

	# The ultimate fallback.
	if (!$username) {
		$username=$login;
	}

	return $username;
}

# Fill out a template, and save it to the passed location.
# The hash that is passed to this function lists the tags that can be onthe
# template, and the values to fill in for those tags.
sub FillOutTemplate { my ($fn,$destfn,%fields)=@_;
	open (IN,"<$fn") || Error("$fn: $!");
	open (OUT,">$destfn") || Error("$destfn: $!");
	while (<IN>) {
		s/#(.*?)#/$fields{$1}/g;
		print OUT $_;
	}
	close OUT;
	close IN;
}

# Check alien's working anvironment.
sub TestEnviron() {
	if (! -w '.') {
		Error("Cannot write to current directory. Try changing to /tmp and re-running alien.");
	}
	if ($> ne 0) {
		print STDERR "* Warning: alien is not running as root!\n";
		print STDERR "* Ownerships of files in the generated packages will\n";
		print STDERR "* probably be messed up.\n";
	}
}

# Main program:

# Initialization and data collection.
GetParams();
TestEnviron();
LoadLibs($filetype,$desttype);
Status("Examining $file");
my %fields=FixFields(GetFields($file));

# Unpack stage.
Status("Unpacking $file");
my $workdir="$fields{NAME}-$fields{VERSION}";
SafeMkdir($workdir);
chdir $workdir;
Unpack($file,%fields);
chdir "..";

# Conversion stage.
Convert($workdir,%fields);

# Build stage.
if (!$generate) {
	my $packagename=GetPackageName(%fields);
	Status("Building the package $packagename");
	chdir $workdir;
	Build(%fields);
	chdir "..";
	SafeSystem("rm -rf $workdir");
	# The above "building $packagename..." message can get lost in the
	# noise, so tell them again where the package ended up.
	print "\nGeneration of $packagename complete.\n" if !$install;
}

# Install stage.
if ($install) {
	my $packagename=GetPackageName(%fields);
	Status("Installing generated $desttype package");
	Install($packagename);
	unlink $packagename;
}

Status("Successfully finished");
