#!/usr/bin/perl
#
# Script to handle alien packages under Debian
# Original author:
#   Christoph Lameter, <clameter@debian.org> October 30, 1996
# Current maintainer:
#   Joey Hess <joeyh@master.debian.org>

# 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 ...] <filename>
  <filename>	rpm or Slackware tgz to convert

  -n, --auto, --nopatch  Assume package can be installed without any patches.
  -i, --noinstall        Do not install generated .deb file.
  -g, --generate         Unpack, but do not generate .deb file.
  -s, --single           Like --generate, but do not create .orig directory.
  --patch=<patchfile>    Specify patch file to use instead of automatically
                         looking for patch in /var/lib/alien.
  -h, --help             Display this help message.

eof
}

# 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\n" if !$errormessage;
		print STDERR $errormessage;
		exit 1;
	}
}

# Process parameters.
# Sets some global variables.
sub GetParams {
	# Get options.
	$ret=&GetOptions(
		"auto|nopatch|n", \$nopatch,
		"generate|g", \$generate,
		"noinstall|i", \$noinstall,
		"single|s", \$single,
		"patch|p=s", \$patchfile,
		"help|h", \$help,
        );
	if (!$ret) { 
		Usage();
		exit 1;
	}

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

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

	# Sanity check options.
	if ($patchfile && ! -f $patchfile) {
		print STDERR "Specified patch file, \"$patchfile\" was not be found.\n";
		exit 1;
	}
	if ($nopatch && $patchfile) {
		print STDERR "Cannot handle --nopatch and --patch options simultaneously.\n";
		Usage();
		exit 1;
	}

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

	if (!$file) {
		print STDERR "You must specify a file to alienize.\n";
		Usage();
		exit 1;
	}	
	if (! -f $file) {
		print STDERR "File $file not found.\n";
		exit 1;
	}
}

# Pass the filename of apackage.
# Returns "rpm" or "tgz", 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';
	}
	else {
		print STDERR "Format of filename bad: $file\n";
		exit 1;
	}
}

# Fill %fields with information about the package.
# Pass filename and file type.
sub GetFields { my ($file,$filetype)=@_;
	if ($filetype eq 'rpm') {
		GetFieldsRPM($file);
	}
	elsif ($filetype eq 'tgz') {
		GetFieldsTGZ($file);
	}
	else {
	        print STDERR "Unknown file type: $filetype\n";
	        exit 1;
	}
	# Make sure package anme is lower case.
	$fields{NAME}=lc($fields{NAME});
}

# Pull fields out of a rpm file, fill %fields with them. Pass filename.
sub GetFieldsRPM { my $file=shift;
	# Use --queryformat to pull out all the fields we need.
	foreach $field ('NAME','VERSION','RELEASE','ARCH','CHANGELOGTEXT',
	                'SUMMARY','DESCRIPTION','COPYRIGHT') {
		$_=`rpm -qp $file --queryformat \%{$field}`;
		$fields{$field}=$_ if $_ ne '(none)';
	}
	
	# Sanity check fields.
	if (!$fields{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.
		($fields{SUMMARY})=($fields{DESCRIPTION}."\n")=~m/(.*?)\n/m;

		# Fallback.
		if (!$fields{SUMMARY}) {
			$fields{SUMMARY}="Converted RPM package";
		}
	}
	if (!$fields{COPYRIGHT}) {
		$fields{COPYRIGHT}="unknown";
	}
	if (!$fields{DESCRIPTION}) {
		$fields{DESCRIPTION}=$fields{SUMMARY};
	}

	# Fix up the description field to Debian standards (indented at
	# least one space, no empty lines.)
	my $description=undef;
	foreach $line (split(/\n/,$fields{DESCRIPTION})) {
		$line=~s/\t/        /g; # change tabs to spaces.
		$line=~s/\s+$//g; # remove trailing whitespace.
		if (!$line) {  # empty lines
			$line=" .";
		}
		else { # normal lines
			$line=" $line";
		}
		$description.=$line."\n";
	}
	chomp $description;
	$fields{DESCRIPTION}=$description."\n";

	# Convert ARCH into string, if it isn't already a string.
	if ($fields{ARCH} eq 1) {
		$fields{ARCH}='i386';
	}
	elsif ($fields{ARCH} eq 2) {
		$fields{ARCH}='alpha';
	}
	elsif ($fields{ARCH} eq 3) {
		$fields{ARCH}='sparc';
	}
	elsif ($fields{ARCH} eq 6) {
		$fields{ARCH}='m68k';
	}

	if ($fields{RELEASE} eq undef || $fields{VERSION} eq undef || !$fields{NAME}) {
		print STDERR "Error querying rpm file.\n";
		exit;
	}

	$fields{RELEASE}=$fields{RELEASE}+1;
}

# Figure out package name and version based on the filename of the tar file.
# Pass filename.
sub GetFieldsTGZ { my $file=shift;
	# Get basename of the filename.
	my ($basename)=('/'.$file)=~m#^/?.*/(.*?)$#;

	# Strip out any tar extentions.
	$basename=~s/\.(tgz|tar\.gz)$//;

	if ($basename=~m/(.*)-(.*)/ ne undef) {
		$fields{NAME}=$1;
		$fields{VERSION}=$2;
	}
	else {
		$fields{NAME}=$basename;
		$fields{VERSION}=1;
	}

	$fields{ARCH}='i386';
	$fields{RELEASE}=1;
}

# Pass this the name of a package, it will return the filename of a patch file
# for the package.
sub GetPatch { my $name=shift;
	if (!$patchfile) {
		$patchfile=glob("$patchdir/$name*.diff.gz")
	}
	if (! -f $patchfile && !$generate) {
		print STDERR "Patchfile $patchdir/$name*.diff.gz not found.\n";
		print STDERR "You may want to run \"alien --auto ...\".\n";
		print STDERR "See the alien man page for details.\n";
		exit 1;
	}
	if (! -f $patchfile) {
		$patchfile='';
	}

	return $patchfile;
}

# This handles the unpack phase --
# print the message, create the directory, cd into it, dispatch
# appropriate unpack subroutine, cd back out.
#
# Returns the directory that is created.
sub Unpack { my ($file,$package,$version,$filetype)=@_;
	print "-- Unpacking $file\n";
	if (-e "$package-$version") {
		print STDERR "$package-$version already exists.\n";
		print STDERR "Remove it and re-run alien.\n";
		exit 1;
	}

	mkdir "$package-$version",0755;
	mkdir "$package-$version/debian",0755;
	chdir "$package-$version";

	if ($filetype eq 'rpm') {
		UnpackRPM($file,$fields{NAME},$fields{VERSION});
	}
	elsif ($filetype eq 'tgz') {
		UnpackTGZ($file,$fields{NAME},$fields{VERSION});
	}
	else {
		print STDERR "Unknown file type: $filetype\n";
		exit 1;
	}

	chdir "..";
	return "$package-$version";
}

# Handles unpacking of rpms.
sub UnpackRPM { my ($file,$package,$version)=@_;
	SafeSystem("(cd ..;rpm2cpio $file) | cpio --extract --make-directories --no-absolute-filenames",
	           "Error unpacking $file\n");
}

# Handles unpacking of tgz's.
sub UnpackTGZ { ($file,$package,$version)=@_;
	SafeSystem ("(cd ..;cat $file) | tar zxpf -","Error unpacking $file\n");

	# Make install script into postinst if it is the only file in the
	# install directory.
	if (-f "install/doinst.sh") {
		my @files=glob("install/*");
		if ($#files eq 0) { # only 1 file, so it must be doinst.sh
			SafeSystem("mv install/doinst.sh debian/postinst");
			rmdir "install";
		}
		else { # more than one file, so who knows..
			print STDERR "Other files besides doinst.sh present in install directory.\n";
			print STDERR "Install script cannot be used as postinst script!";
		}
	}
}

# Apply the given patch file to the given subdirectory.
sub Patch { my ($patchfile,$subdir)=@_;
	print "-- Patching in $patchfile\n";
	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"`) {
		print STDERR "Patch failed: giving up.\n";
		exit 1;
	}
	SafeSystem "rm `find . -name '*.orig'`";
	chdir "..";
}

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

	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;
		return "$login\@$mailname";
	}
	else {
		return $ENV{EMAIL};
	}
}

