#!/usr/bin/perl

# Copyright (C) 2006-2012  Neil Williams <codehelp@debian.org>
#
# This package 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 3 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, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;
use Cwd qw (realpath getcwd);
use File::Basename;
use POSIX qw(locale_h);
use Locale::gettext;
use Config::IniFiles;
use vars qw / $our_version $prog $configfile $config $suite $tarname
 $milestone $name $tarball $key $branch $arch $dir $dryrun $verbose
 $etcdir @dirs @touch $config_str $dpkgdir $codename $extralist
 $rootpkg $targetpkg $location $components $basedir /;
setlocale(LC_MESSAGES, "");
textdomain("ladder");
$prog = basename($0);
$our_version = &scripts_version();
$basedir = "/var/lib/ladder/";
$arch = 'armel';
$dir = "${basedir}rootfs/";
$etcdir = "${dir}etc/apt/"; # sources below ./$name/
use Data::Dumper;
while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	} elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion();
		exit (0);
	} elsif (/^(-m|--milestone)$/) {
		$milestone = shift;
		$configfile = "/etc/ladder.d/$milestone.conf"
			if (-r "/etc/ladder.d/$milestone.conf");
	} elsif (/^(-c|--configfile)$/) {
		$configfile = realpath(shift);
	} elsif (/^(-t|--tarball)$/) {
		$tarball = realpath (shift);
	} elsif (/^(-a|--arch)$/) {
		$arch = shift;
	} elsif (/^(-n|--dry-run)$/) {
		$dryrun++;
	} elsif (/^(-v|--verbose)$/) {
		$verbose++;
	} else {
		die "$prog: "._g("Unknown option")." $_.\n";
	}
}

if ((not defined $configfile) or (not defined $tarball)) {
	&usageversion;
	exit 0;
}
my $dmsg = sprintf (_g("Need a configuration file - use %s -f\n"), $prog);
die ($dmsg) if (not -r "$configfile");
$config     = new Config::IniFiles( -file => $configfile );
&check_config ($config);

# Translators: fields are programname, version string, include file, milestone name.
printf (_g("%s %s using %s for %s\n"), $prog, $our_version, $configfile, $name);
print _g("in dry-run mode") if (defined $dryrun);
printf (_g("Suite:\t\t%s\n"),$suite);
printf (_g("Codename:\t%s\n"), $codename);
printf (_g("Mirror:\t\t%s\n"), $location);
printf (_g("Target package:\t%s\n"), $targetpkg);

if (defined $key) {
	my $gpg = system("gpg --list-secret-key $key >/dev/null 2>&1");
	$gpg = $gpg >> 8;
	if ($gpg != 0) {
		my $dmsg = sprintf(_g("secret key for '%s' is not available to the current user.\n"), $key);
		die ($dmsg);
	}
}

mkdir ($dir);
if (defined $tarball) {
	if (not -f $tarball) {
		my $dmsg = sprintf(_g("Failed to find %s: %s\n"), $tarball, $!);
		die ($dmsg);
	}
	my $tar = system ("cd ${dir} ; tar -xzf $tarball");
	$tar = $tar >> 8;
	if ($tar != 0) {
		my $dmsg = sprintf(_g("Failed to decompress rootfs tarball %s: %s\n"), $tarball, $!);
		die ($dmsg);
	}
} else {
	exit 0;
}
# tarball checks
system ("mkdir -p ${etcdir}sources.list.d/") if (not -d "${etcdir}sources.list.d/");
system ("mkdir -p ${etcdir}preferences.d/")  if (not -d "${etcdir}preferences.d/");
system ("mkdir -p $dir/var/lib/apt/lists")   if (not -d "$dir/var/lib/apt/lists");
system ("mkdir -p $dir/var/lib/apt/lists/partial") if (not -d "$dir/var/lib/apt/lists/partial");
system ("mkdir -p $dir/var/cache/apt/archives")    if (not -d "$dir/var/cache/apt/archives");
system ("mkdir -p $dir/var/cache/apt/archives/partial") if (not -d "$dir/var/cache/apt/archives/partial");
@dirs = qw/ alternatives info parts updates/;
@touch = qw/ available diversions statoverride status lock/;
$dpkgdir = "var/lib/dpkg/";
system ("mkdir -p ${dir}$dpkgdir");
foreach my $dpkgd (@dirs) {
	if (not -d "${dir}${dpkgdir}$dpkgd") {
		mkdir ("${dir}${dpkgdir}$dpkgd");
	}
}
foreach my $file (@touch) {
	open(F, ">${dir}${dpkgdir}/$file");
	close F;
}
utime(time, time, "${dir}etc/shells") or
	(open(F, ">${dir}etc/shells") && close F );

