#!/usr/bin/perl

# customdeb - Modfies binary Debian packages
# © 2008 Joachim Breitner
# 
# 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.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.


=head1 NAME

customdeb - Customizes a binary debian package

=head1 SYNOPSIS

B<customdeb> F<file.cdeb> [F<package.deb>]

Applies the changed specified in the file F<file.cdeb> to the package file specified on the command line. If no package file was passed, it downloads the latest package with L<dget>.

=head1 DESCRIPTION

=head2 DIRECTORIES

The created package will be saved in the F<output/> subdirectory of
the current directory. A F<dlcache/> directory will be created as
well, to prevent repeated downloads of the same file. It can,
however, be deleted without problems.
 
=head2 FILE FORMAT

The cdeb file should be in a RFC822-like format, commonly used in Debian for
almost everything: Field names and values
are separated by a colon (C<:>). Lines starting with a blank are just appended
to their previous line's value. Lines that contain only a period (C<.>) in them
will become an empty line in the output.  Empty lines are ignored. 
Comments are allowed - All characters after a # sign until the end of the 
line are ignored. If you need to include the # sign, prepend it with another #. Also see
L<Parse::DebControl>.

The first stanza of the file specifies general information on the package and
the changes. This is followed by any number of change stanzas, described as below. The changes are applied in the order of their appearance in the cdeb file.

=head2 HEADER FIELDS

=over 4

=item Package 

The name of the package to modify. I<(required)>

=item Mod-Version

String to append to the version of the package.

Default: 0

=item Changes

String to be inserted into the Debian changelog of the
created package.

Default: "This is a customized package, created using customdeb."

B<TODO:> Multi line arguments are not handled nicely yet.

=item Files:

String that specifies a directory to copy files from into
the package (maybe overwriting files there). This happens before any of
modification stanzas are executed.

Default: None


=back

=head2 FILE STANZA FIELDS

This describes changes to a file in the package.

=over 4

=item File

The full path of the file to modify or add. I<(required)>

=item Content

Write the (probably-multi-line) value of the field to the file.

=item Permission

The file permission to set, in octal format.

=item Owner

The user and group to set, separated by a space.

=back

=head1 SEE ALSO

You can find example files for B<customdeb> in F</usr/share/doc/customdeb/examples/>.

=head1 AUTHOR

Joachim Breitner <nomeata@debian.org>

=cut

use warnings;
use strict;

use Parse::DebControl;
my $parser = new Parse::DebControl;
use File::Basename;
use File::Temp qw/tempdir/;
use File::Copy;
use File::Copy::Recursive qw(rcopy);
use Debian::Debhelper::Dh_Lib qw(escape_shell);
use Parse::DebianChangelog;
use Cwd;


sub error ($) {
	print @_;
	exit 1;
}

sub run {
	my $ret = system @_;
	if ($ret != 0) {
		error ("Failed to run ".escape_shell(@_)."\n")
	}
}

# We need to run as fakeroot
if ($< != 0) {
        print "Restarting with fakeroot\n";
	exec {'fakeroot'} ('fakeroot', $0, @ARGV);
}

# Real option parsing here
if (@ARGV == 0) {
	error "Please enter configuration to customize.\n";
}

my $modfile = shift @ARGV;

if (! -e "$modfile") {
	error "Can not find $modfile/.\n";
}

my $basedir = getcwd();
my $modfiledir;
if ($modfile =~ /^\//) {
	$modfiledir = dirname "$modfile";
} else {
	if ($modfile =~ /\//) {
		$modfiledir = $basedir ."/". dirname $modfile;
	} else {
		$modfiledir = $basedir;
	}
}

my $packagefile;
if (@ARGV >= 1) {
	$packagefile = shift @ARGV;
	if (not $packagefile =~ /^\//) {
		$packagefile = $basedir . "/" . $packagefile;
	}
}


for my $dir qw/dlcache output/ {
	if (! -d $dir) {
		mkdir $dir or die;
	}
}

my $stanzas = $parser->parse_file($modfile, { useTieIxHash => 'true' , stripComments => 'true'});

if (not defined $stanzas) {
	error "Could not parse $modfile\n";
}
my $modheader = $stanzas->[0];
my @mods = splice @$stanzas, 1;

for my $req (qw/Package/) {
	if (! exists $modheader->{$req}) {
		error "Missing required field \"$req\"\n";
	}
}

for my $field (keys %$modheader) {
	if (not grep {$_ eq $field} qw/Package Mod-Version Changes Files/) {
		error "Unknown field in header stanza: $field\n";
	}
}

my $package = $modheader->{'Package'};
print "Working on package $package.\n";