# Returns the user name of the user who is running this.
sub GetUserName {
	my $username;
	
	my $login = getlogin || (getpwuid($<))[0] || $ENV{USER};

	open (PASSWD,"</etc/passwd");
	while (<PASSWD>) {
		my (@fields)=split(/:/,$_);
		if ($fields[0] eq $login) {
			$username=$fields[4];
			close PASSWD;
		}
	}
	close PASSWD;

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

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

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

	return $username;
}

# Fill out templates to create debian/* files.
# Pass it the work directory, and the type of package we are debianizing.
sub AutoDebianize { my ($workdir,$filetype)=@_;
	print "-- Automatic package debianization\n";

	# Generate some more fields we need.
	$fields{DATE}=GetDate();
	$fields{EMAIL}=GetEmail();
	$fields{USERNAME}=GetUserName();

	# Fill out all the templates.
	foreach $fn (glob("$libdir/$filetype/*")) {
		open (IN,"<$fn");
		$fn=~s#^$libdir/$filetype/##;
		open (OUT,">$workdir/debian/$fn") || exit print "$workdir/debian/$fn: $!";
		while (<IN>) {
			s/#(.*?)#/$fields{$1}/g;
			print OUT $_;
		}
		close OUT;
		close IN;
	}

	if ($filetype eq 'rpm') {
		# Include the output of rpm -qi in the copyright file.
		system "rpm -qpi $file >> $workdir/debian/copyright";
	}

	# Assume all files in etc are conffiles.
	# This is a temporary fix.
	system "cd $workdir && find etc -type f -printf \"/%p\n\" > debian/conffiles 2>/dev/null";
}

# Main program:

# Initialization and data collection.
GetParams();
$filetype=FileType($file);
GetFields($file,$filetype);
if (!$nopatch) {
	$patchfile=GetPatch($fields{NAME});
}

# Unpack stage.
$workdir=Unpack($file,$fields{NAME},$fields{VERSION},$filetype);
if ($single) {
	print "Directory $workdir prepared.\n";
}
elsif ($generate) {
	SafeSystem("cp -a $workdir $workdir.orig",
	            "Error creating $workdir.orig");

	print "Directories $workdir and $workdir.orig prepared.\n";
}

# Package debianization.
if ($patchfile) {
	Patch($patchfile,$workdir);
}
else {
	AutoDebianize($workdir,$filetype);
}
chmod 0755,"$workdir/debian/rules";
$debname="$fields{NAME}_$fields{VERSION}-$fields{RELEASE}_$fields{ARCH}.deb";

# Build stage.
if (!$generate) {
	print "-- Building the package $debname\n";
	chdir $workdir;
	SafeSystem("debian/rules binary","Package build failed.\n");
	chdir "..";
	SafeSystem("rm -rf $workdir");
}

# Install stage.
if (!$generate && !$noinstall) {
	print "-- Installing generated .deb package\n";
	SafeSystem("dpkg -i $debname");
	unlink $debname;
}

print "-- Successfully finished\n";