if (not -d "${dir}etc/network") {
	mkdir ("${dir}etc/network");
}

if (not -d "${dir}dev") {
	mkdir ("${dir}dev");
}

$config_str  = (defined $verbose) ? '' : ' -q ';
$config_str .= " -o Apt::Get::Download-Only=true";
$config_str .= " -y -o Apt::Architecture=$arch";
$config_str .= " -o Apt::Install-Recommends=false";
$config_str .= " -o Dir::Etc=${etcdir}";
$config_str .= " -o Apt::Get::AllowUnauthenticated=true"; # fixme
$config_str .= " -o Dir::Etc::TrustedParts=/etc/apt/trusted.gpg.d";
$config_str .= " -o Dir::Etc::Trusted=/etc/apt/trusted.gpg";
$config_str .= " -o Dir::Etc::SourceList=${etcdir}sources.list";
$config_str .= " -o Dir::Etc::SourceParts=${etcdir}sources.list.d/";
$config_str .= " -o Dir::State=${dir}var/lib/apt";
$config_str .= " -o Dir::State::Status=${dir}${dpkgdir}status";
$config_str .= " -o Dir::Cache=${dir}var/cache/apt/";

# repo root dir
system ("mkdir -p ${basedir}$name/conf");
my $label = "$name ladder repository";
my $desc = (defined $branch) ? "$branch - $suite" : "ladder for $suite";
my $msg = sprintf(_g("Cannot write %s/conf/distributions"), $name);
open (DIST, ">${basedir}${name}/conf/distributions") or die ($msg." :$!");
# the labels are part of the syntax and cannot be translated.
print DIST "Origin: Debian\n";
print DIST "Label: $label\n";
print DIST "Suite: $suite\n";
print DIST "Codename: $codename\nVersion: 0.1\n";
print DIST "Architectures: $arch\n";
print DIST "Components: main\n"; #  even if the originals had components, this does not.
print DIST "SignWith: $key\n" if (defined $key);
print DIST "Description: $desc\n";
close (DIST);
my $vstr = (defined $verbose) ? "-v" : '--silent';
system ("reprepro $vstr -b ${basedir}$name removematched $suite '*'");
system ("reprepro $vstr -b ${basedir}$name export");
system ("reprepro $vstr -b ${basedir}$name createsymlinks");
# now empty the apt cache (if any) from the tarball.
system ("apt-get $config_str clean");

# populate
printf _g("Source:") . " deb $location $suite $components\n" if (defined $verbose);
printf _g("Apt configuration:") ." $config_str\n" if (defined $verbose);
open (SRC, ">${dir}etc/apt/sources.list.d/ladder-${name}.list") or die ("$!");
print SRC "deb $location $suite $components\n";
close (SRC);
system ("apt-get $config_str update");
system ("apt-get $config_str --purge autoremove $rootpkg") if (defined $rootpkg);
system ("apt-get $config_str install $targetpkg $extralist");
if (not defined $dryrun) {
	system ("apt-get $config_str update");
	system ("apt-get $config_str dist-upgrade");
}
system ("gpg -a --export $key > ${basedir}$name/ladder.gpg");
open (SOURCE, ">${basedir}$name/ladder.list") or die ("$!");
print SOURCE "deb copy:///$name/ $suite main\n";
close (SOURCE);
opendir (DEBS, "${dir}var/cache/apt/archives/") or die ("$!");
my @list = grep(/\.deb$/, readdir DEBS);
closedir (DEBS);
$tarname = "ladder-${name}.tgz";
if (not defined $dryrun) {
	foreach my $pkg (@list) {
		system ("reprepro --silent -b ${basedir}$name includedeb $codename ${dir}var/cache/apt/archives/$pkg 2>/dev/null");
	}
	unlink "${basedir}$tarname" if (-f "${basedir}$tarname");
	system ("cd ${basedir} ; tar -czf ./$tarname ./${name}/dists/ ./$name/ladder.list ./$name/ladder.gpg ./${name}/pool/")
		if (-d "${basedir}${name}/pool");
	printf (_g("Created %s\n"), "${basedir}${tarname}") if (-f "${basedir}${tarname}");
} else {
	print _g("Package list:\n");
	print join ("\n", sort @list);
	print "\n";
	# Translators: string is the name of the final tarball.
	printf (_g("%s not modified.\n"), "${basedir}${tarname}") if (-f "${basedir}${tarname}");
}
system ("rm -rf ${basedir}rootfs/*");
system ("rm -rf ${basedir}${name}/*");
system ("rmdir ${basedir}rootfs/");
system ("rmdir ${basedir}${name}");
exit 0;