# Get original package
unless (defined $packagefile) {
	my $dldir = tempdir("dl-XXXX", DIR => $basedir, CLEANUP => 1);
	chdir $dldir or die;
	run (qw/dget --path/, "$basedir/dlcache", $package);
	my ($origfile) = glob "*";
	print "Downloaded file $origfile\n";
	move($origfile, "$basedir/dlcache");
	$packagefile = "dlcache/$origfile";
}

# Extract package
chdir $basedir or die;
my $workdir = tempdir("work-XXXX", DIR => $basedir, CLEANUP => 1);
run (qw/dpkg-deb -x/, $packagefile, $workdir);
run (qw/dpkg-deb -e/, $packagefile, "$workdir/DEBIAN");

#
# Do the modifications here
#
chdir $workdir or die;
my $control = $parser->parse_file('./DEBIAN/control', { useTieIxHash => 'true' });

# Check package name
$package eq $control->[0]->{Package} or error ("You wanted to modify $package, but I got a package for ".$control->[0]->{Package}."!\n");

# Bump version number
my $modversion = "1";
$modversion = $modheader->{"Mod-Version"} if exists $modheader->{"Mod-Version"};

my $version = $control->[0]->{Version}.".customdeb".$modversion;

# Changelog message
my $logmessage = "This is a customized package, created using customdeb\n";
$logmessage = $modheader->{"Changes"} if exists $modheader->{"Changes"};

# Changelog
my $changelogfile = "./usr/share/doc/$package/changelog.Debian";
if (! -e "$changelogfile.gz") {
	error "No changelog found in $changelogfile.gz\n"
}
print "Modifying changelog.\n";
run ("gunzip", "$changelogfile.gz");
run (qw/dch -v/, $version, qw/-D UNRELEASED -c/, $changelogfile, $logmessage);

# Copy Files
if (exists $modheader->{Files}) {
	my $overlaydir = $modfiledir."/".$modheader->{Files};
	unless (-d $overlaydir) {
		error ("Not a directory: $overlaydir\n");
	}
	
	print "Copying over files from $overlaydir\n";
	rcopy($overlaydir, ".");
}

# Run modification stanzas

for my $mod (@mods) {
	for my $req (qw/File/) {
		if (! exists $mod->{$req}) {
			error "Missing required field \"$req\" in modification stanza.\n";
		}
	}

	for my $field (keys %$mod) {
		if (not grep {$_ eq $field} qw/File Owner Permission Content/) {
			error "Unknown field in modification stanza: $field\n";
		}
	}

	my $file = $mod->{File};
	$file =~ s/^\///; # Strip leading / if present

	print "Modifying $file\n";

	if (exists $mod->{Content}) {
		my $content = $mod->{Content};
		$content =~ s/^\n//g; # When the use only writes in multi-line style.
		$content .= "\n";
		open FH, '>', $file or die $!;
		print FH  $content or die $!;
		close FH or die $!;
		print "Writing content to $file\n"
		
	} else {
		unless (-e $file) {
			open FH, '>', $file or die $!;
			close FH or die $!;
		}
	}

	# Update File-Owner
	if (exists $mod->{Owner}) {
		my ($user,$group) = split (' ', $mod->{Owner}, 4);
		unless ($user and $group) {
			error("Wrong format: ".$mod->{Owner});
		}
		print "Owner of /$file is now $user:$group\n";
		unless ($user =~ /\d+/) {
			$user = getpwnam($user);
		}
		unless ($group =~ /\d+/) {
			$group = getgrnam($group);
		}
		unless (defined $user) {
			error("Could not find user: ".$mod->{Owner});
		}
		unless (defined $group) {
			error("Could not find group: ".$mod->{Owner});
		}

		chown $user, $group, $file or die $!;
	}
	# Update File-Permissions
	if (exists $mod->{Permission}) {
		my $chmod = $mod->{Permission};
		print "Setting /$file to chmod $chmod\n";
		chmod oct($chmod), $file or die $!;
	}
}


#
# Update control fields
#

# Figure out version and set it
my $changelog = Parse::DebianChangelog->init();
$changelog->parse( {infile => $changelogfile} );
$version eq $changelog->dpkg()->{Version} or error ("Version mismatch\n");
print "Creates version $version\n";
$control->[0]->{Version} = $version;

# Write control file
$parser->write_file("./DEBIAN/control", $control, { clobberFile => 'true' });

# Re-Pack Changelog
run ("gzip", "-9", $changelogfile);

# Update md5sums
# (stolen from /usr/bin/dh_md5sums)
print "Updateing md5sums file\n";
run("find . -type f ! -regex '.*/DEBIAN/.*' -printf '%P\\0' | xargs -r0 md5sum > DEBIAN/md5sums");

# Re-build package
chdir $basedir or die;
run (qw/dpkg-deb -b/, $workdir, "output");

