#!/usr/bin/perl
#
# Run debootstrap and add a few other files needed to create a working
# sbuild chroot.
# Copyright © 2004 Francesco P. Lovergine <frankie@debian.org>.
# Copyright © 2007-2008 Roger Leigh <rleigh@debian.org>.
#
# 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, see
# <http://www.gnu.org/licenses/>.
#
#######################################################################

use strict;
use warnings;

use POSIX;
use Getopt::Long qw(:config no_ignore_case auto_abbrev gnu_getopt);
use Sbuild::Sysconfig qw($arch $hostname);
use Sbuild qw(dump_file help_text version_text usage_error);
use File::Temp ();

package main;

sub add_items ($@);
sub dump_file ($);

# Add items to the start of a comma-separated list, and remove the
# items from later in the list if they were already in the list.
sub add_items ($@) {
    my $items = shift;
    my @add = @_;

    my $ret = '';
    my %values;

    foreach (@_) {
	$values{$_} = '';
	$ret .= "$_,"
    }

    # Only add if not already used, to eliminate duplicates.
    foreach (split (/,/,$items)) {
	$ret .= "$_," if (!defined($values{$_}));
    }

    # Remove trailing comma.
    $ret =~ s/,$//;

    return $ret;
}

our $bootstrap_arch = $arch;
our $foreign = 0;
our $include = '';
our $exclude = '';
our $components = 'main';
our $keyring = '';
our $resolve_deps = 1;
our $keep_debootstrap_dir = 0;
our $verbose = 0;

# Default to using the system keyring
if (!defined($keyring) && -f '/etc/apt/trusted.gpg') {
    $keyring='/etc/apt/trusted.gpg';
}

GetOptions (
    "h|help" => sub { help_text("8", "sbuild-createchroot"); },
    "V|version" => sub {version_text("sbuild-createchroot"); },

    "foreign" => \$foreign,
    "resolve-deps" => sub { $resolve_deps = 1; },
    "no-resolve-deps" => sub { $resolve_deps = 0; },
    "keep-debootstrap-dir" => \$keep_debootstrap_dir,
    "arch=s" => \$bootstrap_arch,
    "verbose" => \$verbose,
    "exclude=s" => \$exclude,
    "include=s" => \$include,
    "components=s" => \$components,
    "keyring=s" => \$keyring)
or usage_error("sbuild-createchroot", "Error parsing command-line options");

$include = add_items($include, "fakeroot", "build-essential");

usage_error("sbuild-createchroot",
	    "Incorrect number of options") if (@ARGV <3 || @ARGV >4);

my $suite = $ARGV[0];
my $target = $ARGV[1];
my $mirror = $ARGV[2];
my $script = undef;

$script = $ARGV[3] if $#ARGV == 3;

if ($verbose) {
    print "I: SUITE: $suite\n";
    print "I: TARGET: $target\n";
    print "I: MIRROR: $mirror\n";
    print "I: SCRIPT: $script\n" if (defined($script));
}

my @args = ("--arch=$bootstrap_arch",
	    "--variant=buildd");
push @args, "--verbose" if $verbose;
push @args, "--foreign" if $foreign;
push @args, "--keep-debootstrap-dir" if $keep_debootstrap_dir;
push @args, "--include=$include" if $include;
push @args, "--exclude=$exclude" if $exclude;
push @args, "--components=$components" if $components;
push @args, "--keyring=$keyring" if $keyring;
push @args, $resolve_deps ? "--resolve-deps" : "--no-resolve-deps";
push @args, "$suite", "$target", "$mirror";
push @args, "$script" if $script;

if ($verbose) {
    print "I: Running debootstrap " . join(' ',@args) . "\n";
}

# Run debootstrap with specified options.
!system("/usr/sbin/debootstrap", @args) or die "E: Error running debootstrap";

# Set up minimal /etc/hosts.
my $hosts = "${target}/etc/hosts";
open(HOSTS, ">$hosts")
    or die "Can't open $hosts for writing";
print HOSTS "127.0.0.1 $hostname localhost";
close HOSTS or die "Can't close $hosts";

# Display /etc/hosts.
print "I: Configured /etc/hosts:\n";
dump_file("$hosts");

# Set up minimal /etc/apt/sources.list
my $sources = "${target}/etc/apt/sources.list";
my $comps = join(' ',split(/,/,$components));
open(SOURCES, ">$sources")
    or die "Can't open $sources for writing";
print SOURCES "deb $mirror $suite $comps\n";
print SOURCES "deb-src $mirror $suite $comps\n";
close SOURCES or die "Can't close $sources";

# Display /etc/apt/sources.list.
print "I: Configured APT /etc/apt/sources.list:\n";
dump_file("${target}/etc/apt/sources.list");
print "I: Please add any additional APT sources to ${target}/etc/apt/sources.list\n";

# Write out schroot chroot configuration.
my $chrootname = "${suite}-${bootstrap_arch}-sbuild";

# TODO: Don't hardcode path
my $SCHROOT_CONF =
    new File::Temp( TEMPLATE => "$chrootname.XXXXXX",
		    DIR => "/etc/schroot/chroot.d",
		    UNLINK => 0)
    or die "Can't open schroot configuration file: $!\n";

print $SCHROOT_CONF <<"EOF";
[$chrootname]
type=directory
description=Debian $suite/$bootstrap_arch autobuilder
location=$target
priority=3
groups=root,sbuild
root-groups=root,sbuild
run-setup-scripts=true
run-exec-scripts=true
EOF
    # Needed to display file below.
    $SCHROOT_CONF->flush();

# Display schroot configuration.
print "I: schroot chroot configuration written to $SCHROOT_CONF.\n";
dump_file("$SCHROOT_CONF");
print "I: Please rename and modify this file as required.\n";
print "I: Successfully set up $suite chroot.\n";
print "I: Run sbuild-adduser to add new sbuild users.\n";

exit 0;