# sub routines

sub usageversion {
	printf STDERR (_g("
%s - create a milestone repository
version %s

Syntax: %s [OPTIONS] -m MILESTONE -t TARBALL
        %s -?|-h|--help|--version

Commands:
-c|--config PATH:              path to the config file for this migration
-m|--milestone MILESTONE :     milestone name for the migration [required]
-t|--tarball PATH:             rootfs tarball to upgrade [required]
-n|--dry-run:                  unpack tarball and list the needed packages.
-a|--arch ARCHITECTURE:        architecture of the packages [default=armel]

-?|-h|--help|--version:        print this help message and exit

Options:
-n|--dry-run:                  check which packages would be processed

The specified config file dictates the target branch to achieve from
the rootfs tarball specified in the file. Normally, this will be from
one milestone to the adjacent milestone. Run %s repeatedly to create
multiple steps.

The initial tarball may be a clean build (in which case, ensure that
the milestone is the first software release - for Swift that was
azuki). If the tarball contains released software, this should
normally be a default install of the software release immediately
prior to the specified milestone as some packages may migrate data
formats and other mechanisms between releases and skipping a release
is not usually supported.

%s works in the /var/lib/ladder directory, unpacking the tarball into
./rootfs and creating the repostitory in a directory named after the
milestone. The tarball will be unpacked even in dry-run mode.

"), $prog, $our_version, $prog, $prog, $prog, $prog)
	or die "$0: failed to write usage: $!\n";
}

sub scripts_version {
	my $query = `dpkg-query -W -f='\${Version}' ladder`;
	(defined $query) ? return $query : return "";
}

sub check_config {
	my $conf = shift;
	my @sections = $conf->Sections;
	$name = $sections[0];
	my @msg=();
	$suite      = $config->val(lc($name), 'suite');
	$branch     = $config->val(lc($name), 'branch');
	$codename   = $config->val(lc($name), 'codename');
	$rootpkg    = $config->val(lc($name), 'rootpackage');
	$targetpkg  = $config->val(lc($name), 'targetpackage');
	$location   = $config->val(lc($name), 'location');
	$components = $config->val(lc($name), 'components');
	$key        = $config->val(lc($name), 'key');
	$extralist  = $config->val(lc($name), 'extrapackages');
	push @msg, sprintf(_g("Suite has not been specified in %s."),$configfile) if((not defined $suite) or $suite eq '');
	undef $branch if((not defined $branch) or $branch eq '');
	$codename   = "${name}-release" if((not defined $codename) or $codename eq '');
	undef $rootpkg if((not defined $rootpkg) or $rootpkg eq '');
	push @msg, sprintf(_g("Target package has not been specified in %s."),$configfile)
		if((not defined $targetpkg) or $targetpkg eq '');
	push @msg, sprintf(_g("Location (mirror) has not been specified in %s."), $configfile)
		if((not defined $location) or $location eq '');
	$components = "main" if((not defined $components) or $components eq '');
	undef $key if((not defined $key) or $key eq '');
	$extralist = '' if (not defined $extralist);
	die (join("\n", @msg)."\n") if (scalar @msg > 0);
}

sub _g {
	return gettext(shift);
}

# POD content

=pod

=head1 NAME

Ladder - creates migration repositories for software release sets

=head1 Description

Ladder creates a SecureApt repository to migrate production devices
from one release milestone to the next. The repository contains all
binary packages which would be installed to upgrade the target package
of the specified release, including base packages. Source packages are
not included as this would make the final tarball much larger than
necessary. Sources should remain available via the main repositories.

For the purposes of C<ladder>, the bare installation / rootfs should
be considered to always precede the first software release. Subsequent
steps can then be based on the tarball of the previous milestone.

Note that if using C<multistrap> or a foreign architecture
C<debootstrap>, it is best to ensure that the rootfs inside the tarball
is B<configured> and repacked before being used with C<ladder>. i.e.
use the production tarball rather than the build system tarball.

Ladder checks the installed package list from the production tarball
for that release, calculates the packages needed to migrate to the
specified milestone and prepares a repository containing those packages,
including all dependencies.

If the specified package list and the specified milestone are NOT
contiguous, errors can result if some of the contained packages need
to migrate between data formats. For most cases, create a ladder step
for each software release.

=head1 Deployment of ladder tarballs

The final tarball contains an example apt source showing the syntax
which would be suitable for use with the packaged repository. The
full path will need to be specified in the final sources list file.
e.g.

 deb copy:///milestone suite main
 
May need to be modified to:

 deb copy:///media/usb0/milestone suite main 

The example source is packaged as F<ladder.list> in the tarball.

The key should normally already be part of a keyring package and
installed on the devices. If not, an exported copy of the public key
is also included in the tarball which can be included into the device
keyring using C<apt-key> (which needs to be run as root):

 apt-key add /path/milestone/ladder.gpg

Some scripting / programming support will be needed to make this
process seamless on-device, in particular to provide the knowledge
of the actual sequence of milestone names, but this is beyond the scope
of C<ladder>, if only because the ladder tarball needs to be unpacked
first.

The only requirements to use the ladder tarball are to create the
relevant source list file, ensure the key is available and then call
apt-get update; apt-get upgrade. There is no need for perl, reprepro
or anything else used by C<ladder> itself.

=head1 Config files

Ladder configuration files live in F</etc/ladder.d/> and need to be
named after the release described. e.g. F</etc/ladder.d/internal.conf>.

A minimal file for Debian sid could look like:

 [sid]
 suite=unstable
 location=http://ftp.uk.debian.org/debian
 targetpackage=apt

A more comprehensive config file could look like:

 [internal]
 suite=interim
 codename=milestone
 branch=software_release_4
 key=0xDEADBEEF
 location=copy:///srv/repo
 rootpackage=libfoo3
 targetpackage=metapackage
 extrapackages=bar baz other

(It is possible to list more than one package, as a space separated list.
Commas or other markers will not be parsed by apt.)

To migrate a rootfs tarball between releases, specify the rootpackage
of the previous release. Ladder will then purge the root package
before installing the new release.

The key must be available to the root user as ladder requires sudo/root
to be able to use apt. Ensure that the specified secret key is
available - B<without a passphrase> - to the root user or the repository
will not be signed.

 sudo gpg --list-secret-key KEYID

If the key is not available, the repository simply won't be signed
and devices would need to pass the AllowUnauthenticated option to
C<apt-get> when using the ladder repository.

The section name (e.g. internal in the example above) is used as the
milestone name, which can differ from the suite name and the branch
name.

=head1 Steps and milestones

Ladder - as with Debian - only works forwards. Downgrades are not
supported. If the rootfs tarball contains an existing apt source which
contains packages B<NEWER> than the requested milestone, then the
packages downloaded will be for the existing apt source, not the
milestone. Check the output with the C<-n|--dry-run> option.

=head1 Output

Ladder works in the F</var/lib/ladder> directory, unpacking the tarball
into F<./rootfs> and creating the repository in a directory named
after the milestone.

Results will be F</var/lib/ladder/ladder-$name.tgz>

=head1 Support

C<ladder> was written with a specific purpose in mind but is available
in Debian in the hope it will be useful for other situations as well.
If there are specific situations where C<ladder> could be extended to
be more useful for others, let me know using the Debian bug tracking
system: F<bugs.debian.org/ladder>.

Note that C<reprepro> already has B<snapshot> support which is not
the same as a C<ladder> of milestones. Snapshots include full sources
and ancillary packages which are not needed on-device and are intended
for build systems and developer use - ladder milestones are intended to
provide a small repository which can be used on machines after
production.

=cut
