#! /usr/bin/perl
#
# sbuild: build packages, obeying source dependencies
# Copyright © 1998-2000 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
# Copyright © 2005      Ryan Murray <rmurray@debian.org>
# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org
# Copyright © 2008      Timothy G Abbott <tabbott@mit.edu>
# Copyright © 2008      Simon McVittie <smcv@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/>.
#
#######################################################################

package main;

use strict;
use warnings;
use POSIX;
use File::Basename qw(basename dirname);
use IO::Handle;
use IPC::Open3;
use FileHandle;
use GDBM_File;
use Getopt::Long qw(:config no_ignore_case auto_abbrev gnu_getopt);
use Sbuild qw(binNMU_version version_compare);
use Data::Dumper;
use File::Temp qw(tempdir);

sub fetch_source_files ($$$$$$);
sub build ($$$);
sub analyze_fail_stage ($);
sub remove_files (@);
sub install_deps ($$);
sub wait_for_srcdep_conflicts (@);
sub uninstall_deps ($);
sub uninstall_debs ($$@);
sub run_apt ($$\@\@@);
sub filter_dependencies ($\@\@\@);
sub check_dependencies (\@);
sub get_apt_policy ($@);
sub get_dpkg_status (@);
sub copy ($);
sub merge_pkg_build_deps ($$$$$$);
sub cmp_dep_lists (\@\@);
sub get_altlist ($);
sub is_superset (\%\%);
sub read_build_essential ();
sub expand_dependencies ($\@);
sub expand_virtuals ($\@);
sub get_dependencies ($@);
sub get_virtuals ($@);
sub parse_one_srcdep ($$\%);
sub parse_manual_srcdeps (@);
sub check_space ($@);
sub file_for_name ($@);
sub write_jobs_file ($);
sub append_to_FINISHED ($);
sub write_srcdep_lock_file (\@);
sub check_srcdep_conflicts (\@\@);
sub remove_srcdep_lock_file ();
sub prepare_watches (\@@);
sub check_watches ($);
sub should_skip ($);
sub add_givenback ($$);
sub set_installed (@);
sub set_removed (@);
sub unset_installed (@);
sub unset_removed (@);
sub df ($);
sub isin ($@);
sub fixup_pkgv (\$);
sub format_deps (@);
sub lock_file ($$);
sub unlock_file ($);
sub shutdown ($);
sub write_stats ($$);
sub debian_files_list ($);
sub dsc_files ($);
sub chroot_arch ($);
sub check_group_membership ();
sub open_build_log ($$$);
sub close_build_log ($$$$$$);
sub add_time_entry ($$);
sub add_space_entry ($$);
sub dump_main_state ();

package conf;
use Sbuild::Conf;
package main;
use Sbuild::Conf qw($cwd $nolog $username $verbose); # For backward
						     # compatibility.
use Sbuild::Chroot;
use Sbuild::Log qw(open_log close_log open_pkg_log close_pkg_log);
use Sbuild::Sysconfig qw($arch $hostname $version);

$ENV{'LC_ALL'} = "POSIX";
$ENV{'SHELL'} = "/bin/sh";

# avoid intermixing of stdout and stderr
$| = 1;
# in case the terminal disappears, the build should continue
$SIG{'HUP'} = 'IGNORE';

# A file representing /dev/null
if (!open(main::DEVNULL, '+<', '/dev/null')) {
    die "Cannot open /dev/null: $!\n";;
}

check_group_membership();

umask(022);

$main::distribution = "unstable";
undef $main::chroot;

$main::arch = $Sbuild::Sysconfig::arch;
$main::user_arch = "";
$main::batchmode = 0;
$main::auto_giveback = 0;
$main::build_arch_all = 0;
$main::build_source = 0;
$main::jobs_file = "build-progress";
$main::max_lock_trys = 120;
$main::lock_interval = 5;
$main::srcdep_lock_dir = "";
$main::ilock_file = "";
$main::srcdep_lock_cnt = 0;
$main::pkg_status = "";
$main::pkg_end_time = 0;
$main::pkg_start_time = 0;
$main::this_space = 0;
$main::chroot_dir = "";
$main::chroot_build_dir = "";
@main::toolchain_pkgs = ();
$main::override_distribution = 0;
$main::sub_task = "initialisation";
$main::current_session = undef;

# Be verbose by default if on a tty
if (-t STDIN && -t STDOUT && $main::verbose == 0) {
    $conf::verbose = 1;
}

exit 1 if !GetOptions ("arch=s" => \$main::user_arch,
		       "A|arch-all" => \$main::build_arch_all,
		       "auto-give-back=s" => sub {
			   $main::auto_giveback = 1;
			   if ($_[1]) {
			       my @parts = split( '@', $_[1] );
			       $main::auto_giveback_socket =
				   $parts[$#parts-3] if @parts > 3;
			       $main::auto_giveback_wb_user =
				   $parts[$#parts-2] if @parts > 2;
			       $main::auto_giveback_user =
				   $parts[$#parts-1] if @parts > 1;
			       $main::auto_giveback_host =
				   $parts[$#parts];
			   }
		       },
		       "f|force-depends=s" => sub {
			   push( @main::manual_srcdeps, "f".$_[1] );
		       },
		       "a|add-depends=s" => sub {
			   push( @main::manual_srcdeps, "a".$_[1] );
		       },
		       "check-depends-algorithm=s" => sub {
			   die "Bad build dependency check algorithm\n"
		       		if( ! ($_[1] eq "first-only" 
				    || $_[1] eq "alternatives") );
			   $conf::check_depends_algorithm = $_[1];
		       },
		       "b|batch" => \$main::batchmode,
		       "make-binNMU=s" => sub {
			   $main::binNMU = $_[1];
			   $main::binNMUver ||= 1;
		       },
		       "binNMU=i" => \$main::binNMUver,
		       "c|chroot=s" => \$main::chroot,
		       "database=s" => \$main::database,
		       "D|debug+" => \$conf::debug,
		       "apt-update" => \$conf::apt_update,
		       "d|dist=s" => sub {
			   $main::distribution = $_[1];
			   $main::distribution = "oldstable"
			       if $main::distribution eq "o";
			   $main::distribution = "stable"
			       if $main::distribution eq "s";
			   $main::distribution = "testing"
			       if $main::distribution eq "t";
			   $main::distribution = "unstable"
			       if $main::distribution eq "u";
			   $main::distribution = "experimental"
			       if $main::distribution eq "e";
			   $main::override_distribution = 1;
		       },
		       "force-orig-source" => \$conf::force_orig_source,
		       "m|maintainer=s" => \$conf::maintainer_name,
		       "k|keyid=s" => \$conf::key_id,
		       "e|uploader=s" => \$conf::uploader_name,
		       "n|nolog" => \$conf::nolog,
		       "purge=s" => sub {
			   $conf::purge_build_directory = $_[1];
			   die "Bad purge mode\n"
			       if !isin($conf::purge_build_directory,
					qw(always successful never));
		       },
		       "s|source" => \$main::build_source,
		       "stats-dir=s" => \$main::stats_dir,
		       "use-snapshot" => sub {
			   $main::useSNAP = 1;
			   $main::ld_library_path =
			       "/usr/lib/gcc-snapshot/lib";
			   $conf::path =
			       "/usr/lib/gcc-snapshot/bin:$conf::path";
		       },
		       "v|verbose+" => \$main::verbose,
		       "q|quiet" => sub {
			   $main::verbose-- if $conf::verbose;
		       },
    );

print "Selected distribution $main::distribution\n"
    if $conf::debug;
print "Selected chroot $main::chroot\n"
    if $conf::debug and defined $main::chroot;
print "Selected architecture $main::user_arch\n"
    if $conf::debug;

$conf::mailto = $conf::mailto{$main::distribution}
    if $conf::mailto{$main::distribution};

# see debsign for priorities, we will follow the same order
$main::dpkg_buildpackage_signopt="-m\"".$conf::maintainer_name."\"" if defined $conf::maintainer_name;
$main::dpkg_buildpackage_signopt="-e\"".$conf::uploader_name."\"" if defined $conf::uploader_name;
$main::dpkg_buildpackage_signopt="-k\"".$conf::key_id."\"" if defined $conf::key_id;
$conf::maintainer_name=$conf::uploader_name if defined $conf::uploader_name;
$conf::maintainer_name=$conf::key_id if defined $conf::key_id;

if (!defined($conf::maintainer_name) &&
    !defined($conf::uploader_name) &&
    !defined($conf::key_id) ) {
    die "A maintainer name, uploader name or key ID must be specified in .sbuildrc,\nor use -m, -e or -k\n";
}

# variables for scripts:
open_log($main::distribution);
$SIG{'INT'} = \&shutdown;
$SIG{'TERM'} = \&shutdown;
$SIG{'ALRM'} = \&shutdown;
$SIG{'PIPE'} = \&shutdown;

parse_manual_srcdeps( map { m,(?:.*/)?([^_/]+)[^/]*, } @ARGV );

write_jobs_file("");

my $dscfile;
foreach $dscfile (@ARGV) {

    my $dir = dirname($dscfile);
    my $dscbase = basename($dscfile);
    my $pkgv = basename($dscfile);
    $pkgv =~ s/\.dsc$//;
    my ($pkg, $version) = split /_/, $pkgv;
    my $invalid = 0;

    # Download if package does not have a .dsc extension and no
    # directory was specified.
    my $download = 1;
    if ($dscbase =~ m/\.dsc$/) {
	$download = 0;
	if( ! -f $dscfile ) {
	    $invalid = 1;
	}
    }
    elsif( ! defined $version ) {
	$invalid = 1;
    }

    print STDERR "D: dscfile = $dscfile\n" if $conf::debug;
    print STDERR "D: dir = $dir\n" if $conf::debug;
    print STDERR "D: dscbase = $dscbase\n" if $conf::debug;
    print STDERR "D: pkgv = $pkgv\n" if $conf::debug;
    print STDERR "D: pkg = $pkg\n" if $conf::debug;
    print STDERR "D: version = $version\n" if $conf::debug;
    print STDERR "D: download = $download\n" if $conf::debug;

    if ($invalid || ($download && $dscfile ne $pkgv)) {
	print PLOG "Invalid source: $dscfile\n";
	print PLOG "Skipping $pkg\n";
	$main::pkg_status = "skipped";
	goto cleanup_close;
    }

    {
	my $tpkg = basename($pkgv);
	# TODO: This should be $pkg_start_time, set in build().
	my $date = strftime("%Y%m%d-%H%M",localtime);

	if ($main::binNMU) {
	    $tpkg =~ /^([^_]+)_([^_]+)(.*)$/;
	    $tpkg = $1 . "_" . binNMU_version($2,$main::binNMUver);
	    $main::binNMU_name = $tpkg;
	    $tpkg .= $3;
	}

	next if !open_build_log( $tpkg, $main::distribution, $date );
    }

    $main::pkg_status = "failed"; # assume for now
    $main::current_job = $pkgv;
    $main::additional_deps = [];
    write_jobs_file( "currently building" );
    if (should_skip( $pkgv )) {
	$main::pkg_status = "skipped";
	goto cleanup_close;
    }

    my $session = Sbuild::Chroot::new($main::distribution,
				      $main::chroot, $main::user_arch);
    $main::current_session = $session;

    if (!$session->begin_session()) {
	print PLOG "Error creating schroot session: skipping $pkg\n";
	$main::pkg_status = "skipped";
	goto cleanup_close;
    }
    $main::chroot_dir = $session->{'Location'};
    $main::chroot_build_dir = tempdir("$username-$pkgv-$arch-XXXXXX" , DIR => $session->{'Build Location'});
    # TODO: Don't hack the build location in; add a means to customise
    # the chroot directly.
    $session->{'Build Location'} = $main::chroot_build_dir;
    $main::srcdep_lock_dir = $session->{'Srcdep Lock Dir'};
    $main::ilock_file = $session->{'Install Lock'};

    $main::arch = chroot_arch($session);

    # Update APT cache.
    if ($conf::apt_update) {
	if (!open(PIPE, $session->get_apt_command("$conf::apt_get", "-q update", "root", 1, '/') . " 2>&1 |")) {
	    print PLOG "Can't open pipe to apt-get: $!\n";
	    return 0;
	}
	while(<PIPE>) {
	    print PLOG $_;
	}
	close(PIPE);
	if ($?) {
	    print PLOG "apt-get update failed\n" ;
	    $main::pkg_status = "skipped";
	    goto cleanup_close;
	}
    }

    $main::pkg_fail_stage = "fetch-src";
    if (!fetch_source_files($session, \$dscfile,
			    $dir, $pkg, $version, $download)) {
	goto cleanup_close;
    }

    $main::pkg_fail_stage = "install-deps";
    if (!install_deps($session, $pkg)) {
	print PLOG "Source-dependencies not satisfied; skipping $pkg\n";
	goto cleanup_packages;
    }

    $main::pkg_status = "successful"
	if build ($session, basename($dscfile), $pkgv);
    write_jobs_file( $main::pkg_status );
    append_to_FINISHED( $pkgv );

  cleanup_packages:
    if (defined ($session->{'Session Cloned'}) &&
	$session->{'Session Cloned'} == 1) {
	print PLOG "Not removing build depends: cloned chroot in use\n";
    } else {
	uninstall_deps($session);
    }
    remove_srcdep_lock_file();
  cleanup_close:
    analyze_fail_stage( $pkgv );
    write_jobs_file( $main::pkg_status );

    $session->end_session();
    $session = undef;
    $main::current_session = undef;

    close_build_log( $main::current_job, $main::distribution, $main::pkg_status,
		     $main::pkg_start_time, $main::pkg_end_time,
		     $main::this_space );
    undef $main::binNMU_name;
    $main::current_job = "";
    if ( $main::batchmode and (-f "$conf::HOME/EXIT-DAEMON-PLEASE") ) {
	main::shutdown("NONE (flag file exit)");
    }
    dump_main_state() if $conf::debug;
}
write_jobs_file("");

close_log();
unlink( $main::jobs_file ) if $main::batchmode;
unlink( "SBUILD-FINISHED" ) if $main::batchmode;
if ($conf::sbuild_mode eq "user") {
    exit ($main::pkg_status ne "successful") ? 1 : 0;
}
exit 0;


sub fetch_source_files ($$$$$$) {
    my $session = shift;
    my $dscfile_ref = shift;
    my $dir = shift;
    my $pkg = shift;
    my $version = shift;
    my $download = shift;

    my ($dscbase, $files, @other_files, $dscarchs, @fetched);

    (my $sversion = $version) =~ s/^\d+://; # Strip epoch
    $dscbase = "${pkg}_${sversion}.dsc";

    my $build_depends = "";
    my $build_depends_indep = "";
    my $build_conflicts = "";
    my $build_conflicts_indep = "";
    local( *F );

    @main::have_dsc_build_deps = ();

    if (!defined($pkg) || !defined($version) || !defined($dir) || !defined($dscbase)) {
	print PLOG "Invalid source: $$dscfile_ref\n";
	return 0;
    }

    if (-f "${dir}/${dscbase}" && !$download) {
	print PLOG "${dscbase} exists in ${dir}; copying to chroot\n";
#	my @cwd_files = ("${dir}/${dscbase}");
	my @cwd_files = dsc_files("${dir}/${dscbase}");
	foreach (@cwd_files) {
	    if (system ("cp '$_' '$main::chroot_build_dir'")) {
		print PLOG "ERROR: Could not copy $_ to $main::chroot_build_dir \n";
		return 0;
	    }
	    push(@fetched, "${main::chroot_build_dir}/" . basename($_));
	}
    } else {
	my %entries = ();
	my $retried = $conf::apt_update;
      retry:
	print PLOG "Checking available source versions...\n";
	my $command = $session->get_apt_command("$conf::apt_cache", "-q showsrc $pkg", $main::username, 0, '/');
	my $pid = open3(\*main::DEVNULL, \*PIPE, '>&PLOG', "$command" );
	if (!$pid) {
	    print PLOG "Can't open pipe to $conf::apt_cache: $!\n";
	    return 0;
	}
	{
	    local($/) = "";
	    my $package;
	    my $ver;
	    my $tfile;
	    while( <PIPE> ) {
		$package = $1 if /^Package:\s+(\S+)\s*$/mi;
		$ver = $1 if /^Version:\s+(\S+)\s*$/mi;
		$tfile = $1 if /^Files:\s*\n((\s+.*\s*\n)+)/mi;
		if (defined $package && defined $ver && defined $tfile) {
		    @{$entries{"$package $ver"}} = map { (split( /\s+/, $_ ))[3] }
		    split( "\n", $tfile );
		    undef($package);
		    undef($ver);
		    undef($tfile);
		}
	    }

	    if (! scalar keys %entries) {
		print PLOG "$conf::apt_cache returned no information about $pkg source\n";
		print PLOG "Are there any deb-src lines in your /etc/apt/sources.list?\n";
		return 0;

	    }
	}
	close(PIPE);
	waitpid $pid, 0;
	if ($?) {
	    print PLOG "$conf::apt_cache failed\n";
	    return 0;
	}

	if (!defined($entries{"$pkg $version"})) {
	    if (!$retried) {
		# try to update apt's cache if nothing found
		$session->run_apt_command("$conf::apt_get", "update >/dev/null", "root", 0, '/');
		$retried = 1;
		goto retry;
	    }
	    print PLOG "Can't find source for ${pkg}_${version}\n";
	    print PLOG "(only different version(s) ",
	    join( ", ", sort keys %entries), " found)\n"
		if %entries;
	    return 0;
	}

	print PLOG "Fetching source files...\n";
	foreach (@{$entries{"$pkg $version"}}) {
	    push(@fetched, "$main::chroot_build_dir/$_");
	}

	my $command2 = $session->get_apt_command("$conf::apt_get", "--only-source -q -d source $pkg=$version 2>&1 </dev/null", $main::username, 0, undef);
	if (!open( PIPE, "$command2 |" )) {
	    print PLOG "Can't open pipe to $conf::apt_get: $!\n";
	    return 0;
	}
	while( <PIPE> ) {
	    print PLOG $_;
	}
	close( PIPE );
	if ($?) {
	    print PLOG "$conf::apt_get for sources failed\n";
	    return 0;
	}
	# touch the downloaded files, otherwise buildd-watcher will
	# complain that they're old :)
	$$dscfile_ref = (grep { /\.dsc$/ } @fetched)[0];
    }

    if (!open( F, "<${main::chroot_build_dir}/${dscbase}" )) {
	print PLOG "Can't open ${main::chroot_build_dir}/${dscbase}: $!\n";
	return 0;
    }
    my $dsctext;
    my $orig;
    { local($/); $dsctext = <F>; }
    close( F );

    $dsctext =~ /^Build-Depends:\s*((.|\n\s+)*)\s*$/mi
	and $build_depends = $1;
    $dsctext =~ /^Build-Depends-Indep:\s*((.|\n\s+)*)\s*$/mi
	and $build_depends_indep = $1;
    $dsctext =~ /^Build-Conflicts:\s*((.|\n\s+)*)\s*$/mi
	and $build_conflicts = $1;
    $dsctext =~ /^Build-Conflicts-Indep:\s*((.|\n\s+)*)\s*$/mi
	and $build_conflicts_indep = $1;
    $build_depends =~ s/\n\s+/ /g if defined $build_depends;
    $build_depends_indep =~ s/\n\s+/ /g if defined $build_depends_indep;
    $build_conflicts =~ s/\n\s+/ /g if defined $build_conflicts;
    $build_conflicts_indep =~ s/\n\s+/ /g if defined $build_conflicts_indep;

    $dsctext =~ /^Architecture:\s*(.*)$/mi and $dscarchs = $1;

    $dsctext =~ /^Files:\s*\n((\s+.*\s*\n)+)/mi and $files = $1;
    @other_files = map { (split( /\s+/, $_ ))[3] } split( "\n", $files );
    $files =~ /(\Q$pkg\E.*orig.tar.gz)/mi and $orig = $1;

    if (!$dscarchs) {
	print PLOG "$dscbase has no Architecture: field -- skipping arch check!\n";
    }
    else {
	if ($dscarchs ne "any" && $dscarchs !~ /\b$main::arch\b/ &&
	    !($dscarchs eq "all" && $main::build_arch_all) )  {
	    print PLOG "$dscbase: $main::arch not in arch list: $dscarchs -- ".
		"skipping\n";
	    $main::pkg_fail_stage = "arch-check";
	    return 0;
	}
    }
    print "Arch check ok ($main::arch included in $dscarchs)\n"
	if $conf::debug;

    @main::have_dsc_build_deps = ($build_depends, $build_depends_indep,
				  $build_conflicts,$build_conflicts_indep);
    merge_pkg_build_deps( $session, $pkg, $build_depends,
			  $build_depends_indep, $build_conflicts,
			  $build_conflicts_indep );

    return 1;
}

sub build ($$$) {
    my $session = shift;
    my $dsc = shift;
    my $pkgv = shift;
    my( $dir, $rv, $changes );
    local( *PIPE, *F, *F2 );

    fixup_pkgv( $pkgv );
    print PLOG "-"x78, "\n";
    # count build time from now, ignoring the installation of source
    # deps
    $main::pkg_start_time = time;
    $main::this_space = 0;
    $pkgv =~ /^([a-zA-Z\d.+-]+)_([a-zA-Z\d:.+~-]+)/;
    my ($pkg, $version) = ($1,$2);
    (my $sversion = $version) =~ s/^\d+://; # Strip epoch
    my $tmpunpackdir = $dsc;
    $tmpunpackdir =~ s/-.*$/.orig.tmp-nest/;
    $tmpunpackdir =~ s/_/-/;
    $tmpunpackdir = "$main::chroot_build_dir/$tmpunpackdir";

    if (-d "$main::chroot_build_dir/$dsc" && -l "$main::chroot_build_dir/$dsc") {
	# if the package dir already exists but is a symlink, complain
	print PLOG "Cannot unpack source: a symlink to a directory with the\n",
	"same name already exists.\n";
	return 0;
    }
    if (! -d "$main::chroot_build_dir/$dsc") {
	$main::pkg_fail_stage = "unpack";
	# dpkg-source refuses to remove the remanants of an aborted
	# dpkg-source extraction, so we will if necessary.
	if (-d $tmpunpackdir) {
	    system ("rm -fr '$tmpunpackdir'");
	}
	$dir = "$dsc";
	$dir =~ s/\.dsc$//;
	$main::sub_task = "dpkg-source";
	$session->run_command("$conf::dpkg_source -sn -x $dsc $dir 2>&1", $main::username, 1, 0, undef);
	if ($?) {
	    print PLOG "FAILED [dpkg-source died]\n";

	    system ("rm -fr '$tmpunpackdir'") if -d $tmpunpackdir;
	    return 0;
	}
	$dir = "$main::chroot_build_dir/$dir";

	if (system( "chmod -R g-s,go+rX $dir" ) != 0) {
	    print PLOG "chmod -R g-s,go+rX $dir failed.\n";
	    return 0;
	}
    }
    else {
	$dir = "$main::chroot_build_dir/$dsc";

	$main::pkg_fail_stage = "check-unpacked-version";
	# check if the unpacked tree is really the version we need
	$main::sub_pid = open( PIPE, "-|" );
	if (!defined $main::sub_pid) {
	    print PLOG "Can't spawn dpkg-parsechangelog: $!\n";
	    return 0;
	}
	if ($main::sub_pid == 0) {
	    $dir = $session->strip_chroot_path($dir);
	    $session->exec_command("cd '$dir' && dpkg-parsechangelog 2>&1", $main::username, 1, 0, undef);
	}
	$main::sub_task = "dpkg-parsechangelog";

	my $clog = "";
	while( <PIPE> ) {
	    $clog .= $_;
	}
	close( PIPE );
	undef $main::sub_pid;
	if ($?) {
	    print PLOG "FAILED [dpkg-parsechangelog died]\n";
	    return 0;
	}
	if ($clog !~ /^Version:\s*(.+)\s*$/mi) {
	    print PLOG "dpkg-parsechangelog didn't print Version:\n";
	    return 0;
	}
	my $tree_version = $1;
	my $cmp_version = ($main::binNMU && -f "$dir/debian/.sbuild-binNMU-done") ?
	    binNMU_version($version,$main::binNMUver) : $version;
	if ($tree_version ne $cmp_version) {
	    print PLOG "The unpacked source tree $dir is version ".
		"$tree_version, not wanted $cmp_version!\n";
	    return 0;
	}
    }

    $main::pkg_fail_stage = "check-space";
    my $current_usage = `/usr/bin/du -k -s "$dir"`;
    $current_usage =~ /^(\d+)/;
    $current_usage = $1;
    if ($current_usage) {
	my $free = df( "$dir" );
	if ($free < 2*$current_usage) {
	    print PLOG "Disk space is propably not enough for building.\n".
		"(Source needs $current_usage KB, free are $free KB.)\n";
	    # TODO: Only purge in a single place.
	    print PLOG "Purging $main::chroot_build_dir\n";
	    $session->run_command("rm -rf '$main::chroot_build_dir'", "root", 1, 0, '/');
	    return 0;
	}
    }

    $main::pkg_fail_stage = "hack-binNMU";
    if ($main::binNMU && ! -f "$dir/debian/.sbuild-binNMU-done") {
	if (open( F, "<$dir/debian/changelog" )) {
	    my($firstline, $text);
	    $firstline = "";
	    $firstline = <F> while $firstline =~ /^$/;
	    { local($/); undef $/; $text = <F>; }
	    close( F );
	    $firstline =~ /^(\S+)\s+\((\S+)\)\s+([^;]+)\s*;\s*urgency=(\S+)\s*$/;
	    my ($name, $version, $dists, $urgent) = ($1, $2, $3, $4);
	    my $NMUversion = binNMU_version($version,$main::binNMUver);
	    chomp( my $date = `date -R` );
	    if (!open( F, ">$dir/debian/changelog" )) {
		print PLOG "Can't open debian/changelog for binNMU hack: $!\n";
		return 0;
	    }
	    $dists = $main::distribution;
	    print F "$name ($NMUversion) $dists; urgency=low\n\n";
	    print F "  * Binary-only non-maintainer upload for $main::arch; ",
	    "no source changes.\n";
	    print F "  * ", join( "    ", split( "\n", $main::binNMU )), "\n\n";
	    print F " -- $conf::maintainer_name  $date\n\n";

	    print F $firstline, $text;
	    close( F );
	    system "touch '$dir/debian/.sbuild-binNMU-done'";
	    print PLOG "*** Created changelog entry for bin-NMU version $NMUversion\n";
	}
	else {
	    print PLOG "Can't open debian/changelog -- no binNMU hack!\n";
	}
    }

    if (-f "$dir/debian/files") {
	local( *FILES );
	my @lines;
	open( FILES, "<$dir/debian/files" );
	chomp( @lines = <FILES> );
	close( FILES );
	@lines = map { my $ind = 68-length($_);
		       $ind = 0 if $ind < 0;
		       "│ $_".(" " x $ind)." │\n"; } @lines;

	print PLOG <<"EOF";

┌──────────────────────────────────────────────────────────────────────┐
│ sbuild Warning:                                                      │
│ ---------------                                                      │
│ After unpacking, there exists a file debian/files with the contents: │
│                                                                      │
EOF

	print PLOG @lines;
	print PLOG <<"EOF";
│                                                                      │
│ This should be reported as a bug.                                    │
│ The file has been removed to avoid dpkg-genchanges errors.           │
└──────────────────────────────────────────────────────────────────────┘

EOF

	unlink "$dir/debian/files";
    }

    $main::build_start_time = time;
    $main::pkg_fail_stage = "build";
    $main::sub_pid = open( PIPE, "-|" );
    if (!defined $main::sub_pid) {
	print PLOG "Can't spawn dpkg-buildpackage: $!\n";
	return 0;
    }
    if ($main::sub_pid == 0) {
	open( STDIN, "</dev/null" );
	my $binopt = $main::build_source ?
	    $conf::force_orig_source ? "-sa" : "" :
	    $main::build_arch_all ?	"-b" : "-B";

	my $bdir = $session->strip_chroot_path($dir);
	if (-f "$main::chroot_dir/etc/ld.so.conf" &&
	    ! -r "$main::chroot_dir/etc/ld.so.conf") {
	    $session->run_command("chmod a+r /etc/ld.so.conf", "root", 1, 0, '/');
	    print PLOG "ld.so.conf was not readable! Fixed.\n";
	}
	my $buildcmd = "cd $bdir && PATH=$conf::path ".
	    (defined($main::ld_library_path) ?
	     "LD_LIBRARY_PATH=".$main::ld_library_path." " : "").
	     "exec $conf::build_env_cmnd dpkg-buildpackage $conf::pgp_options ".
	     "$binopt $main::dpkg_buildpackage_signopt -r$conf::fakeroot 2>&1";
	$session->exec_command($buildcmd, $main::username, 1, 0, undef);
    }
    $main::sub_task = "dpkg-buildpackage";

    # We must send the signal as root, because some subprocesses of
    # dpkg-buildpackage could run as root. So we have to use a shell
    # command to send the signal... but /bin/kill can't send to
    # process groups :-( So start another Perl :-)
    my $timeout = $conf::individual_stalled_pkg_timeout{$pkg} ||
	$conf::stalled_pkg_timeout;
    $timeout *= 60;
    my $timed_out = 0;
    my(@timeout_times, @timeout_sigs, $last_time);

    local $SIG{'ALRM'} = sub {
	my $signal = ($timed_out > 0) ? "KILL" : "TERM";
	$session->run_command("perl -e \"kill( \\\"$signal\\\", $main::sub_pid )\"", "root", 1, 0, '/');
	$timeout_times[$timed_out] = time - $last_time;
	$timeout_sigs[$timed_out] = $signal;
	$timed_out++;
	$timeout = 5*60; # only wait 5 minutes until next signal
    };

    alarm( $timeout );
    while( <PIPE> ) {
	alarm( $timeout );
	$last_time = time;
	print PLOG $_;
    }
    close( PIPE );
    undef $main::sub_pid;
    alarm( 0 );
    $rv = $?;

    my $i;
    for( $i = 0; $i < $timed_out; ++$i ) {
	print PLOG "Build killed with signal ", $timeout_sigs[$i],
	           " after ", int($timeout_times[$i]/60),
	           " minutes of inactivity\n";
    }
    $main::pkg_end_time = time;
    write_stats('build-time',$main::pkg_end_time-$main::build_start_time);
    my $date = strftime("%Y%m%d-%H%M",localtime($main::pkg_end_time));
    print PLOG "*"x78, "\n";
    print PLOG "Build finished at $date\n";

    my @space_files = ("$dir");
    if ($rv) {
	print PLOG "FAILED [dpkg-buildpackage died]\n";
    }
    else {
	if (-r "$dir/debian/files" && $main::chroot_build_dir) {
	    my @files = debian_files_list("$dir/debian/files");

	    foreach (@files) {
		if (! -f "$main::chroot_build_dir/$_") {
		    print PLOG "ERROR: Package claims to have built ".basename($_).", but did not.  This is a bug in the packaging.\n";
		    next;
		}
		if (/_all.u?deb$/ and not $main::build_arch_all) {
		    print PLOG "ERROR: Package builds ".basename($_)." when binary-indep target is not called.  This is a bug in the packaging.\n";
		    unlink("$main::chroot_build_dir/$_");
		    next;
		}
	    }
	}

	$changes = "${pkg}_".
	    ($main::binNMU ? binNMU_version($sversion,$main::binNMUver) : $sversion).
	    "_$main::arch.changes";
	my @cfiles;
	if (-r "$main::chroot_build_dir/$changes") {
	    my(@do_dists, @saved_dists);
	    print PLOG "\n$changes:\n";
	    open( F, "<$main::chroot_build_dir/$changes" );
	    if (open( F2, ">$changes.new" )) {
		while( <F> ) {
		    if (/^Distribution:\s*(.*)\s*$/ and $main::override_distribution) {
			print PLOG "Distribution: $main::distribution\n";
			print F2 "Distribution: $main::distribution\n";
		    }
		    else {
			print F2 $_;
			while (length $_ > 989)
			{
			    my $index = rindex($_,' ',989);
			    print PLOG substr ($_,0,$index) . "\n";
			    $_ = '        ' . substr ($_,$index+1);
			}
			print PLOG $_;
			if (/^ [a-z0-9]{32}/) {
			    push(@cfiles, (split( /\s+/, $_ ))[5] );
			}
		    }
		}
		close( F2 );
		rename( "$changes.new", "$changes" )
		    or print PLOG "$changes.new could not be renamed ".
		    "to $changes: $!\n";
		unlink( "$main::chroot_build_dir/$changes" )
		    if $main::chroot_build_dir;
	    }
	    else {
		print PLOG "Cannot create $changes.new: $!\n";
		print PLOG "Distribution field may be wrong!!!\n";
		if ($main::chroot_build_dir) {
		    system "mv", "-f", "$main::chroot_build_dir/$changes", "."
			and print PLOG "ERROR: Could not move ".basename($_)." to .\n";
		}
	    }
	    close( F );
	}
	else {
	    print PLOG "Can't find $changes -- can't dump info\n";
	}

	my @debcfiles = @cfiles;
	foreach (@debcfiles) {
	    my $deb = "$main::chroot_build_dir/$_";
	    next if $deb !~ /($main::arch|all)\.[\w\d.-]*$/;

	    print PLOG "\n$deb:\n";
	    if (!open( PIPE, "dpkg --info $deb 2>&1 |" )) {
		print PLOG "Can't spawn dpkg: $! -- can't dump info\n";
	    }
	    else {
		print PLOG $_ while( <PIPE> );
		close( PIPE );
	    }
	}

	@debcfiles = @cfiles;
	foreach (@debcfiles) {
	    my $deb = "$main::chroot_build_dir/$_";
	    next if $deb !~ /($main::arch|all)\.[\w\d.-]*$/;

	    print PLOG "\n$deb:\n";
	    if (!open( PIPE, "dpkg --contents $deb 2>&1 |" )) {
		print PLOG "Can't spawn dpkg: $! -- can't dump info\n";
	    }
	    else {
		print PLOG $_ while( <PIPE> );
		close( PIPE );
	    }
	}

	foreach (@cfiles) {
	    push( @space_files, $_ );
	    system "mv", "-f", "$main::chroot_build_dir/$_", "."
		and print PLOG "ERROR: Could not move $_ to .\n";
	}
	print PLOG "\n";
	print PLOG "*"x78, "\n";
	print PLOG "Built successfully\n";
    }

    check_watches($session);
    check_space($session, @space_files);

    if ($conf::purge_build_directory eq "always" ||
	($conf::purge_build_directory eq "successful" && $rv == 0)) {
	print PLOG "Purging $main::chroot_build_dir\n";
	my $bdir = $session->strip_chroot_path($main::chroot_build_dir);
	$session->run_command("rm -rf '$bdir'", "root", 1, 0, '/');
    }

    print PLOG "-"x78, "\n";
    return $rv == 0 ? 1 : 0;
}

sub analyze_fail_stage ($) {
    my $pkgv = shift;

    return if $main::pkg_status ne "failed";
    return if !$main::auto_giveback;
    if (isin( $main::pkg_fail_stage,
	      qw(find-dsc fetch-src unpack-check check-space install-deps-env))) {
	$main::pkg_status = "given-back";
	print PLOG "Giving back package $pkgv after failure in ".
	    "$main::pkg_fail_stage stage.\n";
	my $cmd = "";
	$cmd = "ssh -l$main::auto_giveback_user $main::auto_giveback_host "
	    if $main::auto_giveback_host;
	$cmd .= "-S $main::auto_giveback_socket "
	    if $main::auto_giveback_socket;
	$cmd .= "wanna-build --give-back --no-down-propagation ".
	    "--dist=$main::distribution";
	$cmd .= " --database=$main::database" if $main::database;
	$cmd .= " --user=$main::auto_giveback_wb_user "
	    if $main::auto_giveback_wb_user;
	$cmd .= " $pkgv";
	system $cmd;
	if ($?) {
	    print PLOG "wanna-build failed with status $?\n";
	}
	else {
	    add_givenback( $pkgv, time );
	    write_stats('give-back',1);
	}
    }
}

sub install_deps ($$) {
    my $session = shift;
    my $pkg = shift;
    my( @positive, @negative, @instd, @rmvd );

    my $dep = [];
    if (exists $main::deps{$pkg}) {
	$dep = $main::deps{$pkg};
    }
    if ($conf::debug) {
	print "Source dependencies of $pkg: ", format_deps(@$dep), "\n";
    }

  repeat:
    lock_file( "$main::ilock_file", 1 );

    print "Filtering dependencies\n" if $conf::debug;
    if (!filter_dependencies($session, @$dep, @positive, @negative )) {
	print PLOG "Package installation not possible\n";
	unlock_file( "$main::ilock_file" );
	return 0;
    }

    print PLOG "Checking for source dependency conflicts...\n";
    if (!run_apt($session, "-s", @instd, @rmvd, @positive)) {
	print PLOG "Test what should be installed failed.\n";
	unlock_file( "$main::ilock_file" );
	return 0;
    }
    # add negative deps as to be removed for checking srcdep conflicts
    push( @rmvd, @negative );
    my @confl;
    if (@confl = check_srcdep_conflicts( @instd, @rmvd )) {
	print PLOG "Waiting for job(s) @confl to finish\n";

	unlock_file( "$main::ilock_file" );
	wait_for_srcdep_conflicts( @confl );
	goto repeat;
    }

    write_srcdep_lock_file( @$dep );

    my $install_start_time = time;
    print "Installing positive dependencies: @positive\n" if $conf::debug;
    if (!run_apt($session, "-y", @instd, @rmvd, @positive)) {
	print PLOG "Package installation failed\n";
	# try to reinstall removed packages
	print PLOG "Trying to reinstall removed packages:\n";
	print "Reinstalling removed packages: @rmvd\n" if $conf::debug;
	my (@instd2, @rmvd2);
	print PLOG "Failed to reinstall removed packages!\n"
	    if !run_apt($session, "-y", @instd2, @rmvd2, @rmvd);
	print "Installed were: @instd2\n" if $conf::debug;
	print "Removed were: @rmvd2\n" if $conf::debug;
	# remove additional packages
	print PLOG "Trying to uninstall newly installed packages:\n";
	uninstall_debs($session,
		       $main::chroot_dir ? "purge" : "remove",
		       @instd);
	unlock_file( "$main::ilock_file" );
	return 0;
    }
    set_installed( @instd );
    set_removed( @rmvd );

    print "Removing negative dependencies: @negative\n" if $conf::debug;
    if (!uninstall_debs($session,
			$main::chroot_dir ? "purge" : "remove",
			@negative)) {
	print PLOG "Removal of packages failed\n";
	unlock_file( "$main::ilock_file" );
	return 0;
    }
    set_removed( @negative );
    my $install_stop_time = time;
    write_stats( 'install-download-time',
		 $install_stop_time - $install_start_time );

    my $fail = check_dependencies( @$dep );
    if ($fail) {
	print PLOG "After installing, the following source dependencies are ".
	    "still unsatisfied:\n$fail\n";
	unlock_file( "$main::ilock_file" );
	return 0;
    }

    local (*F);

    my $command = $session->get_command("$conf::dpkg --set-selections", "root", 1, 0, '/');

    my $success = open( F, "| $command");

    if ($success) {
	foreach my $tpkg (@instd) {
	    print F $tpkg . " purge\n";
	}
	close( F );
	if ($?) {
	    print PLOG "$conf::dpkg --set-selections failed\n";
	}
    }

    unlock_file( "$main::ilock_file" );

    prepare_watches( @$dep, @instd );
    return 1;
}

sub wait_for_srcdep_conflicts (@) {
    my @confl = @_;

    for(;;) {
	sleep( $conf::srcdep_lock_wait*60 );
	my $allgone = 1;
	for (@confl) {
	    /^(\d+)-(\d+)$/;
	    my $pid = $1;
	    if (-f "$main::srcdep_lock_dir/$_") {
		if (kill( 0, $pid ) == 0 && $! == ESRCH) {
		    print PLOG "Ignoring stale src-dep lock $_\n";
		    unlink( "$main::srcdep_lock_dir/$_" ) or
			print PLOG "Cannot remove $main::srcdep_lock_dir/$_: $!\n";
		}
		else {
		    $allgone = 0;
		    last;
		}
	    }
	}
	last if $allgone;
    }
}

sub uninstall_deps ($) {
    my $session = shift;

    my( @pkgs, @instd, @rmvd );

    lock_file( "$main::ilock_file", 1 );

    @pkgs = keys %{$main::changes->{'removed'}};
    print "Reinstalling removed packages: @pkgs\n" if $conf::debug;
    print PLOG "Failed to reinstall removed packages!\n"
	if !run_apt($session, "-y", @instd, @rmvd, @pkgs);
    print "Installed were: @instd\n" if $conf::debug;
    print "Removed were: @rmvd\n" if $conf::debug;
    unset_removed( @instd );
    unset_installed( @rmvd );

    @pkgs = keys %{$main::changes->{'installed'}};
    print "Removing installed packages: @pkgs\n" if $conf::debug;
    print PLOG "Failed to remove installed packages!\n"
	if !uninstall_debs($session, "purge", @pkgs);
    unset_installed( @pkgs );

    unlock_file( "$main::ilock_file" );
}

sub uninstall_debs ($$@) {
    my $session = shift;
    my $mode = shift;
    local (*PIPE);
    local (%ENV) = %ENV; # make local environment hardwire frontend
			 # for debconf to non-interactive
    $ENV{'DEBIAN_FRONTEND'} = "noninteractive";

    return 1 if !@_;
    print "Uninstalling packages: @_\n" if $conf::debug;

    my $command = $session->get_command("$conf::dpkg --$mode @_ 2>&1 </dev/null", "root", 1, 0, '/');
  repeat:
    my $output;
    my $remove_start_time = time;

    if (!open( PIPE, "$command |")) {
	print PLOG "Can't open pipe to dpkg: $!\n";
	return 0;
    }
    while ( <PIPE> ) {
	$output .= $_;
	print PLOG $_;
    }
    close( PIPE );

    if ($output =~ /status database area is locked/mi) {
	print PLOG "Another dpkg is running -- retrying later\n";
	$output = "";
	sleep( 2*60 );
	goto repeat;
    }
    my $remove_end_time = time;
    write_stats( "remove-time", $remove_end_time - $remove_start_time );
    print PLOG "dpkg run to remove packages (@_) failed!\n" if $?;
    return $? == 0;
}

sub run_apt ($$\@\@@) {
    my $session = shift;
    my $mode = shift;
    my $inst_ret = shift;
    my $rem_ret = shift;
    my @to_install = @_;
    my( $msgs, $status, $pkgs, $rpkgs );
    local (*PIPE);
    local (%ENV) = %ENV; # make local environment hardwire frontend
			 # for debconf to non-interactive
    $ENV{'DEBIAN_FRONTEND'} = "noninteractive";

    @$inst_ret = ();
    @$rem_ret = ();
    return 1 if !@to_install;
  repeat:

    $msgs = "";
    # redirection of stdin from /dev/null so that conffile question
    # are treated as if RETURN was pressed.
    # dpkg since 1.4.1.18 issues an error on the conffile question if
    # it reads EOF -- hardwire the new --force-confold option to avoid
    # the questions.
    my $command =
	$session->get_apt_command("$conf::apt_get", "--purge ".
				  "-o DPkg::Options::=--force-confold ".
				  "-q $mode install @to_install ".
				  "2>&1 </dev/null", "root", 0, '/');

    if (!open( PIPE, "$command |" )) {
	print PLOG "Can't open pipe to apt-get: $!\n";
	return 0;
    }
    while( <PIPE> ) {
	$msgs .= $_;
	print PLOG $_ if $mode ne "-s" || $conf::debug;
    }
    close( PIPE );
    $status = $?;

    if ($status != 0 && $msgs =~ /^E: Packages file \S+ (has changed|is out of sync)/mi) {
	my $command =
	    $session->get_apt_command("$conf::apt_get", "-q update 2>&1",
				      "root", 1, '/');
	if (!open( PIPE, "$command |" )) {
	    print PLOG "Can't open pipe to apt-get: $!\n";
	    return 0;
	}

	$msgs = "";
	while( <PIPE> ) {
	    $msgs .= $_;
	    print PLOG $_;
	}
	close( PIPE );
	print PLOG "apt-get update failed\n" if $?;
	$msgs = "";
	goto repeat;
    }

    if ($status != 0 && $msgs =~ /^Package (\S+) is a virtual package provided by:\n((^\s.*\n)*)/mi) {
	my $to_replace = $1;
	my @providers;
	foreach (split( "\n", $2 )) {
	    s/^\s*//;
	    push( @providers, (split( /\s+/, $_ ))[0] );
	}
	print PLOG "$to_replace is a virtual package provided by: @providers\n";
	my $selected;
	if (@providers == 1) {
	    $selected = $providers[0];
	    print PLOG "Using $selected (only possibility)\n";
	}
	elsif (exists $conf::alternatives{$to_replace}) {
	    $selected = $conf::alternatives{$to_replace};
	    print PLOG "Using $selected (selected in sbuildrc)\n";
	}
	else {
	    $selected = $providers[0];
	    print PLOG "Using $selected (no default, using first one)\n";
	}

	@to_install = grep { $_ ne $to_replace } @to_install;
	push( @to_install, $selected );

	goto repeat;
    }

    if ($status != 0 && ($msgs =~ /^E: Could( not get lock|n.t lock)/mi ||
			 $msgs =~ /^dpkg: status database area is locked/mi)) {
	print PLOG "Another apt-get or dpkg is running -- retrying later\n";
	sleep( 2*60 );
	goto repeat;
    }

    # check for errors that are probably caused by something broken in
    # the build environment, and give back the packages.
    if ($status != 0 && $mode ne "-s" &&
	(($msgs =~ /^E: dpkg was interrupted, you must manually run 'dpkg --configure -a' to correct the problem./mi) ||
	 ($msgs =~ /^dpkg: parse error, in file `\/.+\/var\/lib\/dpkg\/(?:available|status)' near line/mi) ||
	 ($msgs =~ /^E: Unmet dependencies. Try 'apt-get -f install' with no packages \(or specify a solution\)\./mi))) {
	print PLOG "Build environment unusable, giving back\n";
	$main::pkg_fail_stage = "install-deps-env";
    }

    if ($status != 0 && $mode ne "-s" &&
	(($msgs =~ /^E: Unable to fetch some archives, maybe run apt-get update or try with/mi))) {
	print PLOG "Unable to fetch build-depends\n";
	$main::pkg_fail_stage = "install-deps-env";
    }

    if ($status != 0 && $mode ne "-s" &&
	(($msgs =~ /^W: Couldn't stat source package list /mi))) {
	print PLOG "Missing a packages file (mismatch with Release.gpg?), giving back.\n";
	$main::pkg_fail_stage = "install-deps-env";
    }

    $pkgs = $rpkgs = "";
    if ($msgs =~ /NEW packages will be installed:\n((^[ 	].*\n)*)/mi) {
	($pkgs = $1) =~ s/^[ 	]*((.|\n)*)\s*$/$1/m;
	$pkgs =~ s/\*//g;
    }
    if ($msgs =~ /packages will be REMOVED:\n((^[ 	].*\n)*)/mi) {
	($rpkgs = $1) =~ s/^[ 	]*((.|\n)*)\s*$/$1/m;
	$rpkgs =~ s/\*//g;
    }
    @$inst_ret = split( /\s+/, $pkgs );
    @$rem_ret = split( /\s+/, $rpkgs );

    print PLOG "apt-get failed.\n" if $status && $mode ne "-s";
    return $mode eq "-s" || $status == 0;
}

sub filter_dependencies ($\@\@\@) {
    my $session = shift;
    my $dependencies = shift;
    my $pos_list = shift;
    my $neg_list = shift;
    my($dep, $d, $name, %names);

    print PLOG "Checking for already installed source dependencies...\n";

    @$pos_list = @$neg_list = ();
    foreach $d (@$dependencies) {
	my $name = $d->{'Package'};
	$names{$name} = 1 if $name !~ /^\*/;
	foreach (@{$d->{'Alternatives'}}) {
	    my $name = $_->{'Package'};
	    $names{$name} = 1 if $name !~ /^\*/;
	}
    }
    my $status = get_dpkg_status( keys %names );

    my %policy;
    if ($conf::apt_policy) {
	%policy = get_apt_policy( $session, keys %names );
    }

    foreach $dep (@$dependencies) {
	$name = $dep->{'Package'};
	next if !$name;

	my $stat = $status->{$name};
	if ($dep->{'Neg'}) {
	    if ($stat->{'Installed'}) {
		my ($rel, $vers) = ($dep->{'Rel'}, $dep->{'Version'});
		my $ivers = $stat->{'Version'};
		if (!$rel || version_compare( $ivers, $rel, $vers )){
		    print "$name: neg dep, installed, not versioned or ",
		          "version relation satisfied --> remove\n"
			      if $conf::debug;
		    print PLOG "$name: installed (negative dependency)";
		    print PLOG " (bad version $ivers $rel $vers)"
			if $rel;
		    print PLOG "\n";
		    push( @$neg_list, $name );
		}
		else {
		    print PLOG "$name: installed (negative dependency)",
		    "(but version ok $ivers $rel $vers)\n";
		}
	    }
	    else {
		print "$name: neg dep, not installed\n" if $conf::debug;
		print PLOG "$name: already deinstalled\n";
	    }
	    next;
	}

	my $is_satisfied = 0;
	my $installable = "";
	my $upgradeable = "";
	foreach $d ($dep, @{$dep->{'Alternatives'}}) {
	    my ($name, $rel, $vers) =
		($d->{'Package'}, $d->{'Rel'}, $d->{'Version'});
	    my $stat = $status->{$name};
	    if (!$stat->{'Installed'}) {
		print "$name: pos dep, not installed\n" if $conf::debug;
		print PLOG "$name: missing\n";
		if ($conf::apt_policy && $rel) {
		    if (!version_compare($policy{$name}->{defversion}, $rel, $vers)) {
			print PLOG "Default version of $name not sufficient, ";
			foreach my $cvers (@{$policy{$name}->{versions}}) {
			    if (version_compare($cvers, $rel, $vers)) {
				print PLOG "using version $cvers\n";
				$installable = $name . "=" . $cvers if !$installable;
				last;
			    }
			}
			if(!$installable) {
			    print PLOG "no suitable version found. Skipping for now, maybe there are alternatives.\n";
			    next if ($conf::check_depends_algorithm eq "alternatives");
			}
		    } else {
			print PLOG "Using default version " . $policy{$name}->{defversion} . "\n";
		    }
		}
		$installable = $name if !$installable;
		next;
	    }
	    my $ivers = $stat->{'Version'};
	    if (!$rel || version_compare( $ivers, $rel, $vers )) {
		print "$name: pos dep, installed, no versioned dep or ",
		"version ok\n" if $conf::debug;
		print PLOG "$name: already installed ($ivers";
		print PLOG " $rel $vers is satisfied"
		    if $rel;
		print PLOG ")\n";
		$is_satisfied = 1;
		last;
	    }
	    print "$name: vers dep, installed $ivers ! $rel $vers\n"
		if $conf::debug;
	    print PLOG "$name: non-matching version installed ",
	    "($ivers ! $rel $vers)\n";
	    if ($rel =~ /^</ ||
		($rel eq '=' && version_compare($ivers, '>>', $vers))) {
		print "$name: would be a downgrade!\n" if $conf::debug;
		print PLOG "$name: would have to downgrade!\n";
	    }
	    else {
		if ($conf::apt_policy && !version_compare($policy{$name}->{defversion}, $rel, $vers)) {
		    print PLOG "Default version of $name not sufficient, ";
		    foreach my $cvers (@{$policy{$name}->{versions}}) {
			if(version_compare($cvers, $rel, $vers)) {
			    print PLOG "using version $cvers\n";
			    $upgradeable = $name if ! $upgradeable;
			    last;
			}
		    }
		    print PLOG "no suitable alternative found. I probably should dep-wait this one.\n" if !$upgradeable;
		    return 0;
		} else {
		    print PLOG "Using default version " . $policy{$name}->{defversion} . "\n";
		}
		$upgradeable = $name if !$upgradeable;
	    }
	}
	if (!$is_satisfied) {
	    if ($upgradeable) {
		print "using $upgradeable for upgrade\n" if $conf::debug;
		push( @$pos_list, $upgradeable );
	    }
	    elsif ($installable) {
		print "using $installable for install\n" if $conf::debug;
		push( @$pos_list, $installable );
	    }
	    else {
		print PLOG "This dependency could not be satisfied. Possible reasons:\n";
		print PLOG "* The package has a versioned dependency that is not yet available.\n";
		print PLOG "* The package has a versioned dependency on a package version that is\n  older than the currently-installed package. Downgrades are not implemented.\n";
		return 0;
	    }
	}
    }

    return 1;
}

sub check_dependencies (\@) {
    my $dependencies = shift;
    my $fail = "";
    my($dep, $d, $name, %names);

    print PLOG "Checking correctness of source dependencies...\n";

    foreach $d (@$dependencies) {
	my $name = $d->{'Package'};
	$names{$name} = 1 if $name !~ /^\*/;
	foreach (@{$d->{'Alternatives'}}) {
	    my $name = $_->{'Package'};
	    $names{$name} = 1 if $name !~ /^\*/;
	}
    }
    foreach $name (@main::toolchain_pkgs) {
	$names{$name} = 1;
    }
    my $status = get_dpkg_status( keys %names );

    foreach $dep (@$dependencies) {
	$name = $dep->{'Package'};
	next if $name =~ /^\*/;
	my $stat = $status->{$name};
	if ($dep->{'Neg'}) {
	    if ($stat->{'Installed'}) {
		if (!$dep->{'Rel'}) {
		    $fail .= "$name(still installed) ";
		}
		elsif (version_compare($stat->{'Version'}, $dep->{'Rel'},
				       $dep->{'Version'})) {
		    $fail .= "$name(inst $stat->{'Version'} $dep->{'Rel'} ".
			"conflicted $dep->{'Version'})\n";
		}
	    }
	}
	else {
	    my $is_satisfied = 0;
	    my $f = "";
	    foreach $d ($dep, @{$dep->{'Alternatives'}}) {
		my $name = $d->{'Package'};
		my $stat = $status->{$name};
		if (!$stat->{'Installed'}) {
		    $f =~ s/ $/\|/ if $f;
		    $f .= "$name(missing) ";
		}
		elsif ($d->{'Rel'} &&
		       !version_compare( $stat->{'Version'}, $d->{'Rel'},
					 $d->{'Version'} )) {
		    $f =~ s/ $/\|/ if $f;
		    $f .= "$name(inst $stat->{'Version'} ! $d->{'Rel'} ".
			"wanted $d->{'Version'}) ";
		}
		else {
		    $is_satisfied = 1;
		}
	    }
	    if (!$is_satisfied) {
		$fail .= $f;
	    }
	}
    }
    $fail =~ s/\s+$//;
    if (!$fail && @main::toolchain_pkgs) {
	my ($sysname, $nodename, $release, $version, $machine) = uname();
	print PLOG "Kernel: $sysname $release $main::arch ($machine)\n";
	print PLOG "Toolchain package versions:";
	foreach $name (@main::toolchain_pkgs) {
	    if (defined($status->{$name}->{'Version'})) {
		print PLOG ' ' . $name . '_' . $status->{$name}->{'Version'};
	    } else {
		print PLOG ' ' . $name . '_' . ' =*=NOT INSTALLED=*=';

	    }
	}
	print PLOG "\n";
    }

    return $fail;
}

sub get_apt_policy ($@) {
    my $session = shift;
    my @interest = @_;
    my $package;
    my %packages;

    $ENV{LC_ALL}='C';

    my $command =
	$session->get_apt_command("$conf::apt_cache",
				  "policy @interest",
				  $main::username, 0, '/');

    my $pid = open3(\*main::DEVNULL, \*APTCACHE, '>&PLOG', "$command" );
    if (!$pid) {
	die "Cannot start $conf::apt_cache $!\n";
    }
    while(<APTCACHE>) {
	$package=$1 if /^([0-9a-z+.-]+):$/;
	$packages{$package}->{curversion}=$1 if /^ {2}Installed: ([0-9a-zA-Z-.:~+]*)$/;
	$packages{$package}->{defversion}=$1 if /^ {2}Candidate: ([0-9a-zA-Z-.:~+]*)$/;
	push @{$packages{$package}->{versions}}, "$2" if /^ (\*{3}| {3}) ([0-9a-zA-Z-.:~+]*) 0$/;
    }
    close(APTCACHE);
    waitpid $pid, 0;
    die "$conf::apt_cache exit status $?\n" if $?;

    return %packages;
}

sub get_dpkg_status (@) {
    my @interest = @_;
    my %result;
    local( *STATUS );

    return () if !@_;
    print "Requesting dpkg status for packages: @interest\n"
	if $conf::debug;
    if (!open( STATUS, "<$main::chroot_dir/var/lib/dpkg/status" )) {
	print PLOG "Can't open $main::chroot_dir/var/lib/dpkg/status: $!\n";
	return ();
    }
    local( $/ ) = "";
    while( <STATUS> ) {
	my( $pkg, $status, $version, $provides );
	/^Package:\s*(.*)\s*$/mi and $pkg = $1;
	/^Status:\s*(.*)\s*$/mi and $status = $1;
	/^Version:\s*(.*)\s*$/mi and $version = $1;
	/^Provides:\s*(.*)\s*$/mi and $provides = $1;
	if (!$pkg) {
	    print PLOG "sbuild: parse error in $main::chroot_dir/var/lib/dpkg/status: ",
	    "no Package: field\n";
	    next;
	}
	if (defined($version)) {
	    print "$pkg ($version) status: $status\n" if $conf::debug >= 2;
	} else {
	    print "$pkg status: $status\n" if $conf::debug >= 2;
	}
	if (!$status) {
	    print PLOG "sbuild: parse error in $main::chroot_dir/var/lib/dpkg/status: ",
	    "no Status: field for package $pkg\n";
	    next;
	}
	if ($status !~ /\sinstalled$/) {
	    $result{$pkg}->{'Installed'} = 0
		if !(exists($result{$pkg}) &&
		     $result{$pkg}->{'Version'} eq '=*=PROVIDED=*=');
	    next;
	}
	if (!defined $version || $version eq "") {
	    print PLOG "sbuild: parse error in $main::chroot_dir/var/lib/dpkg/status: ",
	    "no Version: field for package $pkg\n";
	    next;
	}
	$result{$pkg} = { Installed => 1, Version => $version }
	if isin( $pkg, @interest );
	if ($provides) {
	    foreach (split( /\s*,\s*/, $provides )) {
		$result{$_} = { Installed => 1, Version => '=*=PROVIDED=*=' }
		if isin( $_, @interest ) and (not exists($result{$_}) or
					      ($result{$_}->{'Installed'} == 0));
	    }
	}
    }
    close( STATUS );
    return \%result;
}

sub copy ($) {
    my $r = shift;
    my $new;

    if (ref($r) eq "HASH") {
	$new = { };
	foreach (keys %$r) {
	    $new->{$_} = copy($r->{$_});
	}
    }
    elsif (ref($r) eq "ARRAY") {
	my $i;
	$new = [ ];
	for( $i = 0; $i < @$r; ++$i ) {
	    $new->[$i] = copy($r->[$i]);
	}
    }
    elsif (!ref($r)) {
	$new = $r;
    }
    else {
	die "unknown ref type in copy\n";
    }

    return $new;
}

sub merge_pkg_build_deps ($$$$$$) {
    my $session = shift;
    my $pkg = shift;
    my $depends = shift;
    my $dependsi = shift;
    my $conflicts = shift;
    my $conflictsi = shift;
    my (@l, $dep);

    print PLOG "** Using build dependencies supplied by package:\n";
    print PLOG "Build-Depends: $depends\n" if $depends;
    print PLOG "Build-Depends-Indep: $dependsi\n" if $dependsi;
    print PLOG "Build-Conflicts: $conflicts\n" if $conflicts;
    print PLOG "Build-Conflicts-Indep: $conflictsi\n" if $conflictsi;

    my $old_deps = copy($main::deps{$pkg});

    # Add gcc-snapshot as an override.
    if ( $main::useSNAP ) {
	$dep->{'Package'} = "gcc-snapshot";
	$dep->{'Override'} = 1;
	push( @{$main::deps{$pkg}}, $dep );
    }

    foreach $dep (@{$main::deps{$pkg}}) {
	if ($dep->{'Override'}) {
	    print PLOG "Added override: ",
	    (map { ($_->{'Neg'} ? "!" : "") .
		       $_->{'Package'} .
		       ($_->{'Rel'} ? " ($_->{'Rel'} $_->{'Version'})":"") }
	     scalar($dep), @{$dep->{'Alternatives'}}), "\n";
	    push( @l, $dep );
	}
    }

    $conflicts = join( ", ", map { "!$_" } split( /\s*,\s*/, $conflicts ));
    $conflictsi = join( ", ", map { "!$_" } split( /\s*,\s*/, $conflictsi ));

    my $deps = $depends . ", " . $conflicts;
    $deps .= ", " . $dependsi . ", " . $conflictsi if $main::build_arch_all;
    @{$main::deps{$pkg}} = @l;
    print "Merging pkg deps: $deps\n" if $conf::debug;
    parse_one_srcdep( $pkg, $deps, %main::deps );

    my $missing = (cmp_dep_lists( @$old_deps, @{$main::deps{$pkg}} ))[1];

    # read list of build-essential packages (if not yet done) and
    # expand their dependencies (those are implicitly essential)
    if (!defined($main::deps{'ESSENTIAL'})) {
	my $ess = read_build_essential();
	parse_one_srcdep( 'ESSENTIAL', $ess, %main::deps );
    }
    my ($exp_essential, $exp_pkgdeps, $filt_essential, $filt_pkgdeps);
    $exp_essential = expand_dependencies($session, @{$main::deps{'ESSENTIAL'}} );
    print "Dependency-expanded build essential packages:\n",
    format_deps(@$exp_essential), "\n" if $conf::debug;

    # populate toolchain_pkgs from toolchain_regexes and
    # build-essential packages.
    @main::toolchain_pkgs = ();
    foreach my $tpkg (@$exp_essential) {
        foreach my $regex (@conf::toolchain_regex) {
	    push @main::toolchain_pkgs,$tpkg->{'Package'}
	        if $tpkg->{'Package'} =~ m,^$regex,;
	}
    }

    return if !@$missing;

    # remove missing essential deps
    ($filt_essential, $missing) = cmp_dep_lists( @$missing, @$exp_essential );
    print PLOG "** Filtered missing build-essential deps:\n",
	       format_deps(@$filt_essential), "\n"
	           if @$filt_essential;

    # if some build deps are virtual packages, replace them by an
    # alternative over all providing packages
    $exp_pkgdeps = expand_virtuals($session, @{$main::deps{$pkg}} );
    print "Provided-expanded build deps:\n",
	  format_deps(@$exp_pkgdeps), "\n" if $conf::debug;

    # now expand dependencies of package build deps
    $exp_pkgdeps = expand_dependencies($session, @$exp_pkgdeps );
    print "Dependency-expanded build deps:\n",
	  format_deps(@$exp_pkgdeps), "\n" if $conf::debug;
    $main::additional_deps = $exp_pkgdeps;

    # remove missing essential deps that are dependencies of build
    # deps
    ($filt_pkgdeps, $missing) = cmp_dep_lists( @$missing, @$exp_pkgdeps );
    print PLOG "** Filtered missing build-essential deps that are dependencies of ",
	       "or provide build-deps:\n",
	       format_deps(@$filt_pkgdeps), "\n"
	           if @$filt_pkgdeps;

    # remove comment package names
    push( @$main::additional_deps,
	  grep { $_->{'Neg'} && $_->{'Package'} =~ /^needs-no-/ } @$missing );
    $missing = [ grep { !($_->{'Neg'} &&
	                ($_->{'Package'} =~ /^this-package-does-not-exist/ ||
	                 $_->{'Package'} =~ /^needs-no-/)) } @$missing ];

    print PLOG "**** Warning:\n",
	       "**** The following src deps are ",
	       "(probably) missing:\n  ", format_deps(@$missing), "\n"
	           if @$missing;
}

sub cmp_dep_lists (\@\@) {
    my $list1 = shift;
    my $list2 = shift;
    my ($dep, @common, @missing);

    foreach $dep (@$list1) {
	my $found = 0;

	if ($dep->{'Neg'}) {
	    foreach (@$list2) {
		if ($dep->{'Package'} eq $_->{'Package'} && $_->{'Neg'}) {
		    $found = 1;
		    last;
		}
	    }
	}
	else {
	    my $al = get_altlist($dep);
	    foreach (@$list2) {
		if (is_superset( %{get_altlist($_)}, %$al )) {
		    $found = 1;
		    last;
		}
	    }
	}

	if ($found) {
	    push( @common, $dep );
	}
	else {
	    push( @missing, $dep );
	}
    }
    return (\@common, \@missing);
}

sub get_altlist ($) {
    my $dep = shift;
    my %l;

    foreach (scalar($dep), @{$dep->{'Alternatives'}}) {
	$l{$_->{'Package'}} = 1 if !$_->{'Neg'};
    }
    return \%l;
}

sub is_superset (\%\%) {
    my $l1 = shift;
    my $l2 = shift;

    foreach (keys %$l2) {
	return 0 if !exists $l1->{$_};
    }
    return 1;
}

sub read_build_essential () {
    my @essential;
    local (*F);

    if (open( F, "$main::chroot_dir/usr/share/doc/build-essential/essential-packages-list" )) {
	while( <F> ) {
	    last if $_ eq "\n";
	}
	while( <F> ) {
	    chomp;
	    push( @essential, $_ ) if $_ !~ /^\s*$/;
	}
	close( F );
    }
    else {
	warn "Cannot open $main::chroot_dir/usr/share/doc/build-essential/essential-packages-list: $!\n";
    }

    if (open( F, "$main::chroot_dir/usr/share/doc/build-essential/list" )) {
	while( <F> ) {
	    last if $_ eq "BEGIN LIST OF PACKAGES\n";
	}
	while( <F> ) {
	    chomp;
	    last if $_ eq "END LIST OF PACKAGES";
	    next if /^\s/ || /^$/;
	    push( @essential, $_ );
	}
	close( F );
    }
    else {
	warn "Cannot open $main::chroot_dir/usr/share/doc/build-essential/list: $!\n";
    }

    return join( ", ", @essential );
}

sub expand_dependencies ($\@) {
    my $session = shift;
    my $dlist = shift;
    my (@to_check, @result, %seen, $check, $dep);

    foreach $dep (@$dlist) {
	next if $dep->{'Neg'} || $dep->{'Package'} =~ /^\*/;
	foreach (scalar($dep), @{$dep->{'Alternatives'}}) {
	    my $name = $_->{'Package'};
	    push( @to_check, $name );
	    $seen{$name} = 1;
	}
	push( @result, copy($dep) );
    }

    while( @to_check ) {
	my $deps = get_dependencies($session, @to_check );
	my @check = @to_check;
	@to_check = ();
	foreach $check (@check) {
	    if (defined($deps->{$check})) {
		foreach (split( /\s*,\s*/, $deps->{$check} )) {
		    foreach (split( /\s*\|\s*/, $_ )) {
			my $pkg = (/^([^\s([]+)/)[0];
			if (!$seen{$pkg}) {
			    push( @to_check, $pkg );
			    push( @result, { Package => $pkg, Neg => 0 } );
			    $seen{$pkg} = 1;
			}
		    }
		}
	    }
	}
    }

    return \@result;
}

sub expand_virtuals ($\@) {
    my $session = shift;
    my $dlist = shift;
    my ($dep, %names, @new_dlist);

    foreach $dep (@$dlist) {
	foreach (scalar($dep), @{$dep->{'Alternatives'}}) {
	    $names{$_->{'Package'}} = 1;
	}
    }
    my $provided_by = get_virtuals($session, keys %names );

    foreach $dep (@$dlist) {
	my %seen;
	foreach (scalar($dep), @{$dep->{'Alternatives'}}) {
	    my $name = $_->{'Package'};
	    $seen{$name} = 1;
	    if (exists $provided_by->{$name}) {
		foreach( keys %{$provided_by->{$name}} ) {
		    $seen{$_} = 1;
		}
	    }
	}
	my @l = map { { Package => $_, Neg => 0 } } keys %seen;
	my $l = shift @l;
	foreach (@l) {
	    push( @{$l->{'Alternatives'}}, $_ );
	}
	push( @new_dlist, $l );
    }

    return \@new_dlist;
}

sub get_dependencies ($@) {
    my $session = shift;

    local(*PIPE);
    my %deps;

    my $command = $session->get_apt_command("$conf::apt_cache", "show @_", $main::username, 0, '/');
    my $pid = open3(\*main::DEVNULL, \*PIPE, '>&PLOG', "$command" );
    if (!$pid) {
	die "Cannot start $conf::apt_cache $!\n";
    }
    local($/) = "";
    while( <PIPE> ) {
	my ($name, $dep, $predep);
	/^Package:\s*(.*)\s*$/mi and $name = $1;
	next if !$name || $deps{$name};
	/^Depends:\s*(.*)\s*$/mi and $dep = $1;
	/^Pre-Depends:\s*(.*)\s*$/mi and $predep = $1;
	$dep .= ", " if defined($dep) && $dep && defined($predep) && $predep;
	$dep .= $predep if defined($predep);
	$deps{$name} = $dep;
    }
    close( PIPE );
    waitpid $pid, 0;
    die "$conf::apt_cache exit status $?\n" if $?;

    return \%deps;
}

sub get_virtuals ($@) {
    my $session = shift;

    local(*PIPE);

    my $command = $session->get_apt_command("$conf::apt_cache", "showpkg @_", $main::username, 0, '/');
    my $pid = open3(\*main::DEVNULL, \*PIPE, '>&PLOG', "$command" );
    if (!$pid) {
	die "Cannot start $conf::apt_cache $!\n";
    }
    my $name;
    my $in_rprov = 0;
    my %provided_by;
    while( <PIPE> ) {
	if (/^Package:\s*(\S+)\s*$/) {
	    $name = $1;
	}
	elsif (/^Reverse Provides: $/) {
	    $in_rprov = 1;
	}
	elsif ($in_rprov && /^(\w+):\s/) {
	    $in_rprov = 0;
	}
	elsif ($in_rprov && /^(\S+)\s*\S+\s*$/) {
	    $provided_by{$name}->{$1} = 1;
	}
    }
    close( PIPE );
    waitpid $pid, 0;
    die "$conf::apt_cache exit status $?\n" if $?;

    return \%provided_by;
}

sub parse_one_srcdep ($$\%) {
    my $pkg = shift;
    my $deps = shift;
    my $hash = shift;

    $deps =~ s/^\s*(.*)\s*$/$1/;
    foreach (split( /\s*,\s*/, $deps )) {
	my @l;
	my $override;
	if (/^\&/) {
	    $override = 1;
	    s/^\&\s+//;
	}
	my @alts = split( /\s*\|\s*/, $_ );
	my $neg_seen = 0;
	foreach (@alts) {
	    if (!/^([^\s([]+)\s*(\(\s*([<=>]+)\s*(\S+)\s*\))?(\s*\[([^]]+)\])?/) {
		warn "Warning: syntax error in dependency '$_' of $pkg\n";
		next;
	    }
	    my( $dep, $rel, $relv, $archlist ) = ($1, $3, $4, $6);
	    if ($archlist) {
		$archlist =~ s/^\s*(.*)\s*$/$1/;
		my @archs = split( /\s+/, $archlist );
		my ($use_it, $ignore_it, $include) = (0, 0, 0);
		foreach (@archs) {
		    if (/^!/) {
			$ignore_it = 1 if substr($_, 1) eq $main::arch;
		    }
		    else {
			$use_it = 1 if $_ eq $main::arch;
			$include = 1;
		    }
		}
		warn "Warning: inconsistent arch restriction on ",
		"$pkg: $dep depedency\n"
		    if $ignore_it && $use_it;
		next if $ignore_it || ($include && !$use_it);
	    }
	    my $neg = 0;
	    if ($dep =~ /^!/) {
		$dep =~ s/^!\s*//;
		$neg = 1;
		$neg_seen = 1;
	    }
	    if ($conf::srcdep_over{$dep}) {
		if ($main::verbose) {
		    print PLOG "Replacing source dep $dep";
		    print PLOG " ($rel $relv)" if $relv;
		    print PLOG " with $conf::srcdep_over{$dep}[0]";
		    print PLOG " ($conf::srcdep_over{$dep}[1] $conf::srcdep_over{$dep}[2])"
			if $conf::srcdep_over{$dep}[1];
		    print PLOG ".\n";
		}
		$dep = $conf::srcdep_over{$dep}[0];
		$rel = $conf::srcdep_over{$dep}[1];
		$relv = $conf::srcdep_over{$dep}[2];
	    }
	    my $h = { Package => $dep, Neg => $neg };
	    if ($rel && $relv) {
		$h->{'Rel'} = $rel;
		$h->{'Version'} = $relv;
	    }
	    $h->{'Override'} = $override if $override;
	    push( @l, $h );
	}
	if (@alts > 1 && $neg_seen) {
	    warn "Warning: $pkg: alternatives with negative dependencies ",
	    "forbidden -- skipped\n";
	}
	elsif (@l) {
	    my $l = shift @l;
	    foreach (@l) {
		push( @{$l->{'Alternatives'}}, $_ );
	    }
	    push( @{$hash->{$pkg}}, $l );
	}
    }
}

sub parse_manual_srcdeps (@) {
    my @for_pkgs = @_;

    foreach (@main::manual_srcdeps) {
	if (!/^([fa])([a-zA-Z\d.+-]+):\s*(.*)\s*$/) {
	    warn "Syntax error in manual source dependency: ",
	    substr( $_, 1 ), "\n";
	    next;
	}
	my ($mode, $pkg, $deps) = ($1, $2, $3);
	next if !isin( $pkg, @for_pkgs );
	@{$main::deps{$pkg}} = () if $mode eq 'f';
	parse_one_srcdep( $pkg, $deps, %main::deps );
    }
}

sub check_space ($@) {
    my $session = shift;
    my @files = @_;
    my $sum = 0;
    local( *PIPE );

    foreach (@files) {
	my $command;

	if (/^\Q$main::chroot_dir\E/) {
	    $_ = $session->strip_chroot_path($_);
	    $command = $session->get_command("/usr/bin/du -k -s $_ 2>/dev/null", "root", 1, 0);
	} else {
	    $command = $session->get_command("/usr/bin/du -k -s $_ 2>/dev/null", $main::username, 0, 0);
	}

	if (!open( PIPE, "$command |" )) {
	    print PLOG "Cannot determine space needed (du failed): $!\n";
	    return;
	}
	while( <PIPE> ) {
	    next if !/^(\d+)/;
	    $sum += $1;
	}
	close( PIPE );
    }

    $main::this_space = $sum;
}

sub file_for_name ($@) {
    my $name = shift;
    my @x = grep { /^\Q$name\E_/ } @_;
    return $x[0];
}

sub write_jobs_file ($) {
    my $news = shift;
    my $job;
    local( *F );

    $main::job_state{$main::current_job} = $news
	if $news && $main::current_job;

    return if !$main::batchmode;

    return if !open( F, ">$main::jobs_file" );
    foreach $job (@ARGV) {
	my $jobname;

	if ($job eq $main::current_job and $main::binNMU_name) {
	    $jobname = $main::binNMU_name;
	} else {
	    $jobname = $job;
	}
	print F ($job eq $main::current_job) ? "" : "  ",
	        $jobname,
	        ($main::job_state{$job} ? ": $main::job_state{$job}" : ""),
	        "\n";
    }
    close( F );
}

sub append_to_FINISHED ($) {
    my $pkg = shift;
    local( *F );

    return if !$main::batchmode;

    open( F, ">>SBUILD-FINISHED" );
    print F "$pkg\n";
    close( F );
}

sub write_srcdep_lock_file (\@) {
    my $deps = shift;
    local( *F );

    ++$main::srcdep_lock_cnt;
    my $f = "$main::srcdep_lock_dir/$$-$main::srcdep_lock_cnt";
    if (!open( F, ">$f" )) {
	print "Warning: cannot create srcdep lock file $f: $!\n";
	return;
    }
    print "Writing srcdep lock file $f:\n" if $conf::debug;

    my $user = getpwuid($<);
    print F "$main::current_job $$ $user\n";
    print "Job $main::current_job pid $$ user $user\n" if $conf::debug;
    foreach (@$deps) {
	my $name = $_->{'Package'};
	print F ($_->{'Neg'} ? "!" : ""), "$name\n";
	print "  ", ($_->{'Neg'} ? "!" : ""), "$name\n" if $conf::debug;
    }
    close( F );
}

sub check_srcdep_conflicts (\@\@) {
    my $to_inst = shift;
    my $to_remove = shift;
    local( *F, *DIR );
    my $mypid = $$;
    my %conflict_builds;

    if (!opendir( DIR, $main::srcdep_lock_dir )) {
	print PLOG "Cannot opendir $main::srcdep_lock_dir: $!\n";
	return 1;
    }
    my @files = grep { !/^\.\.?$/ && !/^install\.lock/ && !/^$mypid-\d+$/ }
    readdir(DIR);
    closedir(DIR);

    my $file;
    foreach $file (@files) {
	if (!open( F, "<$main::srcdep_lock_dir/$file" )) {
	    print PLOG "Cannot open $main::srcdep_lock_dir/$file: $!\n";
	    next;
	}
	<F> =~ /^(\S+)\s+(\S+)\s+(\S+)/;
	my ($job, $pid, $user) = ($1, $2, $3);

	# ignore (and remove) a lock file if associated process
	# doesn't exist anymore
	if (kill( 0, $pid ) == 0 && $! == ESRCH) {
	    close( F );
	    print PLOG "Found stale srcdep lock file $file -- removing it\n";
	    print PLOG "Cannot remove: $!\n"
		if !unlink( "$main::srcdep_lock_dir/$file" );
	    next;
	}

	print "Reading srclock file $file by job $job user $user\n"
	    if $conf::debug;

	while( <F> ) {
	    my ($neg, $pkg) = /^(!?)(\S+)/;
	    print "Found ", ($neg ? "neg " : ""), "entry $pkg\n"
		if $conf::debug;

	    if (isin( $pkg, @$to_inst, @$to_remove )) {
		print PLOG "Source dependency conflict with build of ",
		           "$job by $user (pid $pid):\n";
		print PLOG "  $job ", ($neg ? "conflicts with" : "needs"),
		           " $pkg\n";
		print PLOG "  $main::current_job wants to ",
		           (isin( $pkg, @$to_inst ) ? "update" : "remove"),
		           " $pkg\n";
		$conflict_builds{$file} = 1;
	    }
	}
	close( F );
    }

    my @conflict_builds = keys %conflict_builds;
    if (@conflict_builds) {
	print "Srcdep conflicts with: @conflict_builds\n" if $conf::debug;
    }
    else {
	print "No srcdep conflicts\n" if $conf::debug;
    }
    return @conflict_builds;
}

sub remove_srcdep_lock_file () {
    my $f = "$main::srcdep_lock_dir/$$-$main::srcdep_lock_cnt";

    print "Removing srcdep lock file $f\n" if $conf::debug;
    if (!unlink( $f )) {
	print "Warning: cannot remove srcdep lock file $f: $!\n"
	    if $! != ENOENT;
    }
}

sub prepare_watches (\@@) {
    my $dependencies = shift;
    my @instd = @_;
    my(@dep_on, $dep, $pkg, $prg);

    @dep_on = @instd;
    foreach $dep (@$dependencies, @$main::additional_deps) {
	if ($dep->{'Neg'} && $dep->{'Package'} =~ /^needs-no-(\S+)/) {
	    push( @dep_on, $1 );
	}
	elsif ($dep->{'Package'} !~ /^\*/ && !$dep->{'Neg'}) {
	    foreach (scalar($dep), @{$dep->{'Alternatives'}}) {
		push( @dep_on, $_->{'Package'} );
	    }
	}
    }
    # init %this_watches to names of packages which have not been
    # installed as source dependencies
    undef %main::this_watches;
    foreach $pkg (keys %conf::watches) {
	if (isin( $pkg, @dep_on )) {
	    print "Excluding from watch: $pkg\n" if $conf::debug;
	    next;
	}
	foreach $prg (@{$conf::watches{$pkg}}) {
	    $prg = "/usr/bin/$prg" if $prg !~ m,^/,;
	    $main::this_watches{"$main::chroot_dir$prg"} = $pkg;
	    print "Will watch for $prg ($pkg)\n" if $conf::debug;
	}
    }
}

sub check_watches ($) {
    my $session = shift;
    my($prg, @st, %used);

    return if (!$conf::check_watches);

    foreach $prg (keys %main::this_watches) {
	if (!(@st = stat( $prg ))) {
	    print "Watch: $prg: stat failed\n" if $conf::debug;
	    next;
	}
	if ($st[8] > $main::build_start_time) {
	    my $pkg = $main::this_watches{$prg};
	    my $prg2 = $session->strip_chroot_path($prg);
	    push( @{$used{$pkg}}, $prg2 )
		if @main::have_dsc_build_deps ||
		!isin( $pkg, @conf::ignore_watches_no_build_deps );
	}
	else {
	    print "Watch: $prg: untouched\n" if $conf::debug;
	}
    }
    return if !%used;

    print PLOG <<EOF;

NOTE: The package could have used binaries from the following packages
(access time changed) without a source dependency:
EOF

    foreach (keys %used) {
	print PLOG "  $_: @{$used{$_}}\n";
    }
    print PLOG "\n";
}

sub should_skip ($) {
    my $pkgv = shift;

    fixup_pkgv( $pkgv );
    lock_file( "SKIP", 0 );
    goto unlock if !open( F, "SKIP" );
    my @pkgs = <F>;
    close( F );

    if (!open( F, ">SKIP" )) {
	print "Can't open SKIP for writing: $!\n",
	"Would write: @pkgs\nminus $pkgv\n";
	goto unlock;
    }
    my $found = 0;
    foreach (@pkgs) {
	if (/^\Q$pkgv\E$/) {
	    ++$found;
	    print PLOG "$pkgv found in SKIP file -- skipping building it\n";
	}
	else {
	    print F $_;
	}
    }
    close( F );
  unlock:
    unlock_file( "SKIP" );
    return $found;
}

sub add_givenback ($$) {
    my $pkgv = shift;
    my $time = shift;
    local( *F );

    lock_file( "SBUILD-GIVEN-BACK", 0 );

    if (open( F, ">>SBUILD-GIVEN-BACK" )) {
	print F "$pkgv $time\n";
	close( F );
    }
    else {
	print PLOG "Can't open SBUILD-GIVEN-BACK: $!\n";
    }

  unlock:
    unlock_file( "SBUILD-GIVEN-BACK" );
}

sub set_installed (@) {
    foreach (@_) {
	$main::changes->{'installed'}->{$_} = 1;
    }
    print "Added to installed list: @_\n" if $conf::debug;
}

sub set_removed (@) {
    foreach (@_) {
	$main::changes->{'removed'}->{$_} = 1;
	if (exists $main::changes->{'installed'}->{$_}) {
	    delete $main::changes->{'installed'}->{$_};
	    $main::changes->{'auto-removed'}->{$_} = 1;
	    print "Note: $_ was installed\n" if $conf::debug;
	}
    }
    print "Added to removed list: @_\n" if $conf::debug;
}

sub unset_installed (@) {
    foreach (@_) {
	delete $main::changes->{'installed'}->{$_};
    }
    print "Removed from installed list: @_\n" if $conf::debug;
}

sub unset_removed (@) {
    foreach (@_) {
	delete $main::changes->{'removed'}->{$_};
	if (exists $main::changes->{'auto-removed'}->{$_}) {
	    delete $main::changes->{'auto-removed'}->{$_};
	    $main::changes->{'installed'}->{$_} = 1;
	    print "Note: revived $_ to installed list\n" if $conf::debug;
	}
    }
    print "Removed from removed list: @_\n" if $conf::debug;
}

sub df ($) {
    my $dir = shift;

    my $free = `/bin/df $dir | tail -n 1`;
    my @free = split( /\s+/, $free );
    return $free[3];
}

sub isin ($@) {
    my $val = shift;
    return grep( $_ eq $val, @_ );
}

sub fixup_pkgv (\$) {
    my $pkgv = shift;

    $$pkgv =~ s,^.*/,,; # strip path
    $$pkgv =~ s/\.(dsc|diff\.gz|tar\.gz|deb)$//; # strip extension
    $$pkgv =~ s/_[a-zA-Z\d+~-]+\.(changes|deb)$//; # strip extension
}

sub format_deps (@) {
    return join( ", ",
		 map { join( "|",
			     map { ($_->{'Neg'} ? "!" : "") .
				       $_->{'Package'} .
				       ($_->{'Rel'} ? " ($_->{'Rel'} $_->{'Version'})":"")}
			     scalar($_), @{$_->{'Alternatives'}}) } @_ );
}

sub lock_file ($$) {
    my $file = shift;
    my $for_srcdep = shift;
    my $lockfile = "$file.lock";
    my $try = 0;

  repeat:
    if (!sysopen( F, $lockfile, O_WRONLY|O_CREAT|O_TRUNC|O_EXCL, 0644 )){
	if ($! == EEXIST) {
	    # lock file exists, wait
	    goto repeat if !open( F, "<$lockfile" );
	    my $line = <F>;
	    my ($pid, $user);
	    close( F );
	    if ($line !~ /^(\d+)\s+([\w\d.-]+)$/) {
		warn "Bad lock file contents ($lockfile) -- still trying\n";
	    }
	    else {
		($pid, $user) = ($1, $2);
		if (kill( 0, $pid ) == 0 && $! == ESRCH) {
		    # process doesn't exist anymore, remove stale lock
		    warn "Removing stale lock file $lockfile ".
			" (pid $pid, user $user)\n";
		    unlink( $lockfile );
		    goto repeat;
		}
	    }
	    ++$try;
	    if (!$for_srcdep && $try > $main::max_lock_trys) {
		warn "Lockfile $lockfile still present after ".
		    $main::max_lock_trys*$main::lock_interval.
		    " seconds -- giving up\n";
		return;
	    }
	    print PLOG "Another sbuild process ($pid by $user) is currently ",
	    "installing or\n",
	    "removing packages -- waiting...\n"
		if $for_srcdep && $try == 1;
	    sleep $main::lock_interval;
	    goto repeat;
	}
	warn "Can't create lock file $lockfile: $!\n";
    }
    F->print("$$ $ENV{'LOGNAME'}\n");
    F->close();
}

sub unlock_file ($) {
    my $file = shift;
    my $lockfile = "$file.lock";

    unlink( $lockfile );
}

sub shutdown ($) {
    my $signame = shift;
    my($job,@npkgs,@pkgs);
    local( *F );

    $SIG{'INT'} = 'IGNORE';
    $SIG{'QUIT'} = 'IGNORE';
    $SIG{'TERM'} = 'IGNORE';
    $SIG{'ALRM'} = 'IGNORE';
    $SIG{'PIPE'} = 'IGNORE';
    print PLOG "sbuild received SIG$signame -- shutting down\n";

    goto not_ni_shutdown if !$main::batchmode;

    # most important: dump out names of unfinished jobs to REDO
    foreach $job (@ARGV) {
	my $job2 = $job;
	fixup_pkgv( $job2 );
	push( @npkgs, $job2 )
	    if !$main::job_state{$job} || $job eq $main::current_job;
    }
    print LOG "The following jobs were not finished: @npkgs\n";

    my $f = "REDO";
    if (-f "REDO.lock") {
	# if lock file exists, write to a different file -- timing may
	# be critical
	$f = "REDO2";
    }
    if (open( F, "<$f" )) {
	@pkgs = <F>;
	close( F );
    }
    if (open( F, ">>$f" )) {
	foreach $job (@npkgs) {
	    next if grep( /^\Q$job\E\s/, @pkgs );
	    if (not defined $main::binNMUver) {
		print F "$job $main::distribution\n";
	    } else {
		print F "$job $main::distribution $main::binNMUver $main::binNMU\n";
	    }
	}
	close( F );
    }
    else {
	print "Cannot open $f: $!\n";
    }
    open( F, ">SBUILD-REDO-DUMPED" );
    close( F );
    print LOG "SBUILD-REDO-DUMPED created\n";
    unlink( "SBUILD-FINISHED" );

    # next: say which packages should be uninstalled
    @pkgs = keys %{$main::changes->{'installed'}};
    if (@pkgs) {
	if (open( F, ">>NEED-TO-UNINSTALL" )) {
	    print F "@pkgs\n";
	    close( F );
	}
	print "The following packages still need to be uninstalled ",
	"(--purge):\n@pkgs\n";
    }

  not_ni_shutdown:
    # next: kill currently running command (if one)
    if ($main::sub_pid) {
	print "Killing $main::sub_task subprocess $main::sub_pid\n";
	run_command("perl -e \"kill( \\\"TERM\\\", $main::sub_pid )\"", "root", 1, 0, '/');
    }
    remove_srcdep_lock_file();

    # close logs and send mails
    if ( $main::current_job && defined($main::current_session)) {
	if ($conf::purge_build_directory eq "always") {
	    print PLOG "Purging $main::chroot_build_dir\n";
	    my $bdir = $main::current_session->strip_chroot_path($main::chroot_build_dir);
	    $main::current_session->run_command("rm -rf '$bdir'", "root", 1, 0, '/');
	}

	fixup_pkgv( $main::current_job );

	$main::current_session->end_session();
	undef $main::current_session;

	close_build_log( $main::current_job, $main::distribution, $main::pkg_status,
			 $main::pkg_start_time, $main::pkg_end_time,
			 $main::this_space );
	undef $main::binNMU_name;
    }
    close_log();
    unlink( $main::jobs_file ) if $main::batchmode;
    $? = 0; $! = 0;
    if ($conf::sbuild_mode eq "user") {
	exit 1;
    }
    exit 0;
}

sub write_stats ($$) {
    return if not defined $main::stats_dir;
    my ($cat, $val) = @_;
    local( *F );

    lock_file( "$main::stats_dir", 0 );
    open( F, ">>$main::stats_dir/$cat" );
    print F "$val\n";
    close( F );
    unlock_file( "$main::stats_dir" );
}

sub debian_files_list ($) {
    my $files = shift;

    my @list;

    print STDERR "Parsing $files\n" if $conf::debug;

    if (-r $files && open( FILES, "<$files" )) {
	while (<FILES>) {
	    chomp;
	    my $f = (split( /\s+/, $_ ))[0];
	    push( @list, "$f" );
	    print STDERR "  $f\n" if $conf::debug;
	}
	close( FILES ) or print PLOG "Failed to close $files\n" && return 1;
    }

    return @list;
}

sub dsc_files ($) {
    my $dsc = shift;
    my @files;

    print STDERR "Parsing $dsc\n" if $conf::debug;

    if (-r $dsc && open( DSC, "$conf::dcmd $dsc|" )) {
	while (<DSC>) {
	    chomp;
	    push @files, $_;
	    print STDERR "  $_\n" if $conf::debug;
	}
	close( DSC ) or print PLOG "Failed to close $dsc\n";
    } else {
	print PLOG "Failed to open $dsc\n";
    }

    return @files;
}

# Figure out chroot architecture
sub chroot_arch ($) {
    my $session = shift;

    $main::sub_pid = open( PIPE, "-|" );
    if (!defined $main::sub_pid) {
	print PLOG "Can't spawn dpkg: $!\n";
	return 0;
    }
    if ($main::sub_pid == 0) {
	$session->exec_command("$conf::dpkg --print-installation-architecture 2>/dev/null", $main::username, 1, 0, '/');
    }
    chomp( my $chroot_arch = <PIPE> );
    close( PIPE );
    undef $main::sub_pid;

    die "Can't determine architecture of chroot: $!\n"
	if ($? || !defined($chroot_arch));

    return $chroot_arch;
}

sub check_group_membership () {
    my $user = getpwuid($<);
    my ($name,$passwd,$gid,$members) = getgrnam("sbuild");

    if (!$gid) {
	die "Group sbuild does not exist";
    }

    my $in_group = 0;
    foreach (split(' ', $members)) {
	$in_group = 1 if $_ eq $main::username;
    }

    if (!$in_group) {
	print STDERR "User $user is not a member of group $name\n";
	print STDERR "See \"User Setup\" in sbuild-setup(7)\n";
	exit(1);
    }

    return;
}

sub open_build_log ($$$) {
    my $pkg_name = shift;
    my $pkg_distribution = shift;
    my $date = shift;

    open_pkg_log($pkg_name, $pkg_distribution, $date);
    print PLOG "Automatic build of $pkg_name on $hostname by ".
	"sbuild/$arch $version\n";
    print PLOG "Build started at $date\n";
    print PLOG "*"x78, "\n";
}

sub close_build_log ($$$$$$) {
    my $pkg_name = shift;
    my $pkg_distribution = shift;
    my $status = shift;
    my $pkg_start_time = shift;
    my $pkg_end_time = shift;
    my $space = shift;
    my $date = strftime("%Y%m%d-%H%M", localtime($pkg_end_time));

    my $time = $pkg_end_time - $pkg_start_time;

    $time = 0 if $time < 0;
    if (defined($status) && $status eq "successful") {
	add_time_entry( $pkg_name, $time );
	add_space_entry( $pkg_name, $space );
    }
    print PLOG "*"x78, "\n";
    printf PLOG "Finished at ${date}\nBuild needed %02d:%02d:%02d, %dk disk space\n",
    int($time/3600), int(($time%3600)/60), int($time%60), $space;

    close_pkg_log ($pkg_name, $pkg_distribution, $status,
		   $pkg_start_time, $pkg_end_time);
}

sub add_time_entry ($$) {
    my $pkg = shift;
    my $t = shift;

    return if !$Sbuild::Conf::avg_time_db;
    my %db;
    if (!tie %db, 'GDBM_File', $Sbuild::Conf::avg_time_db, GDBM_WRCREAT, 0664) {
	print "Can't open average time db $Sbuild::Conf::avg_time_db\n";
	return;
    }
    $pkg =~ s/_.*//;

    if (exists $db{$pkg}) {
	my @times = split( /\s+/, $db{$pkg} );
	push( @times, $t );
	my $sum = 0;
	foreach (@times[1..$#times]) { $sum += $_; }
	$times[0] = $sum / (@times-1);
	$db{$pkg} = join( ' ', @times );
    }
    else {
	$db{$pkg} = "$t $t";
    }
    untie %db;
}

sub add_space_entry ($$) {
    my $pkg = shift;
    my $space = shift;

    my $keepvals = 4;

    return if !$Sbuild::Conf::avg_space_db || $space == 0;
    my %db;
    if (!tie %db, 'GDBM_File', $Sbuild::Conf::avg_space_db, &GDBM_WRCREAT, 0664) {
	print "Can't open average space db $Sbuild::Conf::avg_space_db\n";
	return;
    }
    $pkg =~ s/_.*//;

    if (exists $db{$pkg}) {
	my @values = split( /\s+/, $db{$pkg} );
	shift @values;
	unshift( @values, $space );
	pop @values if @values > $keepvals;
	my ($sum, $n, $weight, $i) = (0, 0, scalar(@values));
	for( $i = 0; $i < @values; ++$i) {
	    $sum += $values[$i] * $weight;
	    $n += $weight;
	}
	unshift( @values, $sum/$n );
	$db{$pkg} = join( ' ', @values );
    }
    else {
	$db{$pkg} = "$space $space";
    }
    untie %db;
}

sub dump_main_state () {
    print STDERR Data::Dumper->Dump([\@main::additional_deps,
				     $main::auto_giveback,
				     $main::auto_giveback_host,
				     $main::auto_giveback_socket,
				     $main::auto_giveback_user,
				     $main::auto_giveback_wb_user,
				     $main::batchmode,
				     $main::binNMU,
				     $main::binNMU_name,
				     $main::binNMUver,
				     $main::build_arch_all,
				     $main::build_source,
				     $main::build_start_time,
				     $main::changes,
				     $main::chroot_build_dir,
				     $main::chroot_dir,
				     $main::current_job,
				     $main::current_session,
				     $main::cwd,
				     $main::database,
				     \%main::deps,
				     $main::DEVNULL,
				     $main::distribution,
				     $main::dpkg_buildpackage_signopt,
				     \@main::have_dsc_build_deps,
				     $main::ilock_file,
				     $main::jobs_file,
				     \%main::job_state,
				     $main::ld_library_path,
				     $main::lock_interval,
				     \@main::manual_srcdeps,
				     $main::max_lock_trys,
				     $main::override_distribution,
				     $main::pkg_end_time,
				     $main::pkg_fail_stage,
				     $main::pkg_start_time,
				     $main::pkg_status,
				     $main::shutdown,
				     $main::srcdep_lock_cnt,
				     $main::srcdep_lock_dir,
				     $main::stats_dir,
				     $main::sub_pid,
				     $main::sub_task,
				     $main::this_space,
				     \%main::this_watches,
				     \@main::toolchain_pkgs,
				     $main::username,
				     $main::useSNAP,
				     $main::verbose],
				    [qw(@main::additional_deps
					$main::auto_giveback
					$main::auto_giveback_host
					$main::auto_giveback_socket
					$main::auto_giveback_user
					$main::auto_giveback_wb_user
					$main::batchmode $main::binNMU
					$main::binNMU_name
					$main::binNMUver
					$main::build_arch_all
					$main::build_source
					$main::build_start_time
					$main::changes
					$main::chroot_build_dir
					$main::chroot_dir
					$main::current_job
					$main::current_session
					$main::cwd $main::database
					%main::deps $main::DEVNULL
					$main::distribution
					$main::dpkg_buildpackage_signopt
					@main::have_dsc_build_deps
					$main::ilock_file
					$main::jobs_file
					%main::job_state
					$main::ld_library_path
					$main::lock_interval
					@main::manual_srcdeps
					$main::max_lock_trys
					$main::override_distribution
					$main::pkg_end_time
					$main::pkg_fail_stage
					$main::pkg_start_time
					$main::pkg_status
					$main::shutdown
					$main::srcdep_lock_cnt
					$main::srcdep_lock_dir
					$main::stats_dir
					$main::sub_pid $main::sub_task
					$main::this_space
					%main::this_watches
					@main::toolchain_pkgs
					$main::username $main::useSNAP
					$main::verbose)] );
}
